MODULE module_dm USE module_machine USE module_wrf_error USE module_driver_constants USE module_cpl, ONLY : coupler_on, cpl_init IMPLICIT NONE INCLUDE 'mpif.h' INTEGER, PARAMETER :: max_halo_width = 6 INTEGER :: ips_save, ipe_save, jps_save, jpe_save, itrace INTEGER :: lats_to_mic, minx, miny INTEGER :: communicator_stack_cursor = 0 INTEGER :: current_id = 1 INTEGER, DIMENSION(max_domains) :: ntasks_stack, ntasks_y_stack & , ntasks_x_stack, mytask_stack & , mytask_x_stack, mytask_y_stack & , id_stack INTEGER, DIMENSION(max_domains) :: ntasks_store, ntasks_y_store & , ntasks_x_store, mytask_store & , mytask_x_store, mytask_y_store INTEGER ntasks, ntasks_y, ntasks_x, mytask, mytask_x, mytask_y INTEGER, DIMENSION(max_domains) :: local_communicator_stack, local_communicator_periodic_stack & ,local_iocommunicator_stack & ,local_communicator_x_stack, local_communicator_y_stack INTEGER, DIMENSION(max_domains) :: local_communicator_store, local_communicator_periodic_store & ,local_iocommunicator_store & ,local_communicator_x_store, local_communicator_y_store INTEGER :: mpi_comm_allcompute = MPI_UNDEFINED INTEGER :: local_communicator = MPI_UNDEFINED INTEGER :: local_communicator_periodic = MPI_UNDEFINED INTEGER :: local_iocommunicator = MPI_UNDEFINED INTEGER :: local_communicator_x = MPI_UNDEFINED INTEGER :: local_communicator_y = MPI_UNDEFINED INTEGER :: local_quilt_comm = MPI_UNDEFINED LOGICAL :: dm_debug_flag = .FALSE. INTEGER intercomm_to_mom( max_domains ), intercomm_to_kid( max_nests, max_domains ) INTEGER mpi_comm_to_mom( max_domains ), mpi_comm_to_kid( max_nests, max_domains ) INTEGER which_kid(max_domains), nkids(max_domains) INTEGER nest_task_offsets(max_domains) LOGICAL intercomm_active( max_domains ) LOGICAL domain_active_this_task( max_domains ) INTEGER tasks_per_split INTEGER comm_start(max_domains) INTEGER nest_pes_x(max_domains) INTEGER nest_pes_y(max_domains) INTEGER comms_i_am_in (max_domains) INTEGER loc_comm(max_domains) LOGICAL poll_servers INTEGER nio_tasks_per_group(max_domains), nio_groups, num_io_tasks NAMELIST /dm_task_split/ tasks_per_split, comm_start, nest_pes_x, nest_pes_y NAMELIST /namelist_quilt/ nio_tasks_per_group, nio_groups, poll_servers INTERFACE wrf_dm_maxval MODULE PROCEDURE wrf_dm_maxval_real , wrf_dm_maxval_integer, wrf_dm_maxval_doubleprecision END INTERFACE INTERFACE wrf_dm_minval MODULE PROCEDURE wrf_dm_minval_real , wrf_dm_minval_integer, wrf_dm_minval_doubleprecision END INTERFACE CONTAINS SUBROUTINE MPASPECT( P, MINM, MINN, PROCMIN_M, PROCMIN_N ) IMPLICIT NONE INTEGER P, M, N, MINI, MINM, MINN, PROCMIN_M, PROCMIN_N MINI = 2*P MINM = 1 MINN = P DO M = 1, P IF ( MOD( P, M ) .EQ. 0 ) THEN N = P / M IF ( ABS(M-N) .LT. MINI & .AND. M .GE. PROCMIN_M & .AND. N .GE. PROCMIN_N & ) THEN MINI = ABS(M-N) MINM = M MINN = N END IF END IF END DO IF ( MINM .LT. PROCMIN_M .OR. MINN .LT. PROCMIN_N ) THEN WRITE( wrf_err_message , * )'MPASPECT: UNABLE TO GENERATE PROCESSOR MESH. STOPPING.' CALL wrf_message ( TRIM ( wrf_err_message ) ) WRITE( wrf_err_message , * )' PROCMIN_M ', PROCMIN_M CALL wrf_message ( TRIM ( wrf_err_message ) ) WRITE( wrf_err_message , * )' PROCMIN_N ', PROCMIN_N CALL wrf_message ( TRIM ( wrf_err_message ) ) WRITE( wrf_err_message , * )' P ', P CALL wrf_message ( TRIM ( wrf_err_message ) ) WRITE( wrf_err_message , * )' MINM ', MINM CALL wrf_message ( TRIM ( wrf_err_message ) ) WRITE( wrf_err_message , * )' MINN ', MINN CALL wrf_message ( TRIM ( wrf_err_message ) ) CALL wrf_error_fatal3("",112,& 'module_dm: mpaspect' ) END IF RETURN END SUBROUTINE MPASPECT SUBROUTINE compute_mesh( ntasks , ntasks_x, ntasks_y ) IMPLICIT NONE INTEGER, INTENT(IN) :: ntasks INTEGER, INTENT(OUT) :: ntasks_x, ntasks_y INTEGER lats_to_mic CALL nl_get_nproc_x ( 1, ntasks_x ) CALL nl_get_nproc_y ( 1, ntasks_y ) IF ( ntasks_x .GT. 0 .OR. ntasks_y .GT. 0 ) THEN IF ( ntasks_x .GT. 0 .AND. ntasks_y .EQ. -1 ) THEN ntasks_y = ntasks / ntasks_x ELSE IF ( ntasks_x .EQ. -1 .AND. ntasks_y .GT. 0 ) THEN ntasks_x = ntasks / ntasks_y END IF IF ( ntasks_x * ntasks_y .NE. ntasks ) THEN WRITE( wrf_err_message , * )'WRF_DM_INITIALIZE (RSL_LITE): nproc_x * nproc_y in namelist ne ',ntasks CALL wrf_error_fatal3("",135,& wrf_err_message ) END IF ELSE CALL mpaspect ( ntasks, ntasks_x, ntasks_y, 1, 1 ) END IF ntasks_store(1) = ntasks ntasks_x_store(1) = ntasks_x ntasks_y_store(1) = ntasks_y END SUBROUTINE compute_mesh SUBROUTINE wrf_dm_initialize IMPLICIT NONE INTEGER :: local_comm_per, local_comm_x, local_comm_y, local_comm2, new_local_comm, group, newgroup, p, p1, ierr,itmp INTEGER, ALLOCATABLE, DIMENSION(:) :: ranks INTEGER comdup INTEGER, DIMENSION(2) :: dims, coords LOGICAL, DIMENSION(2) :: isperiodic LOGICAL :: reorder_mesh CALL instate_communicators_for_domain(1) CALL wrf_get_dm_communicator ( new_local_comm ) dims(1) = nest_pes_y(1) dims(2) = nest_pes_x(1) isperiodic(1) = .true. isperiodic(2) = .true. CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_comm_per, ierr ) local_communicator_periodic_store(1) = local_comm_per local_communicator_periodic_store = local_comm_per local_communicator_periodic = local_comm_per CALL nl_set_nproc_x ( 1, ntasks_x ) CALL nl_set_nproc_y ( 1, ntasks_y ) WRITE( wrf_err_message , * )'Ntasks in X ',ntasks_x,', ntasks in Y ',ntasks_y CALL wrf_message( wrf_err_message ) RETURN END SUBROUTINE wrf_dm_initialize SUBROUTINE get_dm_max_halo_width( id, width ) IMPLICIT NONE INTEGER, INTENT(IN) :: id INTEGER, INTENT(OUT) :: width IF ( id .EQ. 1 ) THEN width = max_halo_width ELSE width = max_halo_width + 3 END IF RETURN END SUBROUTINE get_dm_max_halo_width SUBROUTINE patch_domain_rsl_lite( id , parent, parent_id, & sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & sd2 , ed2 , sp2 , ep2 , sm2 , em2 , & sd3 , ed3 , sp3 , ep3 , sm3 , em3 , & sp1x , ep1x , sm1x , em1x , & sp2x , ep2x , sm2x , em2x , & sp3x , ep3x , sm3x , em3x , & sp1y , ep1y , sm1y , em1y , & sp2y , ep2y , sm2y , em2y , & sp3y , ep3y , sm3y , em3y , & bdx , bdy ) USE module_domain, ONLY : domain, head_grid, find_grid_by_id, alloc_space_field IMPLICIT NONE INTEGER, INTENT(IN) :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy INTEGER, INTENT(OUT) :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , & sm1 , em1 , sm2 , em2 , sm3 , em3 INTEGER, INTENT(OUT) :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , & sm1x , em1x , sm2x , em2x , sm3x , em3x INTEGER, INTENT(OUT) :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , & sm1y , em1y , sm2y , em2y , sm3y , em3y INTEGER, INTENT(IN) :: id, parent_id TYPE(domain),POINTER :: parent INTEGER :: ids, ide, jds, jde, kds, kde INTEGER :: ims, ime, jms, jme, kms, kme INTEGER :: ips, ipe, jps, jpe, kps, kpe INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex INTEGER :: ipsx, ipex, jpsx, jpex, kpsx, kpex INTEGER :: imsy, imey, jmsy, jmey, kmsy, kmey INTEGER :: ipsy, ipey, jpsy, jpey, kpsy, kpey INTEGER :: c_sd1 , c_ed1 , c_sd2 , c_ed2 , c_sd3 , c_ed3 INTEGER :: c_sp1 , c_ep1 , c_sp2 , c_ep2 , c_sp3 , c_ep3 , & c_sm1 , c_em1 , c_sm2 , c_em2 , c_sm3 , c_em3 INTEGER :: c_sp1x , c_ep1x , c_sp2x , c_ep2x , c_sp3x , c_ep3x , & c_sm1x , c_em1x , c_sm2x , c_em2x , c_sm3x , c_em3x INTEGER :: c_sp1y , c_ep1y , c_sp2y , c_ep2y , c_sp3y , c_ep3y , & c_sm1y , c_em1y , c_sm2y , c_em2y , c_sm3y , c_em3y INTEGER :: c_ids, c_ide, c_jds, c_jde, c_kds, c_kde INTEGER :: c_ims, c_ime, c_jms, c_jme, c_kms, c_kme INTEGER :: c_ips, c_ipe, c_jps, c_jpe, c_kps, c_kpe INTEGER :: idim , jdim , kdim , rem , a, b INTEGER :: i, j, ni, nj, Px, Py, P INTEGER :: parent_grid_ratio, i_parent_start, j_parent_start INTEGER :: shw INTEGER :: idim_cd, jdim_cd, ierr INTEGER :: max_dom TYPE(domain), POINTER :: intermediate_grid TYPE(domain), POINTER :: nest_grid CHARACTER*256 :: mess INTEGER parent_max_halo_width INTEGER thisdomain_max_halo_width INTEGER lats_to_mic lats_to_mic=0 IF ( lats_to_mic .GT. 0 ) THEN minx = -99 miny = lats_to_mic ELSE minx = 1 miny = 1 END IF SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) ids = sd2 ; ide = ed2 jds = sd3 ; jde = ed3 kds = sd1 ; kde = ed1 CASE ( DATA_ORDER_XYZ ) ids = sd1 ; ide = ed1 jds = sd2 ; jde = ed2 kds = sd3 ; kde = ed3 CASE ( DATA_ORDER_XZY ) ids = sd1 ; ide = ed1 jds = sd3 ; jde = ed3 kds = sd2 ; kde = ed2 CASE ( DATA_ORDER_YXZ) ids = sd2 ; ide = ed2 jds = sd1 ; jde = ed1 kds = sd3 ; kde = ed3 END SELECT CALL nl_get_max_dom( 1 , max_dom ) CALL get_dm_max_halo_width( id , thisdomain_max_halo_width ) IF ( id .GT. 1 ) THEN CALL get_dm_max_halo_width( parent%id , parent_max_halo_width ) END IF CALL compute_memory_dims_rsl_lite ( id, thisdomain_max_halo_width, 0 , bdx, bdy, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & imsx, imex, jmsx, jmex, kmsx, kmex, & imsy, imey, jmsy, jmey, kmsy, kmey, & ips, ipe, jps, jpe, kps, kpe, & ipsx, ipex, jpsx, jpex, kpsx, kpex, & ipsy, ipey, jpsy, jpey, kpsy, kpey ) IF ( id .GT. 1 ) THEN CALL nl_get_parent_grid_ratio( id, parent_grid_ratio ) if ( mod(ime,parent_grid_ratio) .NE. 0 ) ime = ime + parent_grid_ratio - mod(ime,parent_grid_ratio) if ( mod(jme,parent_grid_ratio) .NE. 0 ) jme = jme + parent_grid_ratio - mod(jme,parent_grid_ratio) END IF SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme sp1 = kps ; ep1 = kpe ; sm1 = kms ; em1 = kme sp2x = ipsx ; ep2x = ipex ; sm2x = imsx ; em2x = imex sp3x = jpsx ; ep3x = jpex ; sm3x = jmsx ; em3x = jmex sp1x = kpsx ; ep1x = kpex ; sm1x = kmsx ; em1x = kmex sp2y = ipsy ; ep2y = ipey ; sm2y = imsy ; em2y = imey sp3y = jpsy ; ep3y = jpey ; sm3y = jmsy ; em3y = jmey sp1y = kpsy ; ep1y = kpey ; sm1y = kmsy ; em1y = kmey CASE ( DATA_ORDER_ZYX ) sp3 = ips ; ep3 = ipe ; sm3 = ims ; em3 = ime sp2 = jps ; ep2 = jpe ; sm2 = jms ; em2 = jme sp1 = kps ; ep1 = kpe ; sm1 = kms ; em1 = kme sp3x = ipsx ; ep3x = ipex ; sm3x = imsx ; em3x = imex sp2x = jpsx ; ep2x = jpex ; sm2x = jmsx ; em2x = jmex sp1x = kpsx ; ep1x = kpex ; sm1x = kmsx ; em1x = kmex sp3y = ipsy ; ep3y = ipey ; sm3y = imsy ; em3y = imey sp2y = jpsy ; ep2y = jpey ; sm2y = jmsy ; em2y = jmey sp1y = kpsy ; ep1y = kpey ; sm1y = kmsy ; em1y = kmey CASE ( DATA_ORDER_XYZ ) sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime sp2 = jps ; ep2 = jpe ; sm2 = jms ; em2 = jme sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme sp1x = ipsx ; ep1x = ipex ; sm1x = imsx ; em1x = imex sp2x = jpsx ; ep2x = jpex ; sm2x = jmsx ; em2x = jmex sp3x = kpsx ; ep3x = kpex ; sm3x = kmsx ; em3x = kmex sp1y = ipsy ; ep1y = ipey ; sm1y = imsy ; em1y = imey sp2y = jpsy ; ep2y = jpey ; sm2y = jmsy ; em2y = jmey sp3y = kpsy ; ep3y = kpey ; sm3y = kmsy ; em3y = kmey CASE ( DATA_ORDER_YXZ) sp2 = ips ; ep2 = ipe ; sm2 = ims ; em2 = ime sp1 = jps ; ep1 = jpe ; sm1 = jms ; em1 = jme sp3 = kps ; ep3 = kpe ; sm3 = kms ; em3 = kme sp2x = ipsx ; ep2x = ipex ; sm2x = imsx ; em2x = imex sp1x = jpsx ; ep1x = jpex ; sm1x = jmsx ; em1x = jmex sp3x = kpsx ; ep3x = kpex ; sm3x = kmsx ; em3x = kmex sp2y = ipsy ; ep2y = ipey ; sm2y = imsy ; em2y = imey sp1y = jpsy ; ep1y = jpey ; sm1y = jmsy ; em1y = jmey sp3y = kpsy ; ep3y = kpey ; sm3y = kmsy ; em3y = kmey CASE ( DATA_ORDER_XZY ) sp1 = ips ; ep1 = ipe ; sm1 = ims ; em1 = ime sp3 = jps ; ep3 = jpe ; sm3 = jms ; em3 = jme sp2 = kps ; ep2 = kpe ; sm2 = kms ; em2 = kme sp1x = ipsx ; ep1x = ipex ; sm1x = imsx ; em1x = imex sp3x = jpsx ; ep3x = jpex ; sm3x = jmsx ; em3x = jmex sp2x = kpsx ; ep2x = kpex ; sm2x = kmsx ; em2x = kmex sp1y = ipsy ; ep1y = ipey ; sm1y = imsy ; em1y = imey sp3y = jpsy ; ep3y = jpey ; sm3y = jmsy ; em3y = jmey sp2y = kpsy ; ep2y = kpey ; sm2y = kmsy ; em2y = kmey CASE ( DATA_ORDER_YZX ) sp3 = ips ; ep3 = ipe ; sm3 = ims ; em3 = ime sp1 = jps ; ep1 = jpe ; sm1 = jms ; em1 = jme sp2 = kps ; ep2 = kpe ; sm2 = kms ; em2 = kme sp3x = ipsx ; ep3x = ipex ; sm3x = imsx ; em3x = imex sp1x = jpsx ; ep1x = jpex ; sm1x = jmsx ; em1x = jmex sp2x = kpsx ; ep2x = kpex ; sm2x = kmsx ; em2x = kmex sp3y = ipsy ; ep3y = ipey ; sm3y = imsy ; em3y = imey sp1y = jpsy ; ep1y = jpey ; sm1y = jmsy ; em1y = jmey sp2y = kpsy ; ep2y = kpey ; sm2y = kmsy ; em2y = kmey END SELECT IF ( id.EQ.1 ) THEN WRITE(wrf_err_message,*)'*************************************' CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'Parent domain' CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'*************************************' CALL wrf_message( TRIM(wrf_err_message) ) END IF IF ( id .GT. 1 ) THEN CALL nl_get_shw( id, shw ) CALL nl_get_i_parent_start( id , i_parent_start ) CALL nl_get_j_parent_start( id , j_parent_start ) CALL nl_get_parent_grid_ratio( id, parent_grid_ratio ) SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) idim = ed2-sd2+1 jdim = ed3-sd3+1 kdim = ed1-sd1+1 c_kds = sd1 ; c_kde = ed1 CASE ( DATA_ORDER_ZYX ) idim = ed3-sd3+1 jdim = ed2-sd2+1 kdim = ed1-sd1+1 c_kds = sd1 ; c_kde = ed1 CASE ( DATA_ORDER_XYZ ) idim = ed1-sd1+1 jdim = ed2-sd2+1 kdim = ed3-sd3+1 c_kds = sd3 ; c_kde = ed3 CASE ( DATA_ORDER_YXZ) idim = ed2-sd2+1 jdim = ed1-sd1+1 kdim = ed3-sd3+1 c_kds = sd3 ; c_kde = ed3 CASE ( DATA_ORDER_XZY ) idim = ed1-sd1+1 jdim = ed3-sd3+1 kdim = ed2-sd2+1 c_kds = sd2 ; c_kde = ed2 CASE ( DATA_ORDER_YZX ) idim = ed3-sd3+1 jdim = ed1-sd1+1 kdim = ed2-sd2+1 c_kds = sd2 ; c_kde = ed2 END SELECT idim_cd = idim / parent_grid_ratio + 1 + 2*shw + 1 jdim_cd = jdim / parent_grid_ratio + 1 + 2*shw + 1 c_ids = i_parent_start-shw ; c_ide = c_ids + idim_cd - 1 c_jds = j_parent_start-shw ; c_jde = c_jds + jdim_cd - 1 c_ips = -1 nj = ( c_jds - j_parent_start ) * parent_grid_ratio + 1 + 1 ; ierr = 0 DO i = c_ids, c_ide ni = ( i - i_parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point ( ni, nj, ids, ide, jds, jde, nest_pes_x(id), nest_pes_y(id),Px,Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",411,& 'error code returned by task_for_point in module_dm.F (a)') IF ( Px .EQ. mytask_x ) THEN c_ipe = i IF ( c_ips .EQ. -1 ) c_ips = i END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",557) END IF IF (c_ips .EQ. -1 ) THEN c_ipe = -1 c_ips = 0 END IF c_jps = -1 ni = ( c_ids - i_parent_start ) * parent_grid_ratio + 1 + 1 ; ierr = 0 DO j = c_jds, c_jde nj = ( j - j_parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point ( ni, nj, ids, ide, jds, jde, nest_pes_x(id), nest_pes_y(id), Px, Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",433,& 'error code returned by task_for_point in module_dm.F (b)') IF ( Py .EQ. mytask_y ) THEN c_jpe = j IF ( c_jps .EQ. -1 ) c_jps = j END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",581) END IF IF (c_jps .EQ. -1 ) THEN c_jpe = -1 c_jps = 0 END IF IF ( c_ips <= c_ipe ) THEN IF ( mytask_x .EQ. 0 ) THEN c_ips = c_ips - shw END IF IF ( mytask_x .EQ. nest_pes_x(id)-1 ) THEN c_ipe = c_ipe + shw END IF c_ims = max( c_ips - max(shw,thisdomain_max_halo_width), c_ids - bdx ) - 1 c_ime = min( c_ipe + max(shw,thisdomain_max_halo_width), c_ide + bdx ) + 1 ELSE c_ims = 0 c_ime = 0 END IF IF ( c_jps <= c_jpe ) THEN IF ( mytask_y .EQ. 0 ) THEN c_jps = c_jps - shw END IF IF ( mytask_y .EQ. nest_pes_y(id)-1 ) THEN c_jpe = c_jpe + shw END IF c_jms = max( c_jps - max(shw,thisdomain_max_halo_width), c_jds - bdx ) - 1 c_jme = min( c_jpe + max(shw,thisdomain_max_halo_width), c_jde + bdx ) + 1 ELSE c_jms = 0 c_jme = 0 END IF c_kps = 1 c_kpe = c_kde c_kms = 1 c_kme = c_kde c_sm1x = 1 ; c_em1x = 1 ; c_sm2x = 1 ; c_em2x = 1 ; c_sm3x = 1 ; c_em3x = 1 c_sm1y = 1 ; c_em1y = 1 ; c_sm2y = 1 ; c_em2y = 1 ; c_sm3y = 1 ; c_em3y = 1 WRITE(wrf_err_message,*)'*************************************' CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'Nesting domain' CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ids,ide,jds,jde ',ids,ide,jds,jde CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ims,ime,jms,jme ',ims,ime,jms,jme CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',ips,ipe,jps,jpe CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'INTERMEDIATE domain' CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ids,ide,jds,jde ',c_ids,c_ide,c_jds,c_jde CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ims,ime,jms,jme ',c_ims,c_ime,c_jms,c_jme CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'ips,ipe,jps,jpe ',c_ips,c_ipe,c_jps,c_jpe CALL wrf_message( TRIM(wrf_err_message) ) WRITE(wrf_err_message,*)'*************************************' CALL wrf_message( TRIM(wrf_err_message) ) SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme c_sd1 = c_kds ; c_ed1 = c_kde ; c_sp1 = c_kps ; c_ep1 = c_kpe ; c_sm1 = c_kms ; c_em1 = c_kme CASE ( DATA_ORDER_ZYX ) c_sd3 = c_ids ; c_ed3 = c_ide ; c_sp3 = c_ips ; c_ep3 = c_ipe ; c_sm3 = c_ims ; c_em3 = c_ime c_sd2 = c_jds ; c_ed2 = c_jde ; c_sp2 = c_jps ; c_ep2 = c_jpe ; c_sm2 = c_jms ; c_em2 = c_jme c_sd1 = c_kds ; c_ed1 = c_kde ; c_sp1 = c_kps ; c_ep1 = c_kpe ; c_sm1 = c_kms ; c_em1 = c_kme CASE ( DATA_ORDER_XYZ ) c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime c_sd2 = c_jds ; c_ed2 = c_jde ; c_sp2 = c_jps ; c_ep2 = c_jpe ; c_sm2 = c_jms ; c_em2 = c_jme c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme CASE ( DATA_ORDER_YXZ) c_sd2 = c_ids ; c_ed2 = c_ide ; c_sp2 = c_ips ; c_ep2 = c_ipe ; c_sm2 = c_ims ; c_em2 = c_ime c_sd1 = c_jds ; c_ed1 = c_jde ; c_sp1 = c_jps ; c_ep1 = c_jpe ; c_sm1 = c_jms ; c_em1 = c_jme c_sd3 = c_kds ; c_ed3 = c_kde ; c_sp3 = c_kps ; c_ep3 = c_kpe ; c_sm3 = c_kms ; c_em3 = c_kme CASE ( DATA_ORDER_XZY ) c_sd1 = c_ids ; c_ed1 = c_ide ; c_sp1 = c_ips ; c_ep1 = c_ipe ; c_sm1 = c_ims ; c_em1 = c_ime c_sd3 = c_jds ; c_ed3 = c_jde ; c_sp3 = c_jps ; c_ep3 = c_jpe ; c_sm3 = c_jms ; c_em3 = c_jme c_sd2 = c_kds ; c_ed2 = c_kde ; c_sp2 = c_kps ; c_ep2 = c_kpe ; c_sm2 = c_kms ; c_em2 = c_kme CASE ( DATA_ORDER_YZX ) c_sd3 = c_ids ; c_ed3 = c_ide ; c_sp3 = c_ips ; c_ep3 = c_ipe ; c_sm3 = c_ims ; c_em3 = c_ime c_sd1 = c_jds ; c_ed1 = c_jde ; c_sp1 = c_jps ; c_ep1 = c_jpe ; c_sm1 = c_jms ; c_em1 = c_jme c_sd2 = c_kds ; c_ed2 = c_kde ; c_sp2 = c_kps ; c_ep2 = c_kpe ; c_sm2 = c_kms ; c_em2 = c_kme END SELECT ALLOCATE ( intermediate_grid ) ALLOCATE ( intermediate_grid%parents( max_parents ) ) ALLOCATE ( intermediate_grid%nests( max_nests ) ) intermediate_grid%allocated=.false. NULLIFY( intermediate_grid%sibling ) DO i = 1, max_nests NULLIFY( intermediate_grid%nests(i)%ptr ) END DO NULLIFY (intermediate_grid%next) NULLIFY (intermediate_grid%same_level) NULLIFY (intermediate_grid%i_start) NULLIFY (intermediate_grid%j_start) NULLIFY (intermediate_grid%i_end) NULLIFY (intermediate_grid%j_end) intermediate_grid%id = id intermediate_grid%num_nests = 0 intermediate_grid%num_siblings = 0 intermediate_grid%num_parents = 1 intermediate_grid%max_tiles = 0 intermediate_grid%num_tiles_spec = 0 intermediate_grid%active_this_task = .true. CALL find_grid_by_id ( id, head_grid, nest_grid ) nest_grid%intermediate_grid => intermediate_grid intermediate_grid%parents(1)%ptr => nest_grid intermediate_grid%num_parents = 1 intermediate_grid%is_intermediate = .TRUE. SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) intermediate_grid%nids = nest_grid%sd32 ; intermediate_grid%njds = nest_grid%sd33 intermediate_grid%nide = nest_grid%ed32 ; intermediate_grid%njde = nest_grid%sd33 CASE ( DATA_ORDER_ZYX ) intermediate_grid%nids = nest_grid%sd33 ; intermediate_grid%njds = nest_grid%sd32 intermediate_grid%nide = nest_grid%ed33 ; intermediate_grid%njde = nest_grid%sd32 CASE ( DATA_ORDER_XYZ ) intermediate_grid%nids = nest_grid%sd31 ; intermediate_grid%njds = nest_grid%sd32 intermediate_grid%nide = nest_grid%ed31 ; intermediate_grid%njde = nest_grid%sd32 CASE ( DATA_ORDER_YXZ) intermediate_grid%nids = nest_grid%sd32 ; intermediate_grid%njds = nest_grid%sd31 intermediate_grid%nide = nest_grid%ed32 ; intermediate_grid%njde = nest_grid%sd31 CASE ( DATA_ORDER_XZY ) intermediate_grid%nids = nest_grid%sd31 ; intermediate_grid%njds = nest_grid%sd33 intermediate_grid%nide = nest_grid%ed31 ; intermediate_grid%njde = nest_grid%sd33 CASE ( DATA_ORDER_YZX ) intermediate_grid%nids = nest_grid%sd33 ; intermediate_grid%njds = nest_grid%sd31 intermediate_grid%nide = nest_grid%ed33 ; intermediate_grid%njde = nest_grid%sd31 END SELECT intermediate_grid%nids = ids intermediate_grid%nide = ide intermediate_grid%njds = jds intermediate_grid%njde = jde intermediate_grid%sm31x = c_sm1x intermediate_grid%em31x = c_em1x intermediate_grid%sm32x = c_sm2x intermediate_grid%em32x = c_em2x intermediate_grid%sm33x = c_sm3x intermediate_grid%em33x = c_em3x intermediate_grid%sm31y = c_sm1y intermediate_grid%em31y = c_em1y intermediate_grid%sm32y = c_sm2y intermediate_grid%em32y = c_em2y intermediate_grid%sm33y = c_sm3y intermediate_grid%em33y = c_em3y CALL alloc_space_field ( intermediate_grid, intermediate_grid%id , 1, 2 , .TRUE., nest_grid%active_this_task, & c_sd1, c_ed1, c_sd2, c_ed2, c_sd3, c_ed3, & c_sm1, c_em1, c_sm2, c_em2, c_sm3, c_em3, & c_sp1, c_ep1, c_sp2, c_ep2, c_sp3, c_ep3, & c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, & c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y, & c_sm1x, c_em1x, c_sm2x, c_em2x, c_sm3x, c_em3x, & c_sm1y, c_em1y, c_sm2y, c_em2y, c_sm3y, c_em3y ) intermediate_grid%sd31 = c_sd1 intermediate_grid%ed31 = c_ed1 intermediate_grid%sp31 = c_sp1 intermediate_grid%ep31 = c_ep1 intermediate_grid%sm31 = c_sm1 intermediate_grid%em31 = c_em1 intermediate_grid%sd32 = c_sd2 intermediate_grid%ed32 = c_ed2 intermediate_grid%sp32 = c_sp2 intermediate_grid%ep32 = c_ep2 intermediate_grid%sm32 = c_sm2 intermediate_grid%em32 = c_em2 intermediate_grid%sd33 = c_sd3 intermediate_grid%ed33 = c_ed3 intermediate_grid%sp33 = c_sp3 intermediate_grid%ep33 = c_ep3 intermediate_grid%sm33 = c_sm3 intermediate_grid%em33 = c_em3 CALL med_add_config_info_to_grid ( intermediate_grid ) intermediate_grid%dx = parent%dx intermediate_grid%dy = parent%dy intermediate_grid%dt = parent%dt END IF RETURN END SUBROUTINE patch_domain_rsl_lite SUBROUTINE compute_memory_dims_rsl_lite ( & id , maxhalowidth , & shw , bdx, bdy , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & imsx, imex, jmsx, jmex, kmsx, kmex, & imsy, imey, jmsy, jmey, kmsy, kmey, & ips, ipe, jps, jpe, kps, kpe, & ipsx, ipex, jpsx, jpex, kpsx, kpex, & ipsy, ipey, jpsy, jpey, kpsy, kpey ) IMPLICIT NONE INTEGER, INTENT(IN) :: id , maxhalowidth INTEGER, INTENT(IN) :: shw, bdx, bdy INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme INTEGER, INTENT(OUT) :: imsx, imex, jmsx, jmex, kmsx, kmex INTEGER, INTENT(OUT) :: imsy, imey, jmsy, jmey, kmsy, kmey INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe INTEGER, INTENT(OUT) :: ipsx, ipex, jpsx, jpex, kpsx, kpex INTEGER, INTENT(OUT) :: ipsy, ipey, jpsy, jpey, kpsy, kpey INTEGER Px, Py, P, i, j, k, ierr ips = -1 j = jds ierr = 0 DO i = ids, ide CALL task_for_point ( i, j, ids, ide, jds, jde, nest_pes_x(id), nest_pes_y(id), Px, Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",658,& 'error code returned by task_for_point in module_dm.F (c)') IF ( Px .EQ. mytask_x ) THEN ipe = i IF ( ips .EQ. -1 ) ips = i END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",1009) END IF IF (ips .EQ. -1 ) THEN ipe = -1 ips = 0 END IF jps = -1 i = ids ierr = 0 DO j = jds, jde CALL task_for_point ( i, j, ids, ide, jds, jde, nest_pes_x(id), nest_pes_y(id), Px, Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",680,& 'error code returned by task_for_point in module_dm.F (d)') IF ( Py .EQ. mytask_y ) THEN jpe = j IF ( jps .EQ. -1 ) jps = j END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",1031) END IF IF (jps .EQ. -1 ) THEN jpe = -1 jps = 0 END IF IF (ipe .EQ. -1 .or. jpe .EQ. -1) THEN ipe = -1 ips = 0 jpe = -1 jps = 0 END IF kpsx = -1 j = jds ; ierr = 0 DO k = kds, kde CALL task_for_point ( k, j, kds, kde, jds, jde, nest_pes_x(id), nest_pes_y(id), Px, Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",748,& 'error code returned by task_for_point in module_dm.F (e)') IF ( Px .EQ. mytask_x ) THEN kpex = k IF ( kpsx .EQ. -1 ) kpsx = k END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",1104) END IF IF (kpsx .EQ. -1 ) THEN kpex = -1 kpsx = 0 END IF jpsx = -1 k = kds ; ierr = 0 DO j = jds, jde CALL task_for_point ( k, j, kds, kde, jds, jde, nest_pes_x(id), nest_pes_y(id), Px, Py, & minx, miny, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",771,& 'error code returned by task_for_point in module_dm.F (f)') IF ( Py .EQ. mytask_y ) THEN jpex = j IF ( jpsx .EQ. -1 ) jpsx = j END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",1128) END IF IF (jpsx .EQ. -1 ) THEN jpex = -1 jpsx = 0 END IF IF (jpex .EQ. -1) THEN ipex = -1 ipsx = 0 jpex = -1 jpsx = 0 END IF kpsy = kpsx kpey = kpex ipsy = -1 k = kds ; ierr = 0 DO i = ids, ide CALL task_for_point ( i, k, ids, ide, kds, kde, nest_pes_y(id), nest_pes_x(id), Py, Px, & miny, minx, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",806,& 'error code returned by task_for_point in module_dm.F (g)') IF ( Py .EQ. mytask_y ) THEN ipey = i IF ( ipsy .EQ. -1 ) ipsy = i END IF END DO IF ( ierr .NE. 0 ) THEN CALL tfp_message("module_dm.G",1166) END IF IF (ipsy .EQ. -1 ) THEN ipey = -1 ipsy = 0 END IF IF ( ips < ipe .and. jps < jpe ) THEN IF ( mytask_x .EQ. 0 ) THEN ips = ips - shw ipsy = ipsy - shw END IF IF ( mytask_x .EQ. nest_pes_x(id)-1 ) THEN ipe = ipe + shw ipey = ipey + shw END IF IF ( mytask_y .EQ. 0 ) THEN jps = jps - shw jpsx = jpsx - shw END IF IF ( mytask_y .EQ. nest_pes_y(id)-1 ) THEN jpe = jpe + shw jpex = jpex + shw END IF END IF kps = 1 kpe = kde-kds+1 kms = 1 kme = kpe kmsx = kpsx kmex = kpex kmsy = kpsy kmey = kpey IF ( kpsx .EQ. 0 .AND. kpex .EQ. -1 ) THEN kmsx = 0 kmex = 0 END IF IF ( kpsy .EQ. 0 .AND. kpey .EQ. -1 ) THEN kmsy = 0 kmey = 0 END IF IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN ims = 0 ime = 0 ELSE ims = max( ips - max(shw,maxhalowidth), ids - bdx ) - 1 ime = min( ipe + max(shw,maxhalowidth), ide + bdx ) + 1 END IF imsx = ids imex = ide ipsx = imsx ipex = imex IF ( ipsy .EQ. 0 .AND. ipey .EQ. -1 ) THEN imsy = 0 imey = 0 ELSE imsy = ipsy imey = ipey END IF IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN jms = 0 jme = 0 ELSE jms = max( jps - max(shw,maxhalowidth), jds - bdy ) - 1 jme = min( jpe + max(shw,maxhalowidth), jde + bdy ) + 1 END IF jmsx = jpsx jmex = jpex jmsy = jds jmey = jde IF ( jpsx .EQ. 0 .AND. jpex .EQ. -1 ) THEN jmsx = 0 jmex = 0 jpsy = 0 jpey = -1 ELSE jpsy = jmsy jpey = jmey END IF END SUBROUTINE compute_memory_dims_rsl_lite INTEGER function getrealmpitype() IMPLICIT NONE INTEGER rtypesize, dtypesize, ierr CALL mpi_type_size ( MPI_REAL, rtypesize, ierr ) CALL mpi_type_size ( MPI_DOUBLE_PRECISION, dtypesize, ierr ) IF ( 4 .EQ. rtypesize ) THEN getrealmpitype = MPI_REAL ELSE IF ( 4 .EQ. dtypesize ) THEN getrealmpitype = MPI_DOUBLE_PRECISION ELSE CALL wrf_error_fatal3("",911,& 'RWORDSIZE or DWORDSIZE does not match any MPI type' ) END IF RETURN END FUNCTION getrealmpitype REAL FUNCTION wrf_dm_max_int ( inval ) IMPLICIT NONE INCLUDE 'mpif.h' INTEGER, intent(in) :: inval INTEGER :: ierr, retval CALL mpi_allreduce ( inval, retval , 1, MPI_INT, MPI_MAX, local_communicator, ierr ) wrf_dm_max_int = retval END FUNCTION wrf_dm_max_int REAL FUNCTION wrf_dm_max_real ( inval ) IMPLICIT NONE REAL inval, retval INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MAX, comm, ierr ) wrf_dm_max_real = retval END FUNCTION wrf_dm_max_real REAL FUNCTION wrf_dm_min_real ( inval ) IMPLICIT NONE REAL inval, retval INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_MIN, comm, ierr ) wrf_dm_min_real = retval END FUNCTION wrf_dm_min_real SUBROUTINE wrf_dm_min_reals ( inval, retval, n ) IMPLICIT NONE INTEGER n REAL inval(*) REAL retval(*) INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , n, getrealmpitype(), MPI_MIN, comm, ierr ) END SUBROUTINE wrf_dm_min_reals FUNCTION wrf_dm_sum_real8 ( inval ) IMPLICIT NONE REAL*8 inval, retval, wrf_dm_sum_real8 INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, MPI_REAL8, MPI_SUM, comm, ierr ) wrf_dm_sum_real8 = retval END FUNCTION wrf_dm_sum_real8 REAL FUNCTION wrf_dm_sum_real ( inval ) IMPLICIT NONE REAL inval, retval INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, getrealmpitype(), MPI_SUM, comm, ierr ) wrf_dm_sum_real = retval END FUNCTION wrf_dm_sum_real SUBROUTINE wrf_dm_sum_reals (inval, retval) IMPLICIT NONE REAL, INTENT(IN) :: inval(:) REAL, INTENT(OUT) :: retval(:) INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval, SIZE(inval), getrealmpitype(), MPI_SUM, comm, ierr ) END SUBROUTINE wrf_dm_sum_reals INTEGER FUNCTION wrf_dm_sum_integer ( inval ) IMPLICIT NONE INTEGER inval, retval INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, MPI_INTEGER, MPI_SUM, comm, ierr ) wrf_dm_sum_integer = retval END FUNCTION wrf_dm_sum_integer SUBROUTINE wrf_dm_sum_integers (inval, retval) IMPLICIT NONE INTEGER, INTENT(IN) :: inval(:) INTEGER, INTENT(OUT) :: retval(:) INTEGER comm,ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval, SIZE(inval), MPI_INTEGER, MPI_SUM, comm, ierr ) END SUBROUTINE wrf_dm_sum_integers INTEGER FUNCTION wrf_dm_bxor_integer ( inval ) IMPLICIT NONE INTEGER inval, retval INTEGER comm, ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, MPI_INTEGER, MPI_BXOR, comm, ierr ) wrf_dm_bxor_integer = retval END FUNCTION wrf_dm_bxor_integer LOGICAL FUNCTION wrf_dm_lor_logical ( inval ) IMPLICIT NONE LOGICAL inval, retval INTEGER comm, ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, MPI_LOGICAL, MPI_LOR, comm, ierr ) wrf_dm_lor_logical = retval END FUNCTION wrf_dm_lor_logical LOGICAL FUNCTION wrf_dm_land_logical ( inval ) IMPLICIT NONE LOGICAL inval, retval INTEGER comm, ierr CALL wrf_get_dm_communicator(comm) CALL mpi_allreduce ( inval, retval , 1, MPI_LOGICAL, MPI_LAND, comm, ierr ) wrf_dm_land_logical = retval END FUNCTION wrf_dm_land_logical SUBROUTINE wrf_dm_maxval_real ( val, idex, jdex ) use mpi IMPLICIT NONE REAL val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank REAL :: inreduce(2),outreduce(2) inreduce=(/ val, real(mytask) /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2REAL,& MPI_MAXLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_REAL,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_maxval_real SUBROUTINE wrf_dm_minval_real ( val, idex, jdex ) use mpi IMPLICIT NONE REAL val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank REAL :: inreduce(2),outreduce(2) inreduce=(/ val, real(mytask) /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2REAL,& MPI_MINLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_REAL,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_minval_real SUBROUTINE wrf_dm_maxval_doubleprecision ( val, idex, jdex ) use mpi IMPLICIT NONE DOUBLE PRECISION val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank DOUBLE PRECISION :: inreduce(2),outreduce(2) inreduce=(/ val, dble(mytask) /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2DOUBLE_PRECISION,& MPI_MAXLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_DOUBLE_PRECISION,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_maxval_doubleprecision SUBROUTINE wrf_dm_minval_doubleprecision ( val, idex, jdex ) use mpi IMPLICIT NONE DOUBLE PRECISION val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank DOUBLE PRECISION :: inreduce(2),outreduce(2) inreduce=(/ val, dble(mytask) /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2DOUBLE_PRECISION,& MPI_MINLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_DOUBLE_PRECISION,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_minval_doubleprecision SUBROUTINE wrf_dm_maxval_integer ( val, idex, jdex ) use mpi IMPLICIT NONE INTEGER val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank INTEGER :: inreduce(2),outreduce(2) inreduce=(/ val, mytask /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2INTEGER,& MPI_MAXLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_INTEGER,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_maxval_integer SUBROUTINE wrf_dm_minval_integer ( val, idex, jdex ) use mpi IMPLICIT NONE INTEGER val INTEGER :: idex, jdex, i, comm INTEGER :: bcast(2),mrank INTEGER :: inreduce(2),outreduce(2) inreduce=(/ val, mytask /) bcast=(/ idex,jdex /) CALL wrf_get_dm_communicator(comm) call MPI_Allreduce(inreduce,outreduce,1,MPI_2INTEGER,& MPI_MINLOC,comm,i) mrank=outreduce(2) val=outreduce(1) call MPI_Bcast(bcast,2,MPI_INTEGER,mrank,comm,i) idex=bcast(1) jdex=bcast(2) END SUBROUTINE wrf_dm_minval_integer SUBROUTINE hwrf_coupler_init END SUBROUTINE hwrf_coupler_init SUBROUTINE split_communicator IMPLICIT NONE LOGICAL mpi_inited INTEGER mpi_comm_here, mpi_comm_local, comdup, comdup2, origmytask, ierr, io_status INTEGER mpi_comm_me_and_mom INTEGER coords(3) INTEGER mytask_local,ntasks_local,num_compute_tasks INTEGER i, j, k, x, y, n_x, n_y INTEGER iii INTEGER, ALLOCATABLE :: icolor(:),icolor2(:),idomain(:) INTEGER comm_id INTEGER dims(3) INTEGER :: id INTEGER :: intercomm INTEGER :: domain_id,par_id,nest_id,kid_id INTEGER :: mytask_me_and_mom, ntasks_me_and_mom, remote_leader LOGICAL :: inthisone LOGICAL :: mytask_is_nest, mytask_is_par,isperiodic(3) LOGICAL :: quilting_is_turned_off integer :: first_item_in_struct integer :: run_days integer :: run_hours integer :: run_minutes integer :: run_seconds integer , DIMENSION(max_domains) :: start_year integer , DIMENSION(max_domains) :: start_month integer , DIMENSION(max_domains) :: start_day integer , DIMENSION(max_domains) :: start_hour integer , DIMENSION(max_domains) :: start_minute integer , DIMENSION(max_domains) :: start_second integer , DIMENSION(max_domains) :: end_year integer , DIMENSION(max_domains) :: end_month integer , DIMENSION(max_domains) :: end_day integer , DIMENSION(max_domains) :: end_hour integer , DIMENSION(max_domains) :: end_minute integer , DIMENSION(max_domains) :: end_second integer :: interval_seconds logical , DIMENSION(max_domains) :: input_from_file integer , DIMENSION(max_domains) :: fine_input_stream logical , DIMENSION(max_domains) :: input_from_hires character*256 :: rsmas_data_path logical :: all_ic_times integer , DIMENSION(max_domains) :: reset_interval1 integer , DIMENSION(max_domains) :: julyr integer , DIMENSION(max_domains) :: julday real , DIMENSION(max_domains) :: gmt character*256 :: input_inname character*256 :: input_outname character*256 :: bdy_inname character*256 :: bdy_outname character*256 :: rst_inname character*256 :: rst_outname logical :: write_input logical :: write_restart_at_0h logical :: write_hist_at_0h_rst logical :: adjust_output_times logical :: adjust_input_times integer :: diag_print logical :: nocolons logical :: cycling integer :: output_diagnostics integer :: nwp_diagnostics integer :: gsd_diagnostics integer :: wind_int integer :: diag_int logical :: output_ready_flag logical :: usepio integer :: pioprocs integer :: piostart integer :: piostride integer :: pioshift integer :: dfi_opt integer :: dfi_savehydmeteors integer :: dfi_nfilter logical :: dfi_write_filtered_input logical :: dfi_write_dfi_history integer :: dfi_cutoff_seconds integer :: dfi_time_dim integer :: dfi_fwdstop_year integer :: dfi_fwdstop_month integer :: dfi_fwdstop_day integer :: dfi_fwdstop_hour integer :: dfi_fwdstop_minute integer :: dfi_fwdstop_second integer :: dfi_bckstop_year integer :: dfi_bckstop_month integer :: dfi_bckstop_day integer :: dfi_bckstop_hour integer :: dfi_bckstop_minute integer :: dfi_bckstop_second integer :: time_step integer :: time_step_fract_num integer :: time_step_fract_den integer :: time_step_dfi integer , DIMENSION(max_domains) :: min_time_step integer , DIMENSION(max_domains) :: min_time_step_den integer , DIMENSION(max_domains) :: max_time_step integer , DIMENSION(max_domains) :: max_time_step_den real , DIMENSION(max_domains) :: target_cfl real , DIMENSION(max_domains) :: target_hcfl integer , DIMENSION(max_domains) :: max_step_increase_pct integer , DIMENSION(max_domains) :: starting_time_step integer , DIMENSION(max_domains) :: starting_time_step_den logical :: step_to_output_time integer :: adaptation_domain logical :: use_adaptive_time_step logical :: use_adaptive_time_step_dfi integer :: max_dom integer :: lats_to_mic integer , DIMENSION(max_domains) :: s_we integer , DIMENSION(max_domains) :: e_we integer , DIMENSION(max_domains) :: s_sn integer , DIMENSION(max_domains) :: e_sn integer , DIMENSION(max_domains) :: s_vert integer , DIMENSION(max_domains) :: e_vert integer :: num_metgrid_levels integer :: num_metgrid_soil_levels real :: p_top_requested logical :: interp_theta integer :: interp_type integer :: rebalance integer , DIMENSION(max_domains) :: vert_refine_method integer :: vert_refine_fact integer :: extrap_type integer :: t_extrap_type integer :: hypsometric_opt logical :: lowest_lev_from_sfc logical :: use_levels_below_ground logical :: use_tavg_for_tsk logical :: use_surface integer :: lagrange_order integer :: force_sfc_in_vinterp real :: zap_close_levels real :: maxw_horiz_pres_diff real :: trop_horiz_pres_diff real :: maxw_above_this_level integer :: use_maxw_level integer :: use_trop_level logical :: sfcp_to_sfcp logical :: adjust_heights logical :: smooth_cg_topo integer :: nest_interp_coord integer :: interp_method_type logical :: aggregate_lu logical :: rh2qv_wrt_liquid integer :: rh2qv_method real :: qv_max_p_safe real :: qv_max_flag real :: qv_max_value real :: qv_min_p_safe real :: qv_min_flag real :: qv_min_value integer :: ideal_init_method real , DIMENSION(max_domains) :: dx real , DIMENSION(max_domains) :: dy integer , DIMENSION(max_domains) :: grid_id logical , DIMENSION(max_domains) :: grid_allowed integer , DIMENSION(max_domains) :: parent_id integer , DIMENSION(max_domains) :: i_parent_start integer , DIMENSION(max_domains) :: j_parent_start integer , DIMENSION(max_domains) :: parent_grid_ratio integer , DIMENSION(max_domains) :: parent_time_step_ratio integer :: feedback integer :: smooth_option integer :: blend_width real , DIMENSION(max_domains) :: ztop integer , DIMENSION(max_domains) :: moad_grid_ratio integer , DIMENSION(max_domains) :: moad_time_step_ratio integer , DIMENSION(max_domains) :: shw integer :: tile_sz_x integer :: tile_sz_y integer :: numtiles integer :: numtiles_inc integer :: numtiles_x integer :: numtiles_y integer :: tile_strategy integer :: nproc_x integer :: nproc_y integer :: irand real , DIMENSION(max_domains) :: dt integer :: fft_used integer :: cu_used integer :: shcu_used integer :: cam_used integer :: alloc_qndropsource integer :: num_moves integer :: ts_buf_size integer :: max_ts_locs integer , DIMENSION(max_domains) :: vortex_interval integer , DIMENSION(max_domains) :: max_vortex_speed integer , DIMENSION(max_domains) :: corral_dist integer :: track_level real , DIMENSION(max_domains) :: time_to_move integer , DIMENSION(max_moves) :: move_id integer , DIMENSION(max_moves) :: move_interval integer , DIMENSION(max_moves) :: move_cd_x integer , DIMENSION(max_moves) :: move_cd_y logical , DIMENSION(max_domains) :: swap_x logical , DIMENSION(max_domains) :: swap_y logical , DIMENSION(max_domains) :: cycle_x logical , DIMENSION(max_domains) :: cycle_y logical :: reorder_mesh logical :: perturb_input real , DIMENSION(max_eta) :: eta_levels real :: max_dz integer :: ocean_levels real , DIMENSION(max_ocean) :: ocean_z real , DIMENSION(max_ocean) :: ocean_t real , DIMENSION(max_ocean) :: ocean_s integer :: num_traj integer :: max_ts_level integer :: track_loc_in integer :: num_ext_model_couple_dom logical :: insert_bogus_storm logical :: remove_storm integer :: num_storm real , DIMENSION(max_bogus) :: latc_loc real , DIMENSION(max_bogus) :: lonc_loc real , DIMENSION(max_bogus) :: vmax_meters_per_second real , DIMENSION(max_bogus) :: rmax real , DIMENSION(max_bogus) :: vmax_ratio real :: rankine_lid character*256 :: physics_suite logical :: force_read_thompson logical :: write_thompson_tables integer , DIMENSION(max_domains) :: mp_physics real , DIMENSION(max_domains) :: nssl_cccn real , DIMENSION(max_domains) :: nssl_alphah real , DIMENSION(max_domains) :: nssl_alphahl real , DIMENSION(max_domains) :: nssl_cnoh real , DIMENSION(max_domains) :: nssl_cnohl real , DIMENSION(max_domains) :: nssl_cnor real , DIMENSION(max_domains) :: nssl_cnos real , DIMENSION(max_domains) :: nssl_rho_qh real , DIMENSION(max_domains) :: nssl_rho_qhl real , DIMENSION(max_domains) :: nssl_rho_qs integer , DIMENSION(max_domains) :: nudge_lightning integer , DIMENSION(max_domains) :: nudge_light_times integer , DIMENSION(max_domains) :: nudge_light_timee integer , DIMENSION(max_domains) :: nudge_light_int character*256 :: path_to_files integer :: gsfcgce_hail integer :: gsfcgce_2ice integer , DIMENSION(max_domains) :: progn real :: accum_mode real :: aitken_mode real :: coarse_mode integer :: do_radar_ref integer :: compute_radar_ref integer , DIMENSION(max_domains) :: ra_lw_physics integer , DIMENSION(max_domains) :: ra_sw_physics integer :: ra_sw_eclipse real , DIMENSION(max_domains) :: radt real , DIMENSION(max_domains) :: naer integer , DIMENSION(max_domains) :: alb_sol integer , DIMENSION(max_domains) :: sf_sfclay_physics integer , DIMENSION(max_domains) :: sf_surface_physics integer , DIMENSION(max_domains) :: bl_pbl_physics integer , DIMENSION(max_domains) :: bl_mynn_tkebudget integer :: ysu_topdown_pblmix integer , DIMENSION(max_domains) :: shinhong_tke_diag logical , DIMENSION(max_domains) :: bl_mynn_tkeadvect integer :: bl_mynn_cloudpdf integer :: bl_mynn_mixlength integer , DIMENSION(max_domains) :: bl_mynn_edmf integer , DIMENSION(max_domains) :: bl_mynn_edmf_mom integer , DIMENSION(max_domains) :: bl_mynn_edmf_tke integer , DIMENSION(max_domains) :: bl_mynn_mixscalars integer , DIMENSION(max_domains) :: bl_mynn_cloudmix integer , DIMENSION(max_domains) :: bl_mynn_mixqt integer :: icloud_bl integer , DIMENSION(max_domains) :: mfshconv integer , DIMENSION(max_domains) :: sf_urban_physics real , DIMENSION(max_domains) :: bldt integer , DIMENSION(max_domains) :: cu_physics integer , DIMENSION(max_domains) :: shcu_physics integer , DIMENSION(max_domains) :: cu_diag integer , DIMENSION(max_domains) :: kf_edrates integer :: kfeta_trigger integer :: nsas_dx_factor real , DIMENSION(max_domains) :: cudt real , DIMENSION(max_domains) :: gsmdt integer :: isfflx integer :: ifsnow integer :: icloud integer :: ideal_xland real :: swrad_scat integer :: surface_input_source integer :: num_soil_layers integer :: maxpatch integer :: num_snow_layers integer :: num_snso_layers integer :: num_urban_layers integer :: num_urban_hi integer :: num_months integer :: sf_surface_mosaic integer :: mosaic_cat integer :: mosaic_cat_soil integer :: mosaic_lu integer :: mosaic_soil integer :: flag_sm_adj integer :: maxiens integer :: maxens integer :: maxens2 integer :: maxens3 integer :: ensdim integer :: cugd_avedx integer :: clos_choice integer :: imomentum integer :: ishallow real :: convtrans_avglen_m integer :: num_land_cat integer :: num_soil_cat integer :: mp_zero_out real :: mp_zero_out_thresh real :: seaice_threshold integer :: sst_update integer :: sst_skin integer :: tmn_update logical :: usemonalb logical :: rdmaxalb logical :: rdlai2d logical :: ua_phys integer :: opt_thcnd integer :: co2tf integer :: ra_call_offset real :: cam_abs_freq_s integer :: levsiz integer :: paerlev integer :: cam_abs_dim1 integer :: cam_abs_dim2 integer :: lagday integer :: no_src_types integer :: alevsiz integer :: o3input integer :: aer_opt integer :: swint_opt integer , DIMENSION(max_domains) :: aer_type integer , DIMENSION(max_domains) :: aer_aod550_opt integer , DIMENSION(max_domains) :: aer_angexp_opt integer , DIMENSION(max_domains) :: aer_ssa_opt integer , DIMENSION(max_domains) :: aer_asy_opt real , DIMENSION(max_domains) :: aer_aod550_val real , DIMENSION(max_domains) :: aer_angexp_val real , DIMENSION(max_domains) :: aer_ssa_val real , DIMENSION(max_domains) :: aer_asy_val logical , DIMENSION(max_domains) :: cu_rad_feedback logical , DIMENSION(max_domains) :: shallowcu_forced_ra integer , DIMENSION(max_domains) :: numbins real , DIMENSION(max_domains) :: thbinsize real , DIMENSION(max_domains) :: rbinsize real , DIMENSION(max_domains) :: mindeepfreq real , DIMENSION(max_domains) :: minshallowfreq integer , DIMENSION(max_domains) :: shcu_aerosols_opt integer , DIMENSION(max_domains) :: icloud_cu integer , DIMENSION(max_domains) :: pxlsm_smois_init integer :: omlcall integer :: sf_ocean_physics integer :: traj_opt logical , DIMENSION(max_domains) :: dm_has_traj integer :: tracercall real :: omdt real :: oml_hml0 real :: oml_gamma real :: oml_relaxation_time integer :: isftcflx integer :: iz0tlnd real :: shadlen integer , DIMENSION(max_domains) :: slope_rad integer , DIMENSION(max_domains) :: topo_shading integer , DIMENSION(max_domains) :: topo_wind integer :: no_mp_heating integer :: fractional_seaice integer :: seaice_snowdepth_opt real :: seaice_snowdepth_max real :: seaice_snowdepth_min integer :: seaice_albedo_opt real :: seaice_albedo_default integer :: seaice_thickness_opt real :: seaice_thickness_default logical :: tice2tsk_if2cold real :: bucket_mm real :: bucket_j integer :: mp_tend_radar real :: mp_tend_lim real , DIMENSION(max_domains) :: prec_acc_dt real , DIMENSION(max_domains) :: prec_acc_dt1 integer :: prec_acc_opt integer :: bucketr_opt integer :: bucketf_opt integer :: process_time_series integer , DIMENSION(max_domains) :: grav_settling real , DIMENSION(max_domains) :: sas_pgcon integer , DIMENSION(max_domains) :: scalar_pblmix integer , DIMENSION(max_domains) :: tracer_pblmix logical :: use_aero_icbc logical :: use_rap_aero_icbc integer :: use_mp_re real :: ccn_conc integer :: hail_opt integer :: dveg integer :: opt_crs integer :: opt_btr integer :: opt_run integer :: opt_sfc integer :: opt_frz integer :: opt_inf integer :: opt_rad integer :: opt_alb integer :: opt_snf integer :: opt_tbot integer :: opt_stc integer :: opt_gla integer :: opt_rsf real , DIMENSION(max_domains) :: wtddt integer :: wrf_hydro real , DIMENSION(max_domains) :: fgdt integer , DIMENSION(max_domains) :: fgdtzero integer , DIMENSION(max_domains) :: grid_fdda integer , DIMENSION(max_domains) :: grid_sfdda integer , DIMENSION(max_domains) :: if_no_pbl_nudging_uv integer , DIMENSION(max_domains) :: if_no_pbl_nudging_t integer , DIMENSION(max_domains) :: if_no_pbl_nudging_ph integer , DIMENSION(max_domains) :: if_no_pbl_nudging_q integer , DIMENSION(max_domains) :: if_zfac_uv integer , DIMENSION(max_domains) :: k_zfac_uv integer , DIMENSION(max_domains) :: if_zfac_t integer , DIMENSION(max_domains) :: k_zfac_t integer , DIMENSION(max_domains) :: if_zfac_ph integer , DIMENSION(max_domains) :: k_zfac_ph integer , DIMENSION(max_domains) :: if_zfac_q integer , DIMENSION(max_domains) :: k_zfac_q integer , DIMENSION(max_domains) :: dk_zfac_uv integer , DIMENSION(max_domains) :: dk_zfac_t integer , DIMENSION(max_domains) :: dk_zfac_ph real , DIMENSION(max_domains) :: guv real , DIMENSION(max_domains) :: guv_sfc real , DIMENSION(max_domains) :: gt real , DIMENSION(max_domains) :: gt_sfc real , DIMENSION(max_domains) :: gq real , DIMENSION(max_domains) :: gq_sfc real , DIMENSION(max_domains) :: gph real :: dtramp_min integer :: if_ramping real , DIMENSION(max_domains) :: rinblw integer , DIMENSION(max_domains) :: xwavenum integer , DIMENSION(max_domains) :: ywavenum integer , DIMENSION(max_domains) :: pxlsm_soil_nudge integer , DIMENSION(max_domains) :: fasdas integer , DIMENSION(max_domains) :: obs_nudge_opt integer :: max_obs real , DIMENSION(max_domains) :: fdda_start real , DIMENSION(max_domains) :: fdda_end integer , DIMENSION(max_domains) :: obs_nudge_wind real , DIMENSION(max_domains) :: obs_coef_wind integer , DIMENSION(max_domains) :: obs_nudge_temp real , DIMENSION(max_domains) :: obs_coef_temp integer , DIMENSION(max_domains) :: obs_nudge_mois real , DIMENSION(max_domains) :: obs_coef_mois integer , DIMENSION(max_domains) :: obs_nudge_pstr real , DIMENSION(max_domains) :: obs_coef_pstr integer , DIMENSION(max_domains) :: obs_no_pbl_nudge_uv integer , DIMENSION(max_domains) :: obs_no_pbl_nudge_t integer , DIMENSION(max_domains) :: obs_no_pbl_nudge_q integer :: obs_sfc_scheme_horiz integer :: obs_sfc_scheme_vert real :: obs_max_sndng_gap real :: obs_nudgezfullr1_uv real :: obs_nudgezrampr1_uv real :: obs_nudgezfullr2_uv real :: obs_nudgezrampr2_uv real :: obs_nudgezfullr4_uv real :: obs_nudgezrampr4_uv real :: obs_nudgezfullr1_t real :: obs_nudgezrampr1_t real :: obs_nudgezfullr2_t real :: obs_nudgezrampr2_t real :: obs_nudgezfullr4_t real :: obs_nudgezrampr4_t real :: obs_nudgezfullr1_q real :: obs_nudgezrampr1_q real :: obs_nudgezfullr2_q real :: obs_nudgezrampr2_q real :: obs_nudgezfullr4_q real :: obs_nudgezrampr4_q real :: obs_nudgezfullmin real :: obs_nudgezrampmin real :: obs_nudgezmax real :: obs_sfcfact real :: obs_sfcfacr real :: obs_dpsmx real , DIMENSION(max_domains) :: obs_rinxy real :: obs_rinsig real , DIMENSION(max_domains) :: obs_twindo integer :: obs_npfi integer , DIMENSION(max_domains) :: obs_ionf integer :: obs_idynin real :: obs_dtramp integer :: obs_prt_max integer , DIMENSION(max_domains) :: obs_prt_freq logical :: obs_ipf_in4dob logical :: obs_ipf_errob logical :: obs_ipf_nudob logical :: obs_ipf_init integer :: obs_scl_neg_qv_innov integer :: scm_force real :: scm_force_dx integer :: num_force_layers integer :: scm_lu_index integer :: scm_isltyp real :: scm_vegfra real :: scm_canwat real :: scm_lat real :: scm_lon logical :: scm_th_t_tend logical :: scm_qv_t_tend logical :: scm_th_adv logical :: scm_wind_adv logical :: scm_qv_adv logical :: scm_ql_adv logical :: scm_vert_adv integer :: num_force_soil_layers logical :: scm_soilt_force logical :: scm_soilq_force logical :: scm_force_th_largescale logical :: scm_force_qv_largescale logical :: scm_force_ql_largescale logical :: scm_force_wind_largescale integer :: scm_force_skintemp integer :: scm_force_flux integer :: dyn_opt integer :: rk_ord integer :: w_damping real :: w_crit_cfl integer :: zadvect_implicit integer , DIMENSION(max_domains) :: diff_opt integer , DIMENSION(max_domains) :: diff_opt_dfi integer , DIMENSION(max_domains) :: km_opt integer , DIMENSION(max_domains) :: km_opt_dfi integer :: damp_opt integer :: rad_nudge integer :: gwd_opt real , DIMENSION(max_domains) :: zdamp real , DIMENSION(max_domains) :: dampcoef real , DIMENSION(max_domains) :: khdif real , DIMENSION(max_domains) :: kvdif real , DIMENSION(max_domains) :: diff_6th_factor real , DIMENSION(max_domains) :: diff_6th_factor2 integer , DIMENSION(max_domains) :: diff_6th_opt integer , DIMENSION(max_domains) :: diff_6th_slopeopt real , DIMENSION(max_domains) :: diff_6th_thresh integer :: use_theta_m integer :: use_q_diabatic real , DIMENSION(max_domains) :: c_s real , DIMENSION(max_domains) :: c_k real , DIMENSION(max_domains) :: smdiv real , DIMENSION(max_domains) :: emdiv real , DIMENSION(max_domains) :: epssm logical , DIMENSION(max_domains) :: non_hydrostatic logical :: use_input_w integer , DIMENSION(max_domains) :: time_step_sound integer , DIMENSION(max_domains) :: h_mom_adv_order integer , DIMENSION(max_domains) :: v_mom_adv_order integer , DIMENSION(max_domains) :: h_sca_adv_order integer , DIMENSION(max_domains) :: v_sca_adv_order integer , DIMENSION(max_domains) :: momentum_adv_opt integer , DIMENSION(max_domains) :: moist_adv_opt integer , DIMENSION(max_domains) :: moist_adv_dfi_opt integer , DIMENSION(max_domains) :: chem_adv_opt integer , DIMENSION(max_domains) :: tracer_adv_opt integer , DIMENSION(max_domains) :: scalar_adv_opt integer , DIMENSION(max_domains) :: tke_adv_opt logical , DIMENSION(max_domains) :: moist_mix2_off logical , DIMENSION(max_domains) :: chem_mix2_off logical , DIMENSION(max_domains) :: tracer_mix2_off logical , DIMENSION(max_domains) :: scalar_mix2_off logical , DIMENSION(max_domains) :: tke_mix2_off logical , DIMENSION(max_domains) :: moist_mix6_off logical , DIMENSION(max_domains) :: chem_mix6_off logical , DIMENSION(max_domains) :: tracer_mix6_off logical , DIMENSION(max_domains) :: scalar_mix6_off logical , DIMENSION(max_domains) :: tke_mix6_off logical , DIMENSION(max_domains) :: top_radiation integer , DIMENSION(max_domains) :: mix_isotropic real , DIMENSION(max_domains) :: mix_upper_bound logical , DIMENSION(max_domains) :: top_lid real , DIMENSION(max_domains) :: tke_upper_bound real , DIMENSION(max_domains) :: tke_drag_coefficient real , DIMENSION(max_domains) :: tke_heat_flux logical , DIMENSION(max_domains) :: pert_coriolis logical , DIMENSION(max_domains) :: coriolis2d logical , DIMENSION(max_domains) :: mix_full_fields real :: base_pres real :: base_temp real :: base_lapse real :: iso_temp real :: base_pres_strat real :: base_lapse_strat logical :: use_baseparam_fr_nml real :: fft_filter_lat logical :: coupled_filtering logical :: pos_def logical :: swap_pole_with_next_j logical :: actual_distance_average logical :: rotated_pole logical , DIMENSION(max_domains) :: do_coriolis logical , DIMENSION(max_domains) :: do_curvature logical , DIMENSION(max_domains) :: do_gradp integer , DIMENSION(max_domains) :: tracer_opt integer , DIMENSION(max_domains) :: tenddiag integer :: spec_bdy_width integer :: spec_zone integer :: relax_zone logical , DIMENSION(max_domains) :: specified logical :: constant_bc logical , DIMENSION(max_domains) :: periodic_x logical , DIMENSION(max_domains) :: symmetric_xs logical , DIMENSION(max_domains) :: symmetric_xe logical , DIMENSION(max_domains) :: open_xs logical , DIMENSION(max_domains) :: open_xe logical , DIMENSION(max_domains) :: periodic_y logical , DIMENSION(max_domains) :: symmetric_ys logical , DIMENSION(max_domains) :: symmetric_ye logical , DIMENSION(max_domains) :: open_ys logical , DIMENSION(max_domains) :: open_ye logical , DIMENSION(max_domains) :: polar logical , DIMENSION(max_domains) :: nested real :: spec_exp integer :: spec_bdy_final_mu integer :: real_data_init_type logical , DIMENSION(max_domains) :: have_bcs_moist logical , DIMENSION(max_domains) :: have_bcs_scalar integer :: background_proc_id integer :: forecast_proc_id integer :: production_status integer :: compression integer :: nobs_ndg_vars integer :: nobs_err_flds real , DIMENSION(max_domains) :: cen_lat real , DIMENSION(max_domains) :: cen_lon real , DIMENSION(max_domains) :: truelat1 real , DIMENSION(max_domains) :: truelat2 real , DIMENSION(max_domains) :: moad_cen_lat real , DIMENSION(max_domains) :: stand_lon real , DIMENSION(max_domains) :: pole_lat real , DIMENSION(max_domains) :: pole_lon integer :: flag_metgrid integer :: flag_snow integer :: flag_psfc integer :: flag_sm000010 integer :: flag_sm010040 integer :: flag_sm040100 integer :: flag_sm100200 integer :: flag_st000010 integer :: flag_st010040 integer :: flag_st040100 integer :: flag_st100200 integer :: flag_soil_layers integer :: flag_slp integer :: flag_soilhgt integer :: flag_mf_xy integer :: flag_um_soil real , DIMENSION(max_domains) :: bdyfrq character*256 , DIMENSION(max_domains) :: mminlu integer , DIMENSION(max_domains) :: iswater integer , DIMENSION(max_domains) :: islake integer , DIMENSION(max_domains) :: isice integer , DIMENSION(max_domains) :: isurban integer , DIMENSION(max_domains) :: isoilwater integer , DIMENSION(max_domains) :: map_proj integer :: use_wps_input integer , DIMENSION(max_domains) :: dfi_stage integer , DIMENSION(max_domains) :: mp_physics_dfi integer , DIMENSION(max_domains) :: bl_pbl_physics_dfi integer , DIMENSION(max_domains) :: windfarm_opt integer :: windfarm_ij integer :: windfarm_ws integer , DIMENSION(max_domains) :: hailcast_opt real , DIMENSION(max_domains) :: haildt integer , DIMENSION(max_domains) :: lightning_option real , DIMENSION(max_domains) :: lightning_dt real , DIMENSION(max_domains) :: lightning_start_seconds real , DIMENSION(max_domains) :: flashrate_factor integer , DIMENSION(max_domains) :: iccg_method real , DIMENSION(max_domains) :: iccg_prescribed_num real , DIMENSION(max_domains) :: iccg_prescribed_den integer , DIMENSION(max_domains) :: cellcount_method real , DIMENSION(max_domains) :: cldtop_adjustment integer , DIMENSION(max_domains) :: sf_lake_physics character*256 :: auxinput1_inname integer :: io_form_auxinput1 logical :: override_restart_timers character*256 :: auxhist1_inname character*256 :: auxhist1_outname integer , DIMENSION(max_domains) :: auxhist1_interval_y integer , DIMENSION(max_domains) :: auxhist1_interval_d integer , DIMENSION(max_domains) :: auxhist1_interval_h integer , DIMENSION(max_domains) :: auxhist1_interval_m integer , DIMENSION(max_domains) :: auxhist1_interval_s integer , DIMENSION(max_domains) :: auxhist1_interval integer , DIMENSION(max_domains) :: auxhist1_begin_y integer , DIMENSION(max_domains) :: auxhist1_begin_d integer , DIMENSION(max_domains) :: auxhist1_begin_h integer , DIMENSION(max_domains) :: auxhist1_begin_m integer , DIMENSION(max_domains) :: auxhist1_begin_s integer , DIMENSION(max_domains) :: auxhist1_begin integer , DIMENSION(max_domains) :: auxhist1_end_y integer , DIMENSION(max_domains) :: auxhist1_end_d integer , DIMENSION(max_domains) :: auxhist1_end_h integer , DIMENSION(max_domains) :: auxhist1_end_m integer , DIMENSION(max_domains) :: auxhist1_end_s integer , DIMENSION(max_domains) :: auxhist1_end integer :: io_form_auxhist1 integer , DIMENSION(max_domains) :: frames_per_auxhist1 character*256 :: auxhist2_inname character*256 :: auxhist2_outname integer , DIMENSION(max_domains) :: auxhist2_interval_y integer , DIMENSION(max_domains) :: auxhist2_interval_d integer , DIMENSION(max_domains) :: auxhist2_interval_h integer , DIMENSION(max_domains) :: auxhist2_interval_m integer , DIMENSION(max_domains) :: auxhist2_interval_s integer , DIMENSION(max_domains) :: auxhist2_interval integer , DIMENSION(max_domains) :: auxhist2_begin_y integer , DIMENSION(max_domains) :: auxhist2_begin_d integer , DIMENSION(max_domains) :: auxhist2_begin_h integer , DIMENSION(max_domains) :: auxhist2_begin_m integer , DIMENSION(max_domains) :: auxhist2_begin_s integer , DIMENSION(max_domains) :: auxhist2_begin integer , DIMENSION(max_domains) :: auxhist2_end_y integer , DIMENSION(max_domains) :: auxhist2_end_d integer , DIMENSION(max_domains) :: auxhist2_end_h integer , DIMENSION(max_domains) :: auxhist2_end_m integer , DIMENSION(max_domains) :: auxhist2_end_s integer , DIMENSION(max_domains) :: auxhist2_end integer :: io_form_auxhist2 integer , DIMENSION(max_domains) :: frames_per_auxhist2 character*256 :: auxhist3_inname character*256 :: auxhist3_outname integer , DIMENSION(max_domains) :: auxhist3_interval_y integer , DIMENSION(max_domains) :: auxhist3_interval_d integer , DIMENSION(max_domains) :: auxhist3_interval_h integer , DIMENSION(max_domains) :: auxhist3_interval_m integer , DIMENSION(max_domains) :: auxhist3_interval_s integer , DIMENSION(max_domains) :: auxhist3_interval integer , DIMENSION(max_domains) :: auxhist3_begin_y integer , DIMENSION(max_domains) :: auxhist3_begin_d integer , DIMENSION(max_domains) :: auxhist3_begin_h integer , DIMENSION(max_domains) :: auxhist3_begin_m integer , DIMENSION(max_domains) :: auxhist3_begin_s integer , DIMENSION(max_domains) :: auxhist3_begin integer , DIMENSION(max_domains) :: auxhist3_end_y integer , DIMENSION(max_domains) :: auxhist3_end_d integer , DIMENSION(max_domains) :: auxhist3_end_h integer , DIMENSION(max_domains) :: auxhist3_end_m integer , DIMENSION(max_domains) :: auxhist3_end_s integer , DIMENSION(max_domains) :: auxhist3_end integer :: io_form_auxhist3 integer , DIMENSION(max_domains) :: frames_per_auxhist3 character*256 :: auxhist4_inname character*256 :: auxhist4_outname integer , DIMENSION(max_domains) :: auxhist4_interval_y integer , DIMENSION(max_domains) :: auxhist4_interval_d integer , DIMENSION(max_domains) :: auxhist4_interval_h integer , DIMENSION(max_domains) :: auxhist4_interval_m integer , DIMENSION(max_domains) :: auxhist4_interval_s integer , DIMENSION(max_domains) :: auxhist4_interval integer , DIMENSION(max_domains) :: auxhist4_begin_y integer , DIMENSION(max_domains) :: auxhist4_begin_d integer , DIMENSION(max_domains) :: auxhist4_begin_h integer , DIMENSION(max_domains) :: auxhist4_begin_m integer , DIMENSION(max_domains) :: auxhist4_begin_s integer , DIMENSION(max_domains) :: auxhist4_begin integer , DIMENSION(max_domains) :: auxhist4_end_y integer , DIMENSION(max_domains) :: auxhist4_end_d integer , DIMENSION(max_domains) :: auxhist4_end_h integer , DIMENSION(max_domains) :: auxhist4_end_m integer , DIMENSION(max_domains) :: auxhist4_end_s integer , DIMENSION(max_domains) :: auxhist4_end integer :: io_form_auxhist4 integer , DIMENSION(max_domains) :: frames_per_auxhist4 character*256 :: auxhist5_inname character*256 :: auxhist5_outname integer , DIMENSION(max_domains) :: auxhist5_interval_y integer , DIMENSION(max_domains) :: auxhist5_interval_d integer , DIMENSION(max_domains) :: auxhist5_interval_h integer , DIMENSION(max_domains) :: auxhist5_interval_m integer , DIMENSION(max_domains) :: auxhist5_interval_s integer , DIMENSION(max_domains) :: auxhist5_interval integer , DIMENSION(max_domains) :: auxhist5_begin_y integer , DIMENSION(max_domains) :: auxhist5_begin_d integer , DIMENSION(max_domains) :: auxhist5_begin_h integer , DIMENSION(max_domains) :: auxhist5_begin_m integer , DIMENSION(max_domains) :: auxhist5_begin_s integer , DIMENSION(max_domains) :: auxhist5_begin integer , DIMENSION(max_domains) :: auxhist5_end_y integer , DIMENSION(max_domains) :: auxhist5_end_d integer , DIMENSION(max_domains) :: auxhist5_end_h integer , DIMENSION(max_domains) :: auxhist5_end_m integer , DIMENSION(max_domains) :: auxhist5_end_s integer , DIMENSION(max_domains) :: auxhist5_end integer :: io_form_auxhist5 integer , DIMENSION(max_domains) :: frames_per_auxhist5 character*256 :: auxhist6_inname character*256 :: auxhist6_outname integer , DIMENSION(max_domains) :: auxhist6_interval_y integer , DIMENSION(max_domains) :: auxhist6_interval_d integer , DIMENSION(max_domains) :: auxhist6_interval_h integer , DIMENSION(max_domains) :: auxhist6_interval_m integer , DIMENSION(max_domains) :: auxhist6_interval_s integer , DIMENSION(max_domains) :: auxhist6_interval integer , DIMENSION(max_domains) :: auxhist6_begin_y integer , DIMENSION(max_domains) :: auxhist6_begin_d integer , DIMENSION(max_domains) :: auxhist6_begin_h integer , DIMENSION(max_domains) :: auxhist6_begin_m integer , DIMENSION(max_domains) :: auxhist6_begin_s integer , DIMENSION(max_domains) :: auxhist6_begin integer , DIMENSION(max_domains) :: auxhist6_end_y integer , DIMENSION(max_domains) :: auxhist6_end_d integer , DIMENSION(max_domains) :: auxhist6_end_h integer , DIMENSION(max_domains) :: auxhist6_end_m integer , DIMENSION(max_domains) :: auxhist6_end_s integer , DIMENSION(max_domains) :: auxhist6_end integer :: io_form_auxhist6 integer , DIMENSION(max_domains) :: frames_per_auxhist6 character*256 :: auxhist7_inname character*256 :: auxhist7_outname integer , DIMENSION(max_domains) :: auxhist7_interval_y integer , DIMENSION(max_domains) :: auxhist7_interval_d integer , DIMENSION(max_domains) :: auxhist7_interval_h integer , DIMENSION(max_domains) :: auxhist7_interval_m integer , DIMENSION(max_domains) :: auxhist7_interval_s integer , DIMENSION(max_domains) :: auxhist7_interval integer , DIMENSION(max_domains) :: auxhist7_begin_y integer , DIMENSION(max_domains) :: auxhist7_begin_d integer , DIMENSION(max_domains) :: auxhist7_begin_h integer , DIMENSION(max_domains) :: auxhist7_begin_m integer , DIMENSION(max_domains) :: auxhist7_begin_s integer , DIMENSION(max_domains) :: auxhist7_begin integer , DIMENSION(max_domains) :: auxhist7_end_y integer , DIMENSION(max_domains) :: auxhist7_end_d integer , DIMENSION(max_domains) :: auxhist7_end_h integer , DIMENSION(max_domains) :: auxhist7_end_m integer , DIMENSION(max_domains) :: auxhist7_end_s integer , DIMENSION(max_domains) :: auxhist7_end integer :: io_form_auxhist7 integer , DIMENSION(max_domains) :: frames_per_auxhist7 character*256 :: auxhist8_inname character*256 :: auxhist8_outname integer , DIMENSION(max_domains) :: auxhist8_interval_y integer , DIMENSION(max_domains) :: auxhist8_interval_d integer , DIMENSION(max_domains) :: auxhist8_interval_h integer , DIMENSION(max_domains) :: auxhist8_interval_m integer , DIMENSION(max_domains) :: auxhist8_interval_s integer , DIMENSION(max_domains) :: auxhist8_interval integer , DIMENSION(max_domains) :: auxhist8_begin_y integer , DIMENSION(max_domains) :: auxhist8_begin_d integer , DIMENSION(max_domains) :: auxhist8_begin_h integer , DIMENSION(max_domains) :: auxhist8_begin_m integer , DIMENSION(max_domains) :: auxhist8_begin_s integer , DIMENSION(max_domains) :: auxhist8_begin integer , DIMENSION(max_domains) :: auxhist8_end_y integer , DIMENSION(max_domains) :: auxhist8_end_d integer , DIMENSION(max_domains) :: auxhist8_end_h integer , DIMENSION(max_domains) :: auxhist8_end_m integer , DIMENSION(max_domains) :: auxhist8_end_s integer , DIMENSION(max_domains) :: auxhist8_end integer :: io_form_auxhist8 integer , DIMENSION(max_domains) :: frames_per_auxhist8 character*256 :: auxhist9_inname character*256 :: auxhist9_outname integer , DIMENSION(max_domains) :: auxhist9_interval_y integer , DIMENSION(max_domains) :: auxhist9_interval_d integer , DIMENSION(max_domains) :: auxhist9_interval_h integer , DIMENSION(max_domains) :: auxhist9_interval_m integer , DIMENSION(max_domains) :: auxhist9_interval_s integer , DIMENSION(max_domains) :: auxhist9_interval integer , DIMENSION(max_domains) :: auxhist9_begin_y integer , DIMENSION(max_domains) :: auxhist9_begin_d integer , DIMENSION(max_domains) :: auxhist9_begin_h integer , DIMENSION(max_domains) :: auxhist9_begin_m integer , DIMENSION(max_domains) :: auxhist9_begin_s integer , DIMENSION(max_domains) :: auxhist9_begin integer , DIMENSION(max_domains) :: auxhist9_end_y integer , DIMENSION(max_domains) :: auxhist9_end_d integer , DIMENSION(max_domains) :: auxhist9_end_h integer , DIMENSION(max_domains) :: auxhist9_end_m integer , DIMENSION(max_domains) :: auxhist9_end_s integer , DIMENSION(max_domains) :: auxhist9_end integer :: io_form_auxhist9 integer , DIMENSION(max_domains) :: frames_per_auxhist9 character*256 :: auxhist10_inname character*256 :: auxhist10_outname integer , DIMENSION(max_domains) :: auxhist10_interval_y integer , DIMENSION(max_domains) :: auxhist10_interval_d integer , DIMENSION(max_domains) :: auxhist10_interval_h integer , DIMENSION(max_domains) :: auxhist10_interval_m integer , DIMENSION(max_domains) :: auxhist10_interval_s integer , DIMENSION(max_domains) :: auxhist10_interval integer , DIMENSION(max_domains) :: auxhist10_begin_y integer , DIMENSION(max_domains) :: auxhist10_begin_d integer , DIMENSION(max_domains) :: auxhist10_begin_h integer , DIMENSION(max_domains) :: auxhist10_begin_m integer , DIMENSION(max_domains) :: auxhist10_begin_s integer , DIMENSION(max_domains) :: auxhist10_begin integer , DIMENSION(max_domains) :: auxhist10_end_y integer , DIMENSION(max_domains) :: auxhist10_end_d integer , DIMENSION(max_domains) :: auxhist10_end_h integer , DIMENSION(max_domains) :: auxhist10_end_m integer , DIMENSION(max_domains) :: auxhist10_end_s integer , DIMENSION(max_domains) :: auxhist10_end integer :: io_form_auxhist10 integer , DIMENSION(max_domains) :: frames_per_auxhist10 character*256 :: auxhist11_inname character*256 :: auxhist11_outname integer , DIMENSION(max_domains) :: auxhist11_interval_y integer , DIMENSION(max_domains) :: auxhist11_interval_d integer , DIMENSION(max_domains) :: auxhist11_interval_h integer , DIMENSION(max_domains) :: auxhist11_interval_m integer , DIMENSION(max_domains) :: auxhist11_interval_s integer , DIMENSION(max_domains) :: auxhist11_interval integer , DIMENSION(max_domains) :: auxhist11_begin_y integer , DIMENSION(max_domains) :: auxhist11_begin_d integer , DIMENSION(max_domains) :: auxhist11_begin_h integer , DIMENSION(max_domains) :: auxhist11_begin_m integer , DIMENSION(max_domains) :: auxhist11_begin_s integer , DIMENSION(max_domains) :: auxhist11_begin integer , DIMENSION(max_domains) :: auxhist11_end_y integer , DIMENSION(max_domains) :: auxhist11_end_d integer , DIMENSION(max_domains) :: auxhist11_end_h integer , DIMENSION(max_domains) :: auxhist11_end_m integer , DIMENSION(max_domains) :: auxhist11_end_s integer , DIMENSION(max_domains) :: auxhist11_end integer :: io_form_auxhist11 integer , DIMENSION(max_domains) :: frames_per_auxhist11 character*256 :: auxhist12_inname character*256 :: auxhist12_outname integer , DIMENSION(max_domains) :: auxhist12_interval_y integer , DIMENSION(max_domains) :: auxhist12_interval_d integer , DIMENSION(max_domains) :: auxhist12_interval_h integer , DIMENSION(max_domains) :: auxhist12_interval_m integer , DIMENSION(max_domains) :: auxhist12_interval_s integer , DIMENSION(max_domains) :: auxhist12_interval integer , DIMENSION(max_domains) :: auxhist12_begin_y integer , DIMENSION(max_domains) :: auxhist12_begin_d integer , DIMENSION(max_domains) :: auxhist12_begin_h integer , DIMENSION(max_domains) :: auxhist12_begin_m integer , DIMENSION(max_domains) :: auxhist12_begin_s integer , DIMENSION(max_domains) :: auxhist12_begin integer , DIMENSION(max_domains) :: auxhist12_end_y integer , DIMENSION(max_domains) :: auxhist12_end_d integer , DIMENSION(max_domains) :: auxhist12_end_h integer , DIMENSION(max_domains) :: auxhist12_end_m integer , DIMENSION(max_domains) :: auxhist12_end_s integer , DIMENSION(max_domains) :: auxhist12_end integer :: io_form_auxhist12 integer , DIMENSION(max_domains) :: frames_per_auxhist12 character*256 :: auxhist13_inname character*256 :: auxhist13_outname integer , DIMENSION(max_domains) :: auxhist13_interval_y integer , DIMENSION(max_domains) :: auxhist13_interval_d integer , DIMENSION(max_domains) :: auxhist13_interval_h integer , DIMENSION(max_domains) :: auxhist13_interval_m integer , DIMENSION(max_domains) :: auxhist13_interval_s integer , DIMENSION(max_domains) :: auxhist13_interval integer , DIMENSION(max_domains) :: auxhist13_begin_y integer , DIMENSION(max_domains) :: auxhist13_begin_d integer , DIMENSION(max_domains) :: auxhist13_begin_h integer , DIMENSION(max_domains) :: auxhist13_begin_m integer , DIMENSION(max_domains) :: auxhist13_begin_s integer , DIMENSION(max_domains) :: auxhist13_begin integer , DIMENSION(max_domains) :: auxhist13_end_y integer , DIMENSION(max_domains) :: auxhist13_end_d integer , DIMENSION(max_domains) :: auxhist13_end_h integer , DIMENSION(max_domains) :: auxhist13_end_m integer , DIMENSION(max_domains) :: auxhist13_end_s integer , DIMENSION(max_domains) :: auxhist13_end integer :: io_form_auxhist13 integer , DIMENSION(max_domains) :: frames_per_auxhist13 character*256 :: auxhist14_inname character*256 :: auxhist14_outname integer , DIMENSION(max_domains) :: auxhist14_interval_y integer , DIMENSION(max_domains) :: auxhist14_interval_d integer , DIMENSION(max_domains) :: auxhist14_interval_h integer , DIMENSION(max_domains) :: auxhist14_interval_m integer , DIMENSION(max_domains) :: auxhist14_interval_s integer , DIMENSION(max_domains) :: auxhist14_interval integer , DIMENSION(max_domains) :: auxhist14_begin_y integer , DIMENSION(max_domains) :: auxhist14_begin_d integer , DIMENSION(max_domains) :: auxhist14_begin_h integer , DIMENSION(max_domains) :: auxhist14_begin_m integer , DIMENSION(max_domains) :: auxhist14_begin_s integer , DIMENSION(max_domains) :: auxhist14_begin integer , DIMENSION(max_domains) :: auxhist14_end_y integer , DIMENSION(max_domains) :: auxhist14_end_d integer , DIMENSION(max_domains) :: auxhist14_end_h integer , DIMENSION(max_domains) :: auxhist14_end_m integer , DIMENSION(max_domains) :: auxhist14_end_s integer , DIMENSION(max_domains) :: auxhist14_end integer :: io_form_auxhist14 integer , DIMENSION(max_domains) :: frames_per_auxhist14 character*256 :: auxhist15_inname character*256 :: auxhist15_outname integer , DIMENSION(max_domains) :: auxhist15_interval_y integer , DIMENSION(max_domains) :: auxhist15_interval_d integer , DIMENSION(max_domains) :: auxhist15_interval_h integer , DIMENSION(max_domains) :: auxhist15_interval_m integer , DIMENSION(max_domains) :: auxhist15_interval_s integer , DIMENSION(max_domains) :: auxhist15_interval integer , DIMENSION(max_domains) :: auxhist15_begin_y integer , DIMENSION(max_domains) :: auxhist15_begin_d integer , DIMENSION(max_domains) :: auxhist15_begin_h integer , DIMENSION(max_domains) :: auxhist15_begin_m integer , DIMENSION(max_domains) :: auxhist15_begin_s integer , DIMENSION(max_domains) :: auxhist15_begin integer , DIMENSION(max_domains) :: auxhist15_end_y integer , DIMENSION(max_domains) :: auxhist15_end_d integer , DIMENSION(max_domains) :: auxhist15_end_h integer , DIMENSION(max_domains) :: auxhist15_end_m integer , DIMENSION(max_domains) :: auxhist15_end_s integer , DIMENSION(max_domains) :: auxhist15_end integer :: io_form_auxhist15 integer , DIMENSION(max_domains) :: frames_per_auxhist15 character*256 :: auxhist16_inname character*256 :: auxhist16_outname integer , DIMENSION(max_domains) :: auxhist16_interval_y integer , DIMENSION(max_domains) :: auxhist16_interval_d integer , DIMENSION(max_domains) :: auxhist16_interval_h integer , DIMENSION(max_domains) :: auxhist16_interval_m integer , DIMENSION(max_domains) :: auxhist16_interval_s integer , DIMENSION(max_domains) :: auxhist16_interval integer , DIMENSION(max_domains) :: auxhist16_begin_y integer , DIMENSION(max_domains) :: auxhist16_begin_d integer , DIMENSION(max_domains) :: auxhist16_begin_h integer , DIMENSION(max_domains) :: auxhist16_begin_m integer , DIMENSION(max_domains) :: auxhist16_begin_s integer , DIMENSION(max_domains) :: auxhist16_begin integer , DIMENSION(max_domains) :: auxhist16_end_y integer , DIMENSION(max_domains) :: auxhist16_end_d integer , DIMENSION(max_domains) :: auxhist16_end_h integer , DIMENSION(max_domains) :: auxhist16_end_m integer , DIMENSION(max_domains) :: auxhist16_end_s integer , DIMENSION(max_domains) :: auxhist16_end integer :: io_form_auxhist16 integer , DIMENSION(max_domains) :: frames_per_auxhist16 character*256 :: auxhist17_inname character*256 :: auxhist17_outname integer , DIMENSION(max_domains) :: auxhist17_interval_y integer , DIMENSION(max_domains) :: auxhist17_interval_d integer , DIMENSION(max_domains) :: auxhist17_interval_h integer , DIMENSION(max_domains) :: auxhist17_interval_m integer , DIMENSION(max_domains) :: auxhist17_interval_s integer , DIMENSION(max_domains) :: auxhist17_interval integer , DIMENSION(max_domains) :: auxhist17_begin_y integer , DIMENSION(max_domains) :: auxhist17_begin_d integer , DIMENSION(max_domains) :: auxhist17_begin_h integer , DIMENSION(max_domains) :: auxhist17_begin_m integer , DIMENSION(max_domains) :: auxhist17_begin_s integer , DIMENSION(max_domains) :: auxhist17_begin integer , DIMENSION(max_domains) :: auxhist17_end_y integer , DIMENSION(max_domains) :: auxhist17_end_d integer , DIMENSION(max_domains) :: auxhist17_end_h integer , DIMENSION(max_domains) :: auxhist17_end_m integer , DIMENSION(max_domains) :: auxhist17_end_s integer , DIMENSION(max_domains) :: auxhist17_end integer :: io_form_auxhist17 integer , DIMENSION(max_domains) :: frames_per_auxhist17 character*256 :: auxhist18_inname character*256 :: auxhist18_outname integer , DIMENSION(max_domains) :: auxhist18_interval_y integer , DIMENSION(max_domains) :: auxhist18_interval_d integer , DIMENSION(max_domains) :: auxhist18_interval_h integer , DIMENSION(max_domains) :: auxhist18_interval_m integer , DIMENSION(max_domains) :: auxhist18_interval_s integer , DIMENSION(max_domains) :: auxhist18_interval integer , DIMENSION(max_domains) :: auxhist18_begin_y integer , DIMENSION(max_domains) :: auxhist18_begin_d integer , DIMENSION(max_domains) :: auxhist18_begin_h integer , DIMENSION(max_domains) :: auxhist18_begin_m integer , DIMENSION(max_domains) :: auxhist18_begin_s integer , DIMENSION(max_domains) :: auxhist18_begin integer , DIMENSION(max_domains) :: auxhist18_end_y integer , DIMENSION(max_domains) :: auxhist18_end_d integer , DIMENSION(max_domains) :: auxhist18_end_h integer , DIMENSION(max_domains) :: auxhist18_end_m integer , DIMENSION(max_domains) :: auxhist18_end_s integer , DIMENSION(max_domains) :: auxhist18_end integer :: io_form_auxhist18 integer , DIMENSION(max_domains) :: frames_per_auxhist18 character*256 :: auxhist19_inname character*256 :: auxhist19_outname integer , DIMENSION(max_domains) :: auxhist19_interval_y integer , DIMENSION(max_domains) :: auxhist19_interval_d integer , DIMENSION(max_domains) :: auxhist19_interval_h integer , DIMENSION(max_domains) :: auxhist19_interval_m integer , DIMENSION(max_domains) :: auxhist19_interval_s integer , DIMENSION(max_domains) :: auxhist19_interval integer , DIMENSION(max_domains) :: auxhist19_begin_y integer , DIMENSION(max_domains) :: auxhist19_begin_d integer , DIMENSION(max_domains) :: auxhist19_begin_h integer , DIMENSION(max_domains) :: auxhist19_begin_m integer , DIMENSION(max_domains) :: auxhist19_begin_s integer , DIMENSION(max_domains) :: auxhist19_begin integer , DIMENSION(max_domains) :: auxhist19_end_y integer , DIMENSION(max_domains) :: auxhist19_end_d integer , DIMENSION(max_domains) :: auxhist19_end_h integer , DIMENSION(max_domains) :: auxhist19_end_m integer , DIMENSION(max_domains) :: auxhist19_end_s integer , DIMENSION(max_domains) :: auxhist19_end integer :: io_form_auxhist19 integer , DIMENSION(max_domains) :: frames_per_auxhist19 character*256 :: auxhist20_inname character*256 :: auxhist20_outname integer , DIMENSION(max_domains) :: auxhist20_interval_y integer , DIMENSION(max_domains) :: auxhist20_interval_d integer , DIMENSION(max_domains) :: auxhist20_interval_h integer , DIMENSION(max_domains) :: auxhist20_interval_m integer , DIMENSION(max_domains) :: auxhist20_interval_s integer , DIMENSION(max_domains) :: auxhist20_interval integer , DIMENSION(max_domains) :: auxhist20_begin_y integer , DIMENSION(max_domains) :: auxhist20_begin_d integer , DIMENSION(max_domains) :: auxhist20_begin_h integer , DIMENSION(max_domains) :: auxhist20_begin_m integer , DIMENSION(max_domains) :: auxhist20_begin_s integer , DIMENSION(max_domains) :: auxhist20_begin integer , DIMENSION(max_domains) :: auxhist20_end_y integer , DIMENSION(max_domains) :: auxhist20_end_d integer , DIMENSION(max_domains) :: auxhist20_end_h integer , DIMENSION(max_domains) :: auxhist20_end_m integer , DIMENSION(max_domains) :: auxhist20_end_s integer , DIMENSION(max_domains) :: auxhist20_end integer :: io_form_auxhist20 integer , DIMENSION(max_domains) :: frames_per_auxhist20 character*256 :: auxhist21_inname character*256 :: auxhist21_outname integer , DIMENSION(max_domains) :: auxhist21_interval_y integer , DIMENSION(max_domains) :: auxhist21_interval_d integer , DIMENSION(max_domains) :: auxhist21_interval_h integer , DIMENSION(max_domains) :: auxhist21_interval_m integer , DIMENSION(max_domains) :: auxhist21_interval_s integer , DIMENSION(max_domains) :: auxhist21_interval integer , DIMENSION(max_domains) :: auxhist21_begin_y integer , DIMENSION(max_domains) :: auxhist21_begin_d integer , DIMENSION(max_domains) :: auxhist21_begin_h integer , DIMENSION(max_domains) :: auxhist21_begin_m integer , DIMENSION(max_domains) :: auxhist21_begin_s integer , DIMENSION(max_domains) :: auxhist21_begin integer , DIMENSION(max_domains) :: auxhist21_end_y integer , DIMENSION(max_domains) :: auxhist21_end_d integer , DIMENSION(max_domains) :: auxhist21_end_h integer , DIMENSION(max_domains) :: auxhist21_end_m integer , DIMENSION(max_domains) :: auxhist21_end_s integer , DIMENSION(max_domains) :: auxhist21_end integer :: io_form_auxhist21 integer , DIMENSION(max_domains) :: frames_per_auxhist21 character*256 :: auxhist22_inname character*256 :: auxhist22_outname integer , DIMENSION(max_domains) :: auxhist22_interval_y integer , DIMENSION(max_domains) :: auxhist22_interval_d integer , DIMENSION(max_domains) :: auxhist22_interval_h integer , DIMENSION(max_domains) :: auxhist22_interval_m integer , DIMENSION(max_domains) :: auxhist22_interval_s integer , DIMENSION(max_domains) :: auxhist22_interval integer , DIMENSION(max_domains) :: auxhist22_begin_y integer , DIMENSION(max_domains) :: auxhist22_begin_d integer , DIMENSION(max_domains) :: auxhist22_begin_h integer , DIMENSION(max_domains) :: auxhist22_begin_m integer , DIMENSION(max_domains) :: auxhist22_begin_s integer , DIMENSION(max_domains) :: auxhist22_begin integer , DIMENSION(max_domains) :: auxhist22_end_y integer , DIMENSION(max_domains) :: auxhist22_end_d integer , DIMENSION(max_domains) :: auxhist22_end_h integer , DIMENSION(max_domains) :: auxhist22_end_m integer , DIMENSION(max_domains) :: auxhist22_end_s integer , DIMENSION(max_domains) :: auxhist22_end integer :: io_form_auxhist22 integer , DIMENSION(max_domains) :: frames_per_auxhist22 character*256 :: auxhist23_inname character*256 :: auxhist23_outname integer , DIMENSION(max_domains) :: auxhist23_interval_y integer , DIMENSION(max_domains) :: auxhist23_interval_d integer , DIMENSION(max_domains) :: auxhist23_interval_h integer , DIMENSION(max_domains) :: auxhist23_interval_m integer , DIMENSION(max_domains) :: auxhist23_interval_s integer , DIMENSION(max_domains) :: auxhist23_interval integer , DIMENSION(max_domains) :: auxhist23_begin_y integer , DIMENSION(max_domains) :: auxhist23_begin_d integer , DIMENSION(max_domains) :: auxhist23_begin_h integer , DIMENSION(max_domains) :: auxhist23_begin_m integer , DIMENSION(max_domains) :: auxhist23_begin_s integer , DIMENSION(max_domains) :: auxhist23_begin integer , DIMENSION(max_domains) :: auxhist23_end_y integer , DIMENSION(max_domains) :: auxhist23_end_d integer , DIMENSION(max_domains) :: auxhist23_end_h integer , DIMENSION(max_domains) :: auxhist23_end_m integer , DIMENSION(max_domains) :: auxhist23_end_s integer , DIMENSION(max_domains) :: auxhist23_end integer :: io_form_auxhist23 integer , DIMENSION(max_domains) :: frames_per_auxhist23 character*256 :: auxhist24_inname character*256 :: auxhist24_outname integer , DIMENSION(max_domains) :: auxhist24_interval_y integer , DIMENSION(max_domains) :: auxhist24_interval_d integer , DIMENSION(max_domains) :: auxhist24_interval_h integer , DIMENSION(max_domains) :: auxhist24_interval_m integer , DIMENSION(max_domains) :: auxhist24_interval_s integer , DIMENSION(max_domains) :: auxhist24_interval integer , DIMENSION(max_domains) :: auxhist24_begin_y integer , DIMENSION(max_domains) :: auxhist24_begin_d integer , DIMENSION(max_domains) :: auxhist24_begin_h integer , DIMENSION(max_domains) :: auxhist24_begin_m integer , DIMENSION(max_domains) :: auxhist24_begin_s integer , DIMENSION(max_domains) :: auxhist24_begin integer , DIMENSION(max_domains) :: auxhist24_end_y integer , DIMENSION(max_domains) :: auxhist24_end_d integer , DIMENSION(max_domains) :: auxhist24_end_h integer , DIMENSION(max_domains) :: auxhist24_end_m integer , DIMENSION(max_domains) :: auxhist24_end_s integer , DIMENSION(max_domains) :: auxhist24_end integer :: io_form_auxhist24 integer , DIMENSION(max_domains) :: frames_per_auxhist24 character*256 :: auxinput1_outname integer , DIMENSION(max_domains) :: auxinput1_interval_y integer , DIMENSION(max_domains) :: auxinput1_interval_d integer , DIMENSION(max_domains) :: auxinput1_interval_h integer , DIMENSION(max_domains) :: auxinput1_interval_m integer , DIMENSION(max_domains) :: auxinput1_interval_s integer , DIMENSION(max_domains) :: auxinput1_interval integer , DIMENSION(max_domains) :: auxinput1_begin_y integer , DIMENSION(max_domains) :: auxinput1_begin_d integer , DIMENSION(max_domains) :: auxinput1_begin_h integer , DIMENSION(max_domains) :: auxinput1_begin_m integer , DIMENSION(max_domains) :: auxinput1_begin_s integer , DIMENSION(max_domains) :: auxinput1_begin integer , DIMENSION(max_domains) :: auxinput1_end_y integer , DIMENSION(max_domains) :: auxinput1_end_d integer , DIMENSION(max_domains) :: auxinput1_end_h integer , DIMENSION(max_domains) :: auxinput1_end_m integer , DIMENSION(max_domains) :: auxinput1_end_s integer , DIMENSION(max_domains) :: auxinput1_end integer , DIMENSION(max_domains) :: frames_per_auxinput1 character*256 :: auxinput2_inname character*256 :: auxinput2_outname integer , DIMENSION(max_domains) :: auxinput2_interval_y integer , DIMENSION(max_domains) :: auxinput2_interval_d integer , DIMENSION(max_domains) :: auxinput2_interval_h integer , DIMENSION(max_domains) :: auxinput2_interval_m integer , DIMENSION(max_domains) :: auxinput2_interval_s integer , DIMENSION(max_domains) :: auxinput2_interval integer , DIMENSION(max_domains) :: auxinput2_begin_y integer , DIMENSION(max_domains) :: auxinput2_begin_d integer , DIMENSION(max_domains) :: auxinput2_begin_h integer , DIMENSION(max_domains) :: auxinput2_begin_m integer , DIMENSION(max_domains) :: auxinput2_begin_s integer , DIMENSION(max_domains) :: auxinput2_begin integer , DIMENSION(max_domains) :: auxinput2_end_y integer , DIMENSION(max_domains) :: auxinput2_end_d integer , DIMENSION(max_domains) :: auxinput2_end_h integer , DIMENSION(max_domains) :: auxinput2_end_m integer , DIMENSION(max_domains) :: auxinput2_end_s integer , DIMENSION(max_domains) :: auxinput2_end integer :: io_form_auxinput2 integer , DIMENSION(max_domains) :: frames_per_auxinput2 character*256 :: auxinput3_inname character*256 :: auxinput3_outname integer , DIMENSION(max_domains) :: auxinput3_interval_y integer , DIMENSION(max_domains) :: auxinput3_interval_d integer , DIMENSION(max_domains) :: auxinput3_interval_h integer , DIMENSION(max_domains) :: auxinput3_interval_m integer , DIMENSION(max_domains) :: auxinput3_interval_s integer , DIMENSION(max_domains) :: auxinput3_interval integer , DIMENSION(max_domains) :: auxinput3_begin_y integer , DIMENSION(max_domains) :: auxinput3_begin_d integer , DIMENSION(max_domains) :: auxinput3_begin_h integer , DIMENSION(max_domains) :: auxinput3_begin_m integer , DIMENSION(max_domains) :: auxinput3_begin_s integer , DIMENSION(max_domains) :: auxinput3_begin integer , DIMENSION(max_domains) :: auxinput3_end_y integer , DIMENSION(max_domains) :: auxinput3_end_d integer , DIMENSION(max_domains) :: auxinput3_end_h integer , DIMENSION(max_domains) :: auxinput3_end_m integer , DIMENSION(max_domains) :: auxinput3_end_s integer , DIMENSION(max_domains) :: auxinput3_end integer :: io_form_auxinput3 integer , DIMENSION(max_domains) :: frames_per_auxinput3 character*256 :: auxinput4_inname character*256 :: auxinput4_outname integer , DIMENSION(max_domains) :: auxinput4_interval_y integer , DIMENSION(max_domains) :: auxinput4_interval_d integer , DIMENSION(max_domains) :: auxinput4_interval_h integer , DIMENSION(max_domains) :: auxinput4_interval_m integer , DIMENSION(max_domains) :: auxinput4_interval_s integer , DIMENSION(max_domains) :: auxinput4_interval integer , DIMENSION(max_domains) :: auxinput4_begin_y integer , DIMENSION(max_domains) :: auxinput4_begin_d integer , DIMENSION(max_domains) :: auxinput4_begin_h integer , DIMENSION(max_domains) :: auxinput4_begin_m integer , DIMENSION(max_domains) :: auxinput4_begin_s integer , DIMENSION(max_domains) :: auxinput4_begin integer , DIMENSION(max_domains) :: auxinput4_end_y integer , DIMENSION(max_domains) :: auxinput4_end_d integer , DIMENSION(max_domains) :: auxinput4_end_h integer , DIMENSION(max_domains) :: auxinput4_end_m integer , DIMENSION(max_domains) :: auxinput4_end_s integer , DIMENSION(max_domains) :: auxinput4_end integer :: io_form_auxinput4 integer , DIMENSION(max_domains) :: frames_per_auxinput4 character*256 :: auxinput5_inname character*256 :: auxinput5_outname integer , DIMENSION(max_domains) :: auxinput5_interval_y integer , DIMENSION(max_domains) :: auxinput5_interval_d integer , DIMENSION(max_domains) :: auxinput5_interval_h integer , DIMENSION(max_domains) :: auxinput5_interval_m integer , DIMENSION(max_domains) :: auxinput5_interval_s integer , DIMENSION(max_domains) :: auxinput5_interval integer , DIMENSION(max_domains) :: auxinput5_begin_y integer , DIMENSION(max_domains) :: auxinput5_begin_d integer , DIMENSION(max_domains) :: auxinput5_begin_h integer , DIMENSION(max_domains) :: auxinput5_begin_m integer , DIMENSION(max_domains) :: auxinput5_begin_s integer , DIMENSION(max_domains) :: auxinput5_begin integer , DIMENSION(max_domains) :: auxinput5_end_y integer , DIMENSION(max_domains) :: auxinput5_end_d integer , DIMENSION(max_domains) :: auxinput5_end_h integer , DIMENSION(max_domains) :: auxinput5_end_m integer , DIMENSION(max_domains) :: auxinput5_end_s integer , DIMENSION(max_domains) :: auxinput5_end integer :: io_form_auxinput5 integer , DIMENSION(max_domains) :: frames_per_auxinput5 character*256 :: auxinput6_inname character*256 :: auxinput6_outname integer , DIMENSION(max_domains) :: auxinput6_interval_y integer , DIMENSION(max_domains) :: auxinput6_interval_d integer , DIMENSION(max_domains) :: auxinput6_interval_h integer , DIMENSION(max_domains) :: auxinput6_interval_m integer , DIMENSION(max_domains) :: auxinput6_interval_s integer , DIMENSION(max_domains) :: auxinput6_interval integer , DIMENSION(max_domains) :: auxinput6_begin_y integer , DIMENSION(max_domains) :: auxinput6_begin_d integer , DIMENSION(max_domains) :: auxinput6_begin_h integer , DIMENSION(max_domains) :: auxinput6_begin_m integer , DIMENSION(max_domains) :: auxinput6_begin_s integer , DIMENSION(max_domains) :: auxinput6_begin integer , DIMENSION(max_domains) :: auxinput6_end_y integer , DIMENSION(max_domains) :: auxinput6_end_d integer , DIMENSION(max_domains) :: auxinput6_end_h integer , DIMENSION(max_domains) :: auxinput6_end_m integer , DIMENSION(max_domains) :: auxinput6_end_s integer , DIMENSION(max_domains) :: auxinput6_end integer :: io_form_auxinput6 integer , DIMENSION(max_domains) :: frames_per_auxinput6 character*256 :: auxinput7_inname character*256 :: auxinput7_outname integer , DIMENSION(max_domains) :: auxinput7_interval_y integer , DIMENSION(max_domains) :: auxinput7_interval_d integer , DIMENSION(max_domains) :: auxinput7_interval_h integer , DIMENSION(max_domains) :: auxinput7_interval_m integer , DIMENSION(max_domains) :: auxinput7_interval_s integer , DIMENSION(max_domains) :: auxinput7_interval integer , DIMENSION(max_domains) :: auxinput7_begin_y integer , DIMENSION(max_domains) :: auxinput7_begin_d integer , DIMENSION(max_domains) :: auxinput7_begin_h integer , DIMENSION(max_domains) :: auxinput7_begin_m integer , DIMENSION(max_domains) :: auxinput7_begin_s integer , DIMENSION(max_domains) :: auxinput7_begin integer , DIMENSION(max_domains) :: auxinput7_end_y integer , DIMENSION(max_domains) :: auxinput7_end_d integer , DIMENSION(max_domains) :: auxinput7_end_h integer , DIMENSION(max_domains) :: auxinput7_end_m integer , DIMENSION(max_domains) :: auxinput7_end_s integer , DIMENSION(max_domains) :: auxinput7_end integer :: io_form_auxinput7 integer , DIMENSION(max_domains) :: frames_per_auxinput7 character*256 :: auxinput8_inname character*256 :: auxinput8_outname integer , DIMENSION(max_domains) :: auxinput8_interval_y integer , DIMENSION(max_domains) :: auxinput8_interval_d integer , DIMENSION(max_domains) :: auxinput8_interval_h integer , DIMENSION(max_domains) :: auxinput8_interval_m integer , DIMENSION(max_domains) :: auxinput8_interval_s integer , DIMENSION(max_domains) :: auxinput8_interval integer , DIMENSION(max_domains) :: auxinput8_begin_y integer , DIMENSION(max_domains) :: auxinput8_begin_d integer , DIMENSION(max_domains) :: auxinput8_begin_h integer , DIMENSION(max_domains) :: auxinput8_begin_m integer , DIMENSION(max_domains) :: auxinput8_begin_s integer , DIMENSION(max_domains) :: auxinput8_begin integer , DIMENSION(max_domains) :: auxinput8_end_y integer , DIMENSION(max_domains) :: auxinput8_end_d integer , DIMENSION(max_domains) :: auxinput8_end_h integer , DIMENSION(max_domains) :: auxinput8_end_m integer , DIMENSION(max_domains) :: auxinput8_end_s integer , DIMENSION(max_domains) :: auxinput8_end integer :: io_form_auxinput8 integer , DIMENSION(max_domains) :: frames_per_auxinput8 character*256 :: auxinput9_inname character*256 :: auxinput9_outname integer , DIMENSION(max_domains) :: auxinput9_interval_y integer , DIMENSION(max_domains) :: auxinput9_interval_d integer , DIMENSION(max_domains) :: auxinput9_interval_h integer , DIMENSION(max_domains) :: auxinput9_interval_m integer , DIMENSION(max_domains) :: auxinput9_interval_s integer , DIMENSION(max_domains) :: auxinput9_interval integer , DIMENSION(max_domains) :: auxinput9_begin_y integer , DIMENSION(max_domains) :: auxinput9_begin_d integer , DIMENSION(max_domains) :: auxinput9_begin_h integer , DIMENSION(max_domains) :: auxinput9_begin_m integer , DIMENSION(max_domains) :: auxinput9_begin_s integer , DIMENSION(max_domains) :: auxinput9_begin integer , DIMENSION(max_domains) :: auxinput9_end_y integer , DIMENSION(max_domains) :: auxinput9_end_d integer , DIMENSION(max_domains) :: auxinput9_end_h integer , DIMENSION(max_domains) :: auxinput9_end_m integer , DIMENSION(max_domains) :: auxinput9_end_s integer , DIMENSION(max_domains) :: auxinput9_end integer :: io_form_auxinput9 integer , DIMENSION(max_domains) :: frames_per_auxinput9 character*256 :: auxinput10_inname character*256 :: auxinput10_outname integer , DIMENSION(max_domains) :: auxinput10_interval_y integer , DIMENSION(max_domains) :: auxinput10_interval_d integer , DIMENSION(max_domains) :: auxinput10_interval_h integer , DIMENSION(max_domains) :: auxinput10_interval_m integer , DIMENSION(max_domains) :: auxinput10_interval_s integer , DIMENSION(max_domains) :: auxinput10_interval integer , DIMENSION(max_domains) :: auxinput10_begin_y integer , DIMENSION(max_domains) :: auxinput10_begin_d integer , DIMENSION(max_domains) :: auxinput10_begin_h integer , DIMENSION(max_domains) :: auxinput10_begin_m integer , DIMENSION(max_domains) :: auxinput10_begin_s integer , DIMENSION(max_domains) :: auxinput10_begin integer , DIMENSION(max_domains) :: auxinput10_end_y integer , DIMENSION(max_domains) :: auxinput10_end_d integer , DIMENSION(max_domains) :: auxinput10_end_h integer , DIMENSION(max_domains) :: auxinput10_end_m integer , DIMENSION(max_domains) :: auxinput10_end_s integer , DIMENSION(max_domains) :: auxinput10_end integer :: io_form_auxinput10 integer , DIMENSION(max_domains) :: frames_per_auxinput10 character*256 :: auxinput11_inname character*256 :: auxinput11_outname integer , DIMENSION(max_domains) :: auxinput11_interval_y integer , DIMENSION(max_domains) :: auxinput11_interval_d integer , DIMENSION(max_domains) :: auxinput11_interval_h integer , DIMENSION(max_domains) :: auxinput11_interval_m integer , DIMENSION(max_domains) :: auxinput11_interval_s integer , DIMENSION(max_domains) :: auxinput11_interval integer , DIMENSION(max_domains) :: auxinput11_begin_y integer , DIMENSION(max_domains) :: auxinput11_begin_d integer , DIMENSION(max_domains) :: auxinput11_begin_h integer , DIMENSION(max_domains) :: auxinput11_begin_m integer , DIMENSION(max_domains) :: auxinput11_begin_s integer , DIMENSION(max_domains) :: auxinput11_begin integer , DIMENSION(max_domains) :: auxinput11_end_y integer , DIMENSION(max_domains) :: auxinput11_end_d integer , DIMENSION(max_domains) :: auxinput11_end_h integer , DIMENSION(max_domains) :: auxinput11_end_m integer , DIMENSION(max_domains) :: auxinput11_end_s integer , DIMENSION(max_domains) :: auxinput11_end integer :: io_form_auxinput11 integer , DIMENSION(max_domains) :: frames_per_auxinput11 character*256 :: auxinput12_inname character*256 :: auxinput12_outname integer , DIMENSION(max_domains) :: auxinput12_interval_y integer , DIMENSION(max_domains) :: auxinput12_interval_d integer , DIMENSION(max_domains) :: auxinput12_interval_h integer , DIMENSION(max_domains) :: auxinput12_interval_m integer , DIMENSION(max_domains) :: auxinput12_interval_s integer , DIMENSION(max_domains) :: auxinput12_interval integer , DIMENSION(max_domains) :: auxinput12_begin_y integer , DIMENSION(max_domains) :: auxinput12_begin_d integer , DIMENSION(max_domains) :: auxinput12_begin_h integer , DIMENSION(max_domains) :: auxinput12_begin_m integer , DIMENSION(max_domains) :: auxinput12_begin_s integer , DIMENSION(max_domains) :: auxinput12_begin integer , DIMENSION(max_domains) :: auxinput12_end_y integer , DIMENSION(max_domains) :: auxinput12_end_d integer , DIMENSION(max_domains) :: auxinput12_end_h integer , DIMENSION(max_domains) :: auxinput12_end_m integer , DIMENSION(max_domains) :: auxinput12_end_s integer , DIMENSION(max_domains) :: auxinput12_end integer :: io_form_auxinput12 integer , DIMENSION(max_domains) :: frames_per_auxinput12 character*256 :: auxinput13_inname character*256 :: auxinput13_outname integer , DIMENSION(max_domains) :: auxinput13_interval_y integer , DIMENSION(max_domains) :: auxinput13_interval_d integer , DIMENSION(max_domains) :: auxinput13_interval_h integer , DIMENSION(max_domains) :: auxinput13_interval_m integer , DIMENSION(max_domains) :: auxinput13_interval_s integer , DIMENSION(max_domains) :: auxinput13_interval integer , DIMENSION(max_domains) :: auxinput13_begin_y integer , DIMENSION(max_domains) :: auxinput13_begin_d integer , DIMENSION(max_domains) :: auxinput13_begin_h integer , DIMENSION(max_domains) :: auxinput13_begin_m integer , DIMENSION(max_domains) :: auxinput13_begin_s integer , DIMENSION(max_domains) :: auxinput13_begin integer , DIMENSION(max_domains) :: auxinput13_end_y integer , DIMENSION(max_domains) :: auxinput13_end_d integer , DIMENSION(max_domains) :: auxinput13_end_h integer , DIMENSION(max_domains) :: auxinput13_end_m integer , DIMENSION(max_domains) :: auxinput13_end_s integer , DIMENSION(max_domains) :: auxinput13_end integer :: io_form_auxinput13 integer , DIMENSION(max_domains) :: frames_per_auxinput13 character*256 :: auxinput14_inname character*256 :: auxinput14_outname integer , DIMENSION(max_domains) :: auxinput14_interval_y integer , DIMENSION(max_domains) :: auxinput14_interval_d integer , DIMENSION(max_domains) :: auxinput14_interval_h integer , DIMENSION(max_domains) :: auxinput14_interval_m integer , DIMENSION(max_domains) :: auxinput14_interval_s integer , DIMENSION(max_domains) :: auxinput14_interval integer , DIMENSION(max_domains) :: auxinput14_begin_y integer , DIMENSION(max_domains) :: auxinput14_begin_d integer , DIMENSION(max_domains) :: auxinput14_begin_h integer , DIMENSION(max_domains) :: auxinput14_begin_m integer , DIMENSION(max_domains) :: auxinput14_begin_s integer , DIMENSION(max_domains) :: auxinput14_begin integer , DIMENSION(max_domains) :: auxinput14_end_y integer , DIMENSION(max_domains) :: auxinput14_end_d integer , DIMENSION(max_domains) :: auxinput14_end_h integer , DIMENSION(max_domains) :: auxinput14_end_m integer , DIMENSION(max_domains) :: auxinput14_end_s integer , DIMENSION(max_domains) :: auxinput14_end integer :: io_form_auxinput14 integer , DIMENSION(max_domains) :: frames_per_auxinput14 character*256 :: auxinput15_inname character*256 :: auxinput15_outname integer , DIMENSION(max_domains) :: auxinput15_interval_y integer , DIMENSION(max_domains) :: auxinput15_interval_d integer , DIMENSION(max_domains) :: auxinput15_interval_h integer , DIMENSION(max_domains) :: auxinput15_interval_m integer , DIMENSION(max_domains) :: auxinput15_interval_s integer , DIMENSION(max_domains) :: auxinput15_interval integer , DIMENSION(max_domains) :: auxinput15_begin_y integer , DIMENSION(max_domains) :: auxinput15_begin_d integer , DIMENSION(max_domains) :: auxinput15_begin_h integer , DIMENSION(max_domains) :: auxinput15_begin_m integer , DIMENSION(max_domains) :: auxinput15_begin_s integer , DIMENSION(max_domains) :: auxinput15_begin integer , DIMENSION(max_domains) :: auxinput15_end_y integer , DIMENSION(max_domains) :: auxinput15_end_d integer , DIMENSION(max_domains) :: auxinput15_end_h integer , DIMENSION(max_domains) :: auxinput15_end_m integer , DIMENSION(max_domains) :: auxinput15_end_s integer , DIMENSION(max_domains) :: auxinput15_end integer :: io_form_auxinput15 integer , DIMENSION(max_domains) :: frames_per_auxinput15 character*256 :: auxinput16_inname character*256 :: auxinput16_outname integer , DIMENSION(max_domains) :: auxinput16_interval_y integer , DIMENSION(max_domains) :: auxinput16_interval_d integer , DIMENSION(max_domains) :: auxinput16_interval_h integer , DIMENSION(max_domains) :: auxinput16_interval_m integer , DIMENSION(max_domains) :: auxinput16_interval_s integer , DIMENSION(max_domains) :: auxinput16_interval integer , DIMENSION(max_domains) :: auxinput16_begin_y integer , DIMENSION(max_domains) :: auxinput16_begin_d integer , DIMENSION(max_domains) :: auxinput16_begin_h integer , DIMENSION(max_domains) :: auxinput16_begin_m integer , DIMENSION(max_domains) :: auxinput16_begin_s integer , DIMENSION(max_domains) :: auxinput16_begin integer , DIMENSION(max_domains) :: auxinput16_end_y integer , DIMENSION(max_domains) :: auxinput16_end_d integer , DIMENSION(max_domains) :: auxinput16_end_h integer , DIMENSION(max_domains) :: auxinput16_end_m integer , DIMENSION(max_domains) :: auxinput16_end_s integer , DIMENSION(max_domains) :: auxinput16_end integer :: io_form_auxinput16 integer , DIMENSION(max_domains) :: frames_per_auxinput16 character*256 :: auxinput17_inname character*256 :: auxinput17_outname integer , DIMENSION(max_domains) :: auxinput17_interval_y integer , DIMENSION(max_domains) :: auxinput17_interval_d integer , DIMENSION(max_domains) :: auxinput17_interval_h integer , DIMENSION(max_domains) :: auxinput17_interval_m integer , DIMENSION(max_domains) :: auxinput17_interval_s integer , DIMENSION(max_domains) :: auxinput17_interval integer , DIMENSION(max_domains) :: auxinput17_begin_y integer , DIMENSION(max_domains) :: auxinput17_begin_d integer , DIMENSION(max_domains) :: auxinput17_begin_h integer , DIMENSION(max_domains) :: auxinput17_begin_m integer , DIMENSION(max_domains) :: auxinput17_begin_s integer , DIMENSION(max_domains) :: auxinput17_begin integer , DIMENSION(max_domains) :: auxinput17_end_y integer , DIMENSION(max_domains) :: auxinput17_end_d integer , DIMENSION(max_domains) :: auxinput17_end_h integer , DIMENSION(max_domains) :: auxinput17_end_m integer , DIMENSION(max_domains) :: auxinput17_end_s integer , DIMENSION(max_domains) :: auxinput17_end integer :: io_form_auxinput17 integer , DIMENSION(max_domains) :: frames_per_auxinput17 character*256 :: auxinput18_inname character*256 :: auxinput18_outname integer , DIMENSION(max_domains) :: auxinput18_interval_y integer , DIMENSION(max_domains) :: auxinput18_interval_d integer , DIMENSION(max_domains) :: auxinput18_interval_h integer , DIMENSION(max_domains) :: auxinput18_interval_m integer , DIMENSION(max_domains) :: auxinput18_interval_s integer , DIMENSION(max_domains) :: auxinput18_interval integer , DIMENSION(max_domains) :: auxinput18_begin_y integer , DIMENSION(max_domains) :: auxinput18_begin_d integer , DIMENSION(max_domains) :: auxinput18_begin_h integer , DIMENSION(max_domains) :: auxinput18_begin_m integer , DIMENSION(max_domains) :: auxinput18_begin_s integer , DIMENSION(max_domains) :: auxinput18_begin integer , DIMENSION(max_domains) :: auxinput18_end_y integer , DIMENSION(max_domains) :: auxinput18_end_d integer , DIMENSION(max_domains) :: auxinput18_end_h integer , DIMENSION(max_domains) :: auxinput18_end_m integer , DIMENSION(max_domains) :: auxinput18_end_s integer , DIMENSION(max_domains) :: auxinput18_end integer :: io_form_auxinput18 integer , DIMENSION(max_domains) :: frames_per_auxinput18 character*256 :: auxinput19_inname character*256 :: auxinput19_outname integer , DIMENSION(max_domains) :: auxinput19_interval_y integer , DIMENSION(max_domains) :: auxinput19_interval_d integer , DIMENSION(max_domains) :: auxinput19_interval_h integer , DIMENSION(max_domains) :: auxinput19_interval_m integer , DIMENSION(max_domains) :: auxinput19_interval_s integer , DIMENSION(max_domains) :: auxinput19_interval integer , DIMENSION(max_domains) :: auxinput19_begin_y integer , DIMENSION(max_domains) :: auxinput19_begin_d integer , DIMENSION(max_domains) :: auxinput19_begin_h integer , DIMENSION(max_domains) :: auxinput19_begin_m integer , DIMENSION(max_domains) :: auxinput19_begin_s integer , DIMENSION(max_domains) :: auxinput19_begin integer , DIMENSION(max_domains) :: auxinput19_end_y integer , DIMENSION(max_domains) :: auxinput19_end_d integer , DIMENSION(max_domains) :: auxinput19_end_h integer , DIMENSION(max_domains) :: auxinput19_end_m integer , DIMENSION(max_domains) :: auxinput19_end_s integer , DIMENSION(max_domains) :: auxinput19_end integer :: io_form_auxinput19 integer , DIMENSION(max_domains) :: frames_per_auxinput19 character*256 :: auxinput20_inname character*256 :: auxinput20_outname integer , DIMENSION(max_domains) :: auxinput20_interval_y integer , DIMENSION(max_domains) :: auxinput20_interval_d integer , DIMENSION(max_domains) :: auxinput20_interval_h integer , DIMENSION(max_domains) :: auxinput20_interval_m integer , DIMENSION(max_domains) :: auxinput20_interval_s integer , DIMENSION(max_domains) :: auxinput20_interval integer , DIMENSION(max_domains) :: auxinput20_begin_y integer , DIMENSION(max_domains) :: auxinput20_begin_d integer , DIMENSION(max_domains) :: auxinput20_begin_h integer , DIMENSION(max_domains) :: auxinput20_begin_m integer , DIMENSION(max_domains) :: auxinput20_begin_s integer , DIMENSION(max_domains) :: auxinput20_begin integer , DIMENSION(max_domains) :: auxinput20_end_y integer , DIMENSION(max_domains) :: auxinput20_end_d integer , DIMENSION(max_domains) :: auxinput20_end_h integer , DIMENSION(max_domains) :: auxinput20_end_m integer , DIMENSION(max_domains) :: auxinput20_end_s integer , DIMENSION(max_domains) :: auxinput20_end integer :: io_form_auxinput20 integer , DIMENSION(max_domains) :: frames_per_auxinput20 character*256 :: auxinput21_inname character*256 :: auxinput21_outname integer , DIMENSION(max_domains) :: auxinput21_interval_y integer , DIMENSION(max_domains) :: auxinput21_interval_d integer , DIMENSION(max_domains) :: auxinput21_interval_h integer , DIMENSION(max_domains) :: auxinput21_interval_m integer , DIMENSION(max_domains) :: auxinput21_interval_s integer , DIMENSION(max_domains) :: auxinput21_interval integer , DIMENSION(max_domains) :: auxinput21_begin_y integer , DIMENSION(max_domains) :: auxinput21_begin_d integer , DIMENSION(max_domains) :: auxinput21_begin_h integer , DIMENSION(max_domains) :: auxinput21_begin_m integer , DIMENSION(max_domains) :: auxinput21_begin_s integer , DIMENSION(max_domains) :: auxinput21_begin integer , DIMENSION(max_domains) :: auxinput21_end_y integer , DIMENSION(max_domains) :: auxinput21_end_d integer , DIMENSION(max_domains) :: auxinput21_end_h integer , DIMENSION(max_domains) :: auxinput21_end_m integer , DIMENSION(max_domains) :: auxinput21_end_s integer , DIMENSION(max_domains) :: auxinput21_end integer :: io_form_auxinput21 integer , DIMENSION(max_domains) :: frames_per_auxinput21 character*256 :: auxinput22_inname character*256 :: auxinput22_outname integer , DIMENSION(max_domains) :: auxinput22_interval_y integer , DIMENSION(max_domains) :: auxinput22_interval_d integer , DIMENSION(max_domains) :: auxinput22_interval_h integer , DIMENSION(max_domains) :: auxinput22_interval_m integer , DIMENSION(max_domains) :: auxinput22_interval_s integer , DIMENSION(max_domains) :: auxinput22_interval integer , DIMENSION(max_domains) :: auxinput22_begin_y integer , DIMENSION(max_domains) :: auxinput22_begin_d integer , DIMENSION(max_domains) :: auxinput22_begin_h integer , DIMENSION(max_domains) :: auxinput22_begin_m integer , DIMENSION(max_domains) :: auxinput22_begin_s integer , DIMENSION(max_domains) :: auxinput22_begin integer , DIMENSION(max_domains) :: auxinput22_end_y integer , DIMENSION(max_domains) :: auxinput22_end_d integer , DIMENSION(max_domains) :: auxinput22_end_h integer , DIMENSION(max_domains) :: auxinput22_end_m integer , DIMENSION(max_domains) :: auxinput22_end_s integer , DIMENSION(max_domains) :: auxinput22_end integer :: io_form_auxinput22 integer , DIMENSION(max_domains) :: frames_per_auxinput22 character*256 :: auxinput23_inname character*256 :: auxinput23_outname integer , DIMENSION(max_domains) :: auxinput23_interval_y integer , DIMENSION(max_domains) :: auxinput23_interval_d integer , DIMENSION(max_domains) :: auxinput23_interval_h integer , DIMENSION(max_domains) :: auxinput23_interval_m integer , DIMENSION(max_domains) :: auxinput23_interval_s integer , DIMENSION(max_domains) :: auxinput23_interval integer , DIMENSION(max_domains) :: auxinput23_begin_y integer , DIMENSION(max_domains) :: auxinput23_begin_d integer , DIMENSION(max_domains) :: auxinput23_begin_h integer , DIMENSION(max_domains) :: auxinput23_begin_m integer , DIMENSION(max_domains) :: auxinput23_begin_s integer , DIMENSION(max_domains) :: auxinput23_begin integer , DIMENSION(max_domains) :: auxinput23_end_y integer , DIMENSION(max_domains) :: auxinput23_end_d integer , DIMENSION(max_domains) :: auxinput23_end_h integer , DIMENSION(max_domains) :: auxinput23_end_m integer , DIMENSION(max_domains) :: auxinput23_end_s integer , DIMENSION(max_domains) :: auxinput23_end integer :: io_form_auxinput23 integer , DIMENSION(max_domains) :: frames_per_auxinput23 character*256 :: auxinput24_inname character*256 :: auxinput24_outname integer , DIMENSION(max_domains) :: auxinput24_interval_y integer , DIMENSION(max_domains) :: auxinput24_interval_d integer , DIMENSION(max_domains) :: auxinput24_interval_h integer , DIMENSION(max_domains) :: auxinput24_interval_m integer , DIMENSION(max_domains) :: auxinput24_interval_s integer , DIMENSION(max_domains) :: auxinput24_interval integer , DIMENSION(max_domains) :: auxinput24_begin_y integer , DIMENSION(max_domains) :: auxinput24_begin_d integer , DIMENSION(max_domains) :: auxinput24_begin_h integer , DIMENSION(max_domains) :: auxinput24_begin_m integer , DIMENSION(max_domains) :: auxinput24_begin_s integer , DIMENSION(max_domains) :: auxinput24_begin integer , DIMENSION(max_domains) :: auxinput24_end_y integer , DIMENSION(max_domains) :: auxinput24_end_d integer , DIMENSION(max_domains) :: auxinput24_end_h integer , DIMENSION(max_domains) :: auxinput24_end_m integer , DIMENSION(max_domains) :: auxinput24_end_s integer , DIMENSION(max_domains) :: auxinput24_end integer :: io_form_auxinput24 integer , DIMENSION(max_domains) :: frames_per_auxinput24 integer , DIMENSION(max_domains) :: history_interval integer , DIMENSION(max_domains) :: history_interval2 integer , DIMENSION(max_domains) :: history_interval_change integer , DIMENSION(max_domains) :: frames_per_outfile logical :: restart integer :: restart_interval integer :: io_form_input integer :: io_form_history integer :: io_form_restart integer :: io_form_boundary integer :: debug_level logical :: self_test_domain character*256 :: history_outname character*256 :: history_inname logical :: use_netcdf_classic integer , DIMENSION(max_domains) :: history_interval_d integer , DIMENSION(max_domains) :: history_interval_h integer , DIMENSION(max_domains) :: history_interval_m integer , DIMENSION(max_domains) :: history_interval_s integer , DIMENSION(max_domains) :: inputout_interval_d integer , DIMENSION(max_domains) :: inputout_interval_h integer , DIMENSION(max_domains) :: inputout_interval_m integer , DIMENSION(max_domains) :: inputout_interval_s integer , DIMENSION(max_domains) :: inputout_interval integer :: restart_interval_d integer :: restart_interval_h integer :: restart_interval_m integer :: restart_interval_s integer , DIMENSION(max_domains) :: history_begin_y integer , DIMENSION(max_domains) :: history_begin_d integer , DIMENSION(max_domains) :: history_begin_h integer , DIMENSION(max_domains) :: history_begin_m integer , DIMENSION(max_domains) :: history_begin_s integer , DIMENSION(max_domains) :: history_begin integer , DIMENSION(max_domains) :: inputout_begin_y integer , DIMENSION(max_domains) :: inputout_begin_d integer , DIMENSION(max_domains) :: inputout_begin_h integer , DIMENSION(max_domains) :: inputout_begin_m integer , DIMENSION(max_domains) :: inputout_begin_s integer :: restart_begin_y integer :: restart_begin_d integer :: restart_begin_h integer :: restart_begin_m integer :: restart_begin_s integer :: restart_begin integer , DIMENSION(max_domains) :: history_end_y integer , DIMENSION(max_domains) :: history_end_d integer , DIMENSION(max_domains) :: history_end_h integer , DIMENSION(max_domains) :: history_end_m integer , DIMENSION(max_domains) :: history_end_s integer , DIMENSION(max_domains) :: history_end integer , DIMENSION(max_domains) :: inputout_end_y integer , DIMENSION(max_domains) :: inputout_end_d integer , DIMENSION(max_domains) :: inputout_end_h integer , DIMENSION(max_domains) :: inputout_end_m integer , DIMENSION(max_domains) :: inputout_end_s integer :: simulation_start_year integer :: simulation_start_month integer :: simulation_start_day integer :: simulation_start_hour integer :: simulation_start_minute integer :: simulation_start_second logical :: reset_simulation_start integer , DIMENSION(max_domains) :: sr_x integer , DIMENSION(max_domains) :: sr_y character*256 :: sgfdda_inname character*256 :: gfdda_inname integer , DIMENSION(max_domains) :: sgfdda_interval_d integer , DIMENSION(max_domains) :: sgfdda_interval_h integer , DIMENSION(max_domains) :: sgfdda_interval_m integer , DIMENSION(max_domains) :: sgfdda_interval_s integer , DIMENSION(max_domains) :: sgfdda_interval_y integer , DIMENSION(max_domains) :: sgfdda_interval integer , DIMENSION(max_domains) :: gfdda_interval_d integer , DIMENSION(max_domains) :: gfdda_interval_h integer , DIMENSION(max_domains) :: gfdda_interval_m integer , DIMENSION(max_domains) :: gfdda_interval_s integer , DIMENSION(max_domains) :: gfdda_interval_y integer , DIMENSION(max_domains) :: gfdda_interval integer , DIMENSION(max_domains) :: sgfdda_begin_y integer , DIMENSION(max_domains) :: sgfdda_begin_d integer , DIMENSION(max_domains) :: sgfdda_begin_h integer , DIMENSION(max_domains) :: sgfdda_begin_m integer , DIMENSION(max_domains) :: sgfdda_begin_s integer , DIMENSION(max_domains) :: gfdda_begin_y integer , DIMENSION(max_domains) :: gfdda_begin_d integer , DIMENSION(max_domains) :: gfdda_begin_h integer , DIMENSION(max_domains) :: gfdda_begin_m integer , DIMENSION(max_domains) :: gfdda_begin_s integer , DIMENSION(max_domains) :: sgfdda_end_y integer , DIMENSION(max_domains) :: sgfdda_end_d integer , DIMENSION(max_domains) :: sgfdda_end_h integer , DIMENSION(max_domains) :: sgfdda_end_m integer , DIMENSION(max_domains) :: sgfdda_end_s integer , DIMENSION(max_domains) :: gfdda_end_y integer , DIMENSION(max_domains) :: gfdda_end_d integer , DIMENSION(max_domains) :: gfdda_end_h integer , DIMENSION(max_domains) :: gfdda_end_m integer , DIMENSION(max_domains) :: gfdda_end_s integer :: io_form_sgfdda integer :: io_form_gfdda character*256 , DIMENSION(max_domains) :: iofields_filename logical :: ignore_iofields_warning logical :: ncd_nofill logical , DIMENSION(max_domains) :: enh_vermix logical , DIMENSION(max_domains) :: bb_dcycle real , DIMENSION(max_domains) :: flam_part character*256 :: emi_inname character*256 :: fireemi_inname character*256 :: input_chem_inname character*256 :: emi_outname character*256 :: fireemi_outname character*256 :: input_chem_outname integer :: io_style_emissions real , DIMENSION(max_domains) :: bioemdt real , DIMENSION(max_domains) :: photdt real , DIMENSION(max_domains) :: chemdt integer :: ne_area integer :: kemit integer :: nmegan integer :: kfuture integer :: kfire integer :: kemit_aircraft integer :: kdvel integer :: ndepvel integer :: kdepvel integer :: erosion_dim integer , DIMENSION(max_domains) :: biomass_emiss_opt integer :: cam_mam_mode integer :: cam_mam_nspec logical :: cam_mp_mam_cpled integer , DIMENSION(max_domains) :: lightning_opt integer , DIMENSION(max_domains) :: lightning_time_step real , DIMENSION(max_domains) :: temp_upper real , DIMENSION(max_domains) :: temp_lower real , DIMENSION(max_domains) :: n_ic real , DIMENSION(max_domains) :: n_cg integer , DIMENSION(max_domains) :: passive_ltng integer :: lflash_data integer , DIMENSION(max_domains) :: flashrate_method character*256 , DIMENSION(max_domains) :: vprm_opt real :: wpeat real :: wflood character*256 , DIMENSION(max_domains) :: term_opt integer , DIMENSION(max_domains) :: chem_conv_tr integer , DIMENSION(max_domains) :: conv_tr_wetscav integer , DIMENSION(max_domains) :: conv_tr_aqchem integer , DIMENSION(max_domains) :: chem_opt integer , DIMENSION(max_domains) :: gaschem_onoff integer , DIMENSION(max_domains) :: aerchem_onoff integer , DIMENSION(max_domains) :: wetscav_onoff integer , DIMENSION(max_domains) :: dustwd_onoff integer , DIMENSION(max_domains) :: cldchem_onoff logical , DIMENSION(max_domains) :: is_full_tuv real , DIMENSION(max_domains) :: lambda_cutoff integer , DIMENSION(max_domains) :: cld_od_opt integer , DIMENSION(max_domains) :: pht_cldfrc_opt integer , DIMENSION(max_domains) :: vertmix_onoff integer , DIMENSION(max_domains) :: chem_in_opt integer , DIMENSION(max_domains) :: phot_opt integer , DIMENSION(max_domains) :: gas_drydep_opt integer , DIMENSION(max_domains) :: aer_drydep_opt integer , DIMENSION(max_domains) :: aero_diag_opt integer , DIMENSION(max_domains) :: aero_cw_diag_opt integer , DIMENSION(max_domains) :: kfcup_diag integer , DIMENSION(max_domains) :: diagnostic_chem integer , DIMENSION(max_domains) :: aer_aerodynres_opt integer , DIMENSION(max_domains) :: emiss_opt integer , DIMENSION(max_domains) :: emiss_opt_vol integer :: dust_opt integer :: dust_schme integer :: dmsemis_opt integer :: seas_opt integer , DIMENSION(max_domains) :: bio_emiss_opt integer , DIMENSION(max_domains) :: biomass_burn_opt integer , DIMENSION(max_domains) :: plumerisefire_frq integer , DIMENSION(max_domains) :: emiss_inpt_opt integer , DIMENSION(max_domains) :: gas_bc_opt integer , DIMENSION(max_domains) :: gas_ic_opt integer , DIMENSION(max_domains) :: aer_bc_opt integer , DIMENSION(max_domains) :: aer_ic_opt logical , DIMENSION(max_domains) :: have_bcs_chem logical , DIMENSION(max_domains) :: have_bcs_tracer logical , DIMENSION(max_domains) :: scale_fire_emiss integer , DIMENSION(max_domains) :: aer_ra_feedback integer , DIMENSION(max_domains) :: aer_op_opt integer :: opt_pars_out integer , DIMENSION(max_domains) :: diagnostic_dep integer , DIMENSION(max_domains) :: aircraft_emiss_opt logical , DIMENSION(max_domains) :: have_bcs_upper real , DIMENSION(max_domains) :: fixed_ubc_press character*256 :: fixed_ubc_inname character*256 :: trop_lev_inname character*256 , DIMENSION(max_domains) :: exo_coldens_inname character*256 , DIMENSION(max_domains) :: wes_seasonal_inname integer , DIMENSION(max_domains) :: chemdiag real :: dust_alpha real :: dust_gamma real :: dust_smtune real :: dust_ustune integer :: dust_dsr integer :: dust_veg integer :: dust_soils integer :: dust_smois real :: emiss_ash_hgt real , DIMENSION(max_domains) :: depo_fact integer :: track_chem_num character*256 , DIMENSION(max_trackchem) :: track_chem_name integer :: track_rad_num integer :: track_tuv_num integer :: track_tuv_lev integer :: n2o5_hetchem real , DIMENSION(max_domains) :: af_lambda_start real , DIMENSION(max_domains) :: af_lambda_end integer , DIMENSION(max_domains) :: plumerise_flag logical , DIMENSION(max_domains) :: debug_chem integer , DIMENSION(max_domains) :: simple_dir_fdb integer , DIMENSION(max_domains) :: simple_ind_fdb integer , DIMENSION(max_domains) :: lnox_opt logical , DIMENSION(max_domains) :: lnox_passive real , DIMENSION(max_domains) :: ltng_temp_upper real , DIMENSION(max_domains) :: ltng_temp_lower logical :: has_o3_exo_coldens real :: du_at_grnd logical :: scale_o3_to_grnd_exo_coldens logical :: scale_o3_to_du_at_grnd integer , DIMENSION(max_domains) :: ifire integer , DIMENSION(max_domains) :: fire_boundary_guard integer , DIMENSION(max_domains) :: fire_num_ignitions real , DIMENSION(max_domains) :: fire_ignition_ros1 real , DIMENSION(max_domains) :: fire_ignition_start_lon1 real , DIMENSION(max_domains) :: fire_ignition_start_lat1 real , DIMENSION(max_domains) :: fire_ignition_end_lon1 real , DIMENSION(max_domains) :: fire_ignition_end_lat1 real , DIMENSION(max_domains) :: fire_ignition_radius1 real , DIMENSION(max_domains) :: fire_ignition_start_time1 real , DIMENSION(max_domains) :: fire_ignition_end_time1 real , DIMENSION(max_domains) :: fire_ignition_ros2 real , DIMENSION(max_domains) :: fire_ignition_start_lon2 real , DIMENSION(max_domains) :: fire_ignition_start_lat2 real , DIMENSION(max_domains) :: fire_ignition_end_lon2 real , DIMENSION(max_domains) :: fire_ignition_end_lat2 real , DIMENSION(max_domains) :: fire_ignition_radius2 real , DIMENSION(max_domains) :: fire_ignition_start_time2 real , DIMENSION(max_domains) :: fire_ignition_end_time2 real , DIMENSION(max_domains) :: fire_ignition_ros3 real , DIMENSION(max_domains) :: fire_ignition_start_lon3 real , DIMENSION(max_domains) :: fire_ignition_start_lat3 real , DIMENSION(max_domains) :: fire_ignition_end_lon3 real , DIMENSION(max_domains) :: fire_ignition_end_lat3 real , DIMENSION(max_domains) :: fire_ignition_radius3 real , DIMENSION(max_domains) :: fire_ignition_start_time3 real , DIMENSION(max_domains) :: fire_ignition_end_time3 real , DIMENSION(max_domains) :: fire_ignition_ros4 real , DIMENSION(max_domains) :: fire_ignition_start_lon4 real , DIMENSION(max_domains) :: fire_ignition_start_lat4 real , DIMENSION(max_domains) :: fire_ignition_end_lon4 real , DIMENSION(max_domains) :: fire_ignition_end_lat4 real , DIMENSION(max_domains) :: fire_ignition_radius4 real , DIMENSION(max_domains) :: fire_ignition_start_time4 real , DIMENSION(max_domains) :: fire_ignition_end_time4 real , DIMENSION(max_domains) :: fire_ignition_ros5 real , DIMENSION(max_domains) :: fire_ignition_start_lon5 real , DIMENSION(max_domains) :: fire_ignition_start_lat5 real , DIMENSION(max_domains) :: fire_ignition_end_lon5 real , DIMENSION(max_domains) :: fire_ignition_end_lat5 real , DIMENSION(max_domains) :: fire_ignition_radius5 real , DIMENSION(max_domains) :: fire_ignition_start_time5 real , DIMENSION(max_domains) :: fire_ignition_end_time5 real , DIMENSION(max_domains) :: fire_ignition_start_x1 real , DIMENSION(max_domains) :: fire_ignition_start_y1 real , DIMENSION(max_domains) :: fire_ignition_end_x1 real , DIMENSION(max_domains) :: fire_ignition_end_y1 real , DIMENSION(max_domains) :: fire_ignition_start_x2 real , DIMENSION(max_domains) :: fire_ignition_start_y2 real , DIMENSION(max_domains) :: fire_ignition_end_x2 real , DIMENSION(max_domains) :: fire_ignition_end_y2 real , DIMENSION(max_domains) :: fire_ignition_start_x3 real , DIMENSION(max_domains) :: fire_ignition_start_y3 real , DIMENSION(max_domains) :: fire_ignition_end_x3 real , DIMENSION(max_domains) :: fire_ignition_end_y3 real , DIMENSION(max_domains) :: fire_ignition_start_x4 real , DIMENSION(max_domains) :: fire_ignition_start_y4 real , DIMENSION(max_domains) :: fire_ignition_end_x4 real , DIMENSION(max_domains) :: fire_ignition_end_y4 real , DIMENSION(max_domains) :: fire_ignition_start_x5 real , DIMENSION(max_domains) :: fire_ignition_start_y5 real , DIMENSION(max_domains) :: fire_ignition_end_x5 real , DIMENSION(max_domains) :: fire_ignition_end_y5 real , DIMENSION(max_domains) :: fire_lat_init real , DIMENSION(max_domains) :: fire_lon_init real , DIMENSION(max_domains) :: fire_ign_time integer , DIMENSION(max_domains) :: fire_shape integer , DIMENSION(max_domains) :: fire_sprd_mdl real , DIMENSION(max_domains) :: fire_crwn_hgt real , DIMENSION(max_domains) :: fire_ext_grnd real , DIMENSION(max_domains) :: fire_ext_crwn real , DIMENSION(max_domains) :: fire_wind_height integer , DIMENSION(max_domains) :: fire_fuel_read integer , DIMENSION(max_domains) :: fire_fuel_cat integer , DIMENSION(max_domains) :: fire_print_msg integer , DIMENSION(max_domains) :: fire_print_file integer , DIMENSION(max_domains) :: fire_fuel_left_method integer , DIMENSION(max_domains) :: fire_fuel_left_irl integer , DIMENSION(max_domains) :: fire_fuel_left_jrl real , DIMENSION(max_domains) :: fire_back_weight integer , DIMENSION(max_domains) :: fire_grows_only integer , DIMENSION(max_domains) :: fire_upwinding integer , DIMENSION(max_domains) :: fire_upwind_split real , DIMENSION(max_domains) :: fire_viscosity real , DIMENSION(max_domains) :: fire_lfn_ext_up integer , DIMENSION(max_domains) :: fire_topo_from_atm integer , DIMENSION(max_domains) :: fire_advection integer , DIMENSION(max_domains) :: fire_test_steps real , DIMENSION(max_domains) :: fire_const_time real , DIMENSION(max_domains) :: fire_const_grnhfx real , DIMENSION(max_domains) :: fire_const_grnqfx real , DIMENSION(max_domains) :: fire_atm_feedback integer , DIMENSION(max_domains) :: fire_mountain_type real , DIMENSION(max_domains) :: fire_mountain_height real , DIMENSION(max_domains) :: fire_mountain_start_x real , DIMENSION(max_domains) :: fire_mountain_start_y real , DIMENSION(max_domains) :: fire_mountain_end_x real , DIMENSION(max_domains) :: fire_mountain_end_y real , DIMENSION(max_domains) :: delt_perturbation real , DIMENSION(max_domains) :: xrad_perturbation real , DIMENSION(max_domains) :: yrad_perturbation real , DIMENSION(max_domains) :: zrad_perturbation real , DIMENSION(max_domains) :: hght_perturbation logical , DIMENSION(max_domains) :: stretch_grd logical , DIMENSION(max_domains) :: stretch_hyp real , DIMENSION(max_domains) :: z_grd_scale logical , DIMENSION(max_domains) :: sfc_full_init integer , DIMENSION(max_domains) :: sfc_lu_index real , DIMENSION(max_domains) :: sfc_tsk real , DIMENSION(max_domains) :: sfc_tmn logical , DIMENSION(max_domains) :: fire_read_lu logical , DIMENSION(max_domains) :: fire_read_tsk logical , DIMENSION(max_domains) :: fire_read_tmn logical , DIMENSION(max_domains) :: fire_read_atm_ht logical , DIMENSION(max_domains) :: fire_read_fire_ht logical , DIMENSION(max_domains) :: fire_read_atm_grad logical , DIMENSION(max_domains) :: fire_read_fire_grad real , DIMENSION(max_domains) :: sfc_vegfra real , DIMENSION(max_domains) :: sfc_canwat integer , DIMENSION(max_domains) :: sfc_ivgtyp integer , DIMENSION(max_domains) :: sfc_isltyp integer , DIMENSION(max_domains) :: do_avgflx_em integer , DIMENSION(max_domains) :: do_avgflx_cugd integer :: nens integer :: lmax_ideal integer :: kmax_ideal integer :: stepstoch integer , DIMENSION(max_domains) :: skebs integer , DIMENSION(max_domains) :: stoch_force_opt integer :: skebs_vertstruc integer , DIMENSION(max_domains) :: stoch_vertstruc_opt real , DIMENSION(max_domains) :: tot_backscat_psi real , DIMENSION(max_domains) :: tot_backscat_t real :: ztau_psi real :: ztau_t real :: rexponent_psi real :: rexponent_t real :: zsigma2_eps real :: zsigma2_eta integer :: kminforc integer :: lminforc integer :: kminforct integer :: lminforct integer :: kmaxforc integer :: lmaxforc integer :: kmaxforct integer :: lmaxforct integer :: iseed_skebs integer :: kmaxforch integer :: lmaxforch integer :: kmaxforcth integer :: lmaxforcth integer , DIMENSION(max_domains) :: sppt real , DIMENSION(max_domains) :: gridpt_stddev_sppt real , DIMENSION(max_domains) :: stddev_cutoff_sppt real , DIMENSION(max_domains) :: lengthscale_sppt real , DIMENSION(max_domains) :: timescale_sppt integer :: sppt_vertstruc integer :: iseed_sppt integer , DIMENSION(max_domains) :: rand_perturb real , DIMENSION(max_domains) :: gridpt_stddev_rand_pert real , DIMENSION(max_domains) :: stddev_cutoff_rand_pert real , DIMENSION(max_domains) :: lengthscale_rand_pert real , DIMENSION(max_domains) :: timescale_rand_pert integer :: rand_pert_vertstruc integer :: iseed_rand_pert integer , DIMENSION(max_domains) :: spp logical :: hrrr_cycling integer , DIMENSION(max_domains) :: spp_conv real , DIMENSION(max_domains) :: gridpt_stddev_spp_conv real , DIMENSION(max_domains) :: stddev_cutoff_spp_conv real , DIMENSION(max_domains) :: lengthscale_spp_conv real , DIMENSION(max_domains) :: timescale_spp_conv integer :: vertstruc_spp_conv integer :: iseed_spp_conv integer , DIMENSION(max_domains) :: spp_pbl real , DIMENSION(max_domains) :: gridpt_stddev_spp_pbl real , DIMENSION(max_domains) :: stddev_cutoff_spp_pbl real , DIMENSION(max_domains) :: lengthscale_spp_pbl real , DIMENSION(max_domains) :: timescale_spp_pbl integer :: vertstruc_spp_pbl integer :: iseed_spp_pbl integer , DIMENSION(max_domains) :: spp_mp real , DIMENSION(max_domains) :: gridpt_stddev_spp_mp real , DIMENSION(max_domains) :: stddev_cutoff_spp_mp real , DIMENSION(max_domains) :: lengthscale_spp_mp real , DIMENSION(max_domains) :: timescale_spp_mp integer :: vertstruc_spp_mp integer :: iseed_spp_mp integer , DIMENSION(max_domains) :: spp_lsm real , DIMENSION(max_domains) :: gridpt_stddev_spp_lsm real , DIMENSION(max_domains) :: stddev_cutoff_spp_lsm real , DIMENSION(max_domains) :: lengthscale_spp_lsm real , DIMENSION(max_domains) :: timescale_spp_lsm integer :: vertstruc_spp_lsm integer :: iseed_spp_lsm integer :: skebs_on integer :: sppt_on integer :: spp_on integer :: rand_perturb_on integer :: num_stoch_levels integer :: seed_dim integer , DIMENSION(max_domains) :: sfs_opt integer , DIMENSION(max_domains) :: m_opt real , DIMENSION(max_domains) :: lakedepth_default real , DIMENSION(max_domains) :: lake_min_elev integer , DIMENSION(max_domains) :: use_lakedepth integer :: p_lev_diags integer :: p_lev_diags_dfi integer :: num_press_levels real , DIMENSION(max_plevs) :: press_levels integer :: use_tot_or_hyd_p integer :: extrap_below_grnd real :: p_lev_missing real , DIMENSION(max_domains) :: p_lev_interval integer :: z_lev_diags integer :: z_lev_diags_dfi integer :: num_z_levels real , DIMENSION(max_zlevs) :: z_levels real :: z_lev_missing real , DIMENSION(max_domains) :: z_lev_interval integer , DIMENSION(max_domains) :: afwa_diag_opt integer , DIMENSION(max_domains) :: afwa_ptype_opt integer , DIMENSION(max_domains) :: afwa_vil_opt integer , DIMENSION(max_domains) :: afwa_radar_opt integer , DIMENSION(max_domains) :: afwa_severe_opt integer , DIMENSION(max_domains) :: afwa_icing_opt integer , DIMENSION(max_domains) :: afwa_vis_opt integer , DIMENSION(max_domains) :: afwa_cloud_opt integer , DIMENSION(max_domains) :: afwa_therm_opt integer , DIMENSION(max_domains) :: afwa_turb_opt integer , DIMENSION(max_domains) :: afwa_buoy_opt real :: afwa_ptype_ccn_tmp real :: afwa_ptype_tot_melt integer :: afwa_bad_data_check integer :: mean_diag integer :: mean_freq integer :: mean_interval integer :: diurnal_diag integer , DIMENSION(max_domains) :: nssl_ipelec integer :: nssl_isaund integer :: nssl_iscreen real :: nssl_lightrad integer :: nssl_idischarge integer :: nssl_ibrkd real :: nssl_ecrit real :: nssl_disfrac integer :: elec_physics integer :: perturb_bdy integer :: perturb_chem_bdy integer :: num_gca_levels integer :: gca_input_opt integer :: hybrid_opt real :: etac integer :: num_wif_levels integer :: wif_input_opt integer :: last_item_in_struct NAMELIST /time_control/ run_days NAMELIST /time_control/ run_hours NAMELIST /time_control/ run_minutes NAMELIST /time_control/ run_seconds NAMELIST /time_control/ start_year NAMELIST /time_control/ start_month NAMELIST /time_control/ start_day NAMELIST /time_control/ start_hour NAMELIST /time_control/ start_minute NAMELIST /time_control/ start_second NAMELIST /time_control/ end_year NAMELIST /time_control/ end_month NAMELIST /time_control/ end_day NAMELIST /time_control/ end_hour NAMELIST /time_control/ end_minute NAMELIST /time_control/ end_second NAMELIST /time_control/ interval_seconds NAMELIST /time_control/ input_from_file NAMELIST /time_control/ fine_input_stream NAMELIST /time_control/ input_from_hires NAMELIST /time_control/ rsmas_data_path NAMELIST /time_control/ all_ic_times NAMELIST /time_control/ reset_interval1 NAMELIST /time_control/ julyr NAMELIST /time_control/ julday NAMELIST /time_control/ gmt NAMELIST /time_control/ input_inname NAMELIST /time_control/ input_outname NAMELIST /time_control/ bdy_inname NAMELIST /time_control/ bdy_outname NAMELIST /time_control/ rst_inname NAMELIST /time_control/ rst_outname NAMELIST /time_control/ write_input NAMELIST /time_control/ write_restart_at_0h NAMELIST /time_control/ write_hist_at_0h_rst NAMELIST /time_control/ adjust_output_times NAMELIST /time_control/ adjust_input_times NAMELIST /time_control/ diag_print NAMELIST /time_control/ nocolons NAMELIST /time_control/ cycling NAMELIST /time_control/ output_diagnostics NAMELIST /time_control/ nwp_diagnostics NAMELIST /time_control/ gsd_diagnostics NAMELIST /time_control/ wind_int NAMELIST /time_control/ diag_int NAMELIST /time_control/ output_ready_flag NAMELIST /pio_control/ usepio NAMELIST /pio_control/ pioprocs NAMELIST /pio_control/ piostart NAMELIST /pio_control/ piostride NAMELIST /pio_control/ pioshift NAMELIST /dfi_control/ dfi_opt NAMELIST /dfi_control/ dfi_savehydmeteors NAMELIST /dfi_control/ dfi_nfilter NAMELIST /dfi_control/ dfi_write_filtered_input NAMELIST /dfi_control/ dfi_write_dfi_history NAMELIST /dfi_control/ dfi_cutoff_seconds NAMELIST /dfi_control/ dfi_time_dim NAMELIST /dfi_control/ dfi_fwdstop_year NAMELIST /dfi_control/ dfi_fwdstop_month NAMELIST /dfi_control/ dfi_fwdstop_day NAMELIST /dfi_control/ dfi_fwdstop_hour NAMELIST /dfi_control/ dfi_fwdstop_minute NAMELIST /dfi_control/ dfi_fwdstop_second NAMELIST /dfi_control/ dfi_bckstop_year NAMELIST /dfi_control/ dfi_bckstop_month NAMELIST /dfi_control/ dfi_bckstop_day NAMELIST /dfi_control/ dfi_bckstop_hour NAMELIST /dfi_control/ dfi_bckstop_minute NAMELIST /dfi_control/ dfi_bckstop_second NAMELIST /domains/ time_step NAMELIST /domains/ time_step_fract_num NAMELIST /domains/ time_step_fract_den NAMELIST /domains/ time_step_dfi NAMELIST /domains/ min_time_step NAMELIST /domains/ min_time_step_den NAMELIST /domains/ max_time_step NAMELIST /domains/ max_time_step_den NAMELIST /domains/ target_cfl NAMELIST /domains/ target_hcfl NAMELIST /domains/ max_step_increase_pct NAMELIST /domains/ starting_time_step NAMELIST /domains/ starting_time_step_den NAMELIST /domains/ step_to_output_time NAMELIST /domains/ adaptation_domain NAMELIST /domains/ use_adaptive_time_step NAMELIST /domains/ use_adaptive_time_step_dfi NAMELIST /domains/ max_dom NAMELIST /domains/ lats_to_mic NAMELIST /domains/ s_we NAMELIST /domains/ e_we NAMELIST /domains/ s_sn NAMELIST /domains/ e_sn NAMELIST /domains/ s_vert NAMELIST /domains/ e_vert NAMELIST /domains/ num_metgrid_levels NAMELIST /domains/ num_metgrid_soil_levels NAMELIST /domains/ p_top_requested NAMELIST /domains/ interp_theta NAMELIST /domains/ interp_type NAMELIST /domains/ rebalance NAMELIST /domains/ vert_refine_method NAMELIST /domains/ vert_refine_fact NAMELIST /domains/ extrap_type NAMELIST /domains/ t_extrap_type NAMELIST /domains/ hypsometric_opt NAMELIST /domains/ lowest_lev_from_sfc NAMELIST /domains/ use_levels_below_ground NAMELIST /domains/ use_tavg_for_tsk NAMELIST /domains/ use_surface NAMELIST /domains/ lagrange_order NAMELIST /domains/ force_sfc_in_vinterp NAMELIST /domains/ zap_close_levels NAMELIST /domains/ maxw_horiz_pres_diff NAMELIST /domains/ trop_horiz_pres_diff NAMELIST /domains/ maxw_above_this_level NAMELIST /domains/ use_maxw_level NAMELIST /domains/ use_trop_level NAMELIST /domains/ sfcp_to_sfcp NAMELIST /domains/ adjust_heights NAMELIST /domains/ smooth_cg_topo NAMELIST /domains/ nest_interp_coord NAMELIST /domains/ interp_method_type NAMELIST /domains/ aggregate_lu NAMELIST /domains/ rh2qv_wrt_liquid NAMELIST /domains/ rh2qv_method NAMELIST /domains/ qv_max_p_safe NAMELIST /domains/ qv_max_flag NAMELIST /domains/ qv_max_value NAMELIST /domains/ qv_min_p_safe NAMELIST /domains/ qv_min_flag NAMELIST /domains/ qv_min_value NAMELIST /domains/ ideal_init_method NAMELIST /domains/ dx NAMELIST /domains/ dy NAMELIST /domains/ grid_id NAMELIST /domains/ grid_allowed NAMELIST /domains/ parent_id NAMELIST /domains/ i_parent_start NAMELIST /domains/ j_parent_start NAMELIST /domains/ parent_grid_ratio NAMELIST /domains/ parent_time_step_ratio NAMELIST /domains/ feedback NAMELIST /domains/ smooth_option NAMELIST /domains/ blend_width NAMELIST /domains/ ztop NAMELIST /domains/ moad_grid_ratio NAMELIST /domains/ moad_time_step_ratio NAMELIST /domains/ shw NAMELIST /domains/ tile_sz_x NAMELIST /domains/ tile_sz_y NAMELIST /domains/ numtiles NAMELIST /domains/ numtiles_inc NAMELIST /domains/ numtiles_x NAMELIST /domains/ numtiles_y NAMELIST /domains/ tile_strategy NAMELIST /domains/ nproc_x NAMELIST /domains/ nproc_y NAMELIST /domains/ irand NAMELIST /domains/ num_moves NAMELIST /domains/ ts_buf_size NAMELIST /domains/ max_ts_locs NAMELIST /domains/ vortex_interval NAMELIST /domains/ max_vortex_speed NAMELIST /domains/ corral_dist NAMELIST /domains/ track_level NAMELIST /domains/ time_to_move NAMELIST /domains/ move_id NAMELIST /domains/ move_interval NAMELIST /domains/ move_cd_x NAMELIST /domains/ move_cd_y NAMELIST /domains/ swap_x NAMELIST /domains/ swap_y NAMELIST /domains/ cycle_x NAMELIST /domains/ cycle_y NAMELIST /domains/ reorder_mesh NAMELIST /domains/ perturb_input NAMELIST /domains/ eta_levels NAMELIST /domains/ max_dz NAMELIST /domains/ ocean_levels NAMELIST /domains/ ocean_z NAMELIST /domains/ ocean_t NAMELIST /domains/ ocean_s NAMELIST /domains/ num_traj NAMELIST /domains/ max_ts_level NAMELIST /domains/ track_loc_in NAMELIST /domains/ num_ext_model_couple_dom NAMELIST /tc/ insert_bogus_storm NAMELIST /tc/ remove_storm NAMELIST /tc/ num_storm NAMELIST /tc/ latc_loc NAMELIST /tc/ lonc_loc NAMELIST /tc/ vmax_meters_per_second NAMELIST /tc/ rmax NAMELIST /tc/ vmax_ratio NAMELIST /tc/ rankine_lid NAMELIST /physics/ physics_suite NAMELIST /physics/ force_read_thompson NAMELIST /physics/ write_thompson_tables NAMELIST /physics/ mp_physics NAMELIST /physics/ nssl_cccn NAMELIST /physics/ nssl_alphah NAMELIST /physics/ nssl_alphahl NAMELIST /physics/ nssl_cnoh NAMELIST /physics/ nssl_cnohl NAMELIST /physics/ nssl_cnor NAMELIST /physics/ nssl_cnos NAMELIST /physics/ nssl_rho_qh NAMELIST /physics/ nssl_rho_qhl NAMELIST /physics/ nssl_rho_qs NAMELIST /physics/ nudge_lightning NAMELIST /physics/ nudge_light_times NAMELIST /physics/ nudge_light_timee NAMELIST /physics/ nudge_light_int NAMELIST /physics/ path_to_files NAMELIST /physics/ gsfcgce_hail NAMELIST /physics/ gsfcgce_2ice NAMELIST /physics/ progn NAMELIST /physics/ accum_mode NAMELIST /physics/ aitken_mode NAMELIST /physics/ coarse_mode NAMELIST /physics/ do_radar_ref NAMELIST /physics/ ra_lw_physics NAMELIST /physics/ ra_sw_physics NAMELIST /physics/ ra_sw_eclipse NAMELIST /physics/ radt NAMELIST /physics/ naer NAMELIST /physics/ alb_sol NAMELIST /physics/ sf_sfclay_physics NAMELIST /physics/ sf_surface_physics NAMELIST /physics/ bl_pbl_physics NAMELIST /physics/ bl_mynn_tkebudget NAMELIST /physics/ ysu_topdown_pblmix NAMELIST /physics/ shinhong_tke_diag NAMELIST /physics/ bl_mynn_tkeadvect NAMELIST /physics/ bl_mynn_cloudpdf NAMELIST /physics/ bl_mynn_mixlength NAMELIST /physics/ bl_mynn_edmf NAMELIST /physics/ bl_mynn_edmf_mom NAMELIST /physics/ bl_mynn_edmf_tke NAMELIST /physics/ bl_mynn_mixscalars NAMELIST /physics/ bl_mynn_cloudmix NAMELIST /physics/ bl_mynn_mixqt NAMELIST /physics/ icloud_bl NAMELIST /physics/ mfshconv NAMELIST /physics/ sf_urban_physics NAMELIST /physics/ bldt NAMELIST /physics/ cu_physics NAMELIST /physics/ shcu_physics NAMELIST /physics/ cu_diag NAMELIST /physics/ kf_edrates NAMELIST /physics/ kfeta_trigger NAMELIST /physics/ nsas_dx_factor NAMELIST /physics/ cudt NAMELIST /physics/ gsmdt NAMELIST /physics/ isfflx NAMELIST /physics/ ifsnow NAMELIST /physics/ icloud NAMELIST /physics/ ideal_xland NAMELIST /physics/ swrad_scat NAMELIST /physics/ surface_input_source NAMELIST /physics/ num_soil_layers NAMELIST /physics/ maxpatch NAMELIST /physics/ num_snow_layers NAMELIST /physics/ num_snso_layers NAMELIST /physics/ num_urban_layers NAMELIST /physics/ num_urban_hi NAMELIST /physics/ num_months NAMELIST /physics/ sf_surface_mosaic NAMELIST /physics/ mosaic_cat NAMELIST /physics/ mosaic_lu NAMELIST /physics/ mosaic_soil NAMELIST /physics/ flag_sm_adj NAMELIST /physics/ maxiens NAMELIST /physics/ maxens NAMELIST /physics/ maxens2 NAMELIST /physics/ maxens3 NAMELIST /physics/ ensdim NAMELIST /physics/ cugd_avedx NAMELIST /physics/ clos_choice NAMELIST /physics/ imomentum NAMELIST /physics/ ishallow NAMELIST /physics/ convtrans_avglen_m NAMELIST /physics/ num_land_cat NAMELIST /physics/ num_soil_cat NAMELIST /physics/ mp_zero_out NAMELIST /physics/ mp_zero_out_thresh NAMELIST /physics/ seaice_threshold NAMELIST /physics/ sst_update NAMELIST /physics/ sst_skin NAMELIST /physics/ tmn_update NAMELIST /physics/ usemonalb NAMELIST /physics/ rdmaxalb NAMELIST /physics/ rdlai2d NAMELIST /physics/ ua_phys NAMELIST /physics/ opt_thcnd NAMELIST /physics/ co2tf NAMELIST /physics/ ra_call_offset NAMELIST /physics/ cam_abs_freq_s NAMELIST /physics/ levsiz NAMELIST /physics/ paerlev NAMELIST /physics/ cam_abs_dim1 NAMELIST /physics/ cam_abs_dim2 NAMELIST /physics/ lagday NAMELIST /physics/ no_src_types NAMELIST /physics/ alevsiz NAMELIST /physics/ o3input NAMELIST /physics/ aer_opt NAMELIST /physics/ swint_opt NAMELIST /physics/ aer_type NAMELIST /physics/ aer_aod550_opt NAMELIST /physics/ aer_angexp_opt NAMELIST /physics/ aer_ssa_opt NAMELIST /physics/ aer_asy_opt NAMELIST /physics/ aer_aod550_val NAMELIST /physics/ aer_angexp_val NAMELIST /physics/ aer_ssa_val NAMELIST /physics/ aer_asy_val NAMELIST /physics/ cu_rad_feedback NAMELIST /physics/ shallowcu_forced_ra NAMELIST /physics/ numbins NAMELIST /physics/ thbinsize NAMELIST /physics/ rbinsize NAMELIST /physics/ mindeepfreq NAMELIST /physics/ minshallowfreq NAMELIST /physics/ shcu_aerosols_opt NAMELIST /physics/ pxlsm_smois_init NAMELIST /physics/ omlcall NAMELIST /physics/ sf_ocean_physics NAMELIST /physics/ traj_opt NAMELIST /physics/ dm_has_traj NAMELIST /physics/ tracercall NAMELIST /physics/ omdt NAMELIST /physics/ oml_hml0 NAMELIST /physics/ oml_gamma NAMELIST /physics/ oml_relaxation_time NAMELIST /physics/ isftcflx NAMELIST /physics/ iz0tlnd NAMELIST /physics/ shadlen NAMELIST /physics/ slope_rad NAMELIST /physics/ topo_shading NAMELIST /physics/ topo_wind NAMELIST /physics/ no_mp_heating NAMELIST /physics/ fractional_seaice NAMELIST /physics/ seaice_snowdepth_opt NAMELIST /physics/ seaice_snowdepth_max NAMELIST /physics/ seaice_snowdepth_min NAMELIST /physics/ seaice_albedo_opt NAMELIST /physics/ seaice_albedo_default NAMELIST /physics/ seaice_thickness_opt NAMELIST /physics/ seaice_thickness_default NAMELIST /physics/ tice2tsk_if2cold NAMELIST /physics/ bucket_mm NAMELIST /physics/ bucket_j NAMELIST /physics/ mp_tend_radar NAMELIST /physics/ mp_tend_lim NAMELIST /physics/ prec_acc_dt NAMELIST /physics/ prec_acc_dt1 NAMELIST /physics/ grav_settling NAMELIST /physics/ sas_pgcon NAMELIST /physics/ scalar_pblmix NAMELIST /physics/ tracer_pblmix NAMELIST /physics/ use_aero_icbc NAMELIST /physics/ use_rap_aero_icbc NAMELIST /physics/ use_mp_re NAMELIST /physics/ ccn_conc NAMELIST /physics/ hail_opt NAMELIST /noah_mp/ dveg NAMELIST /noah_mp/ opt_crs NAMELIST /noah_mp/ opt_btr NAMELIST /noah_mp/ opt_run NAMELIST /noah_mp/ opt_sfc NAMELIST /noah_mp/ opt_frz NAMELIST /noah_mp/ opt_inf NAMELIST /noah_mp/ opt_rad NAMELIST /noah_mp/ opt_alb NAMELIST /noah_mp/ opt_snf NAMELIST /noah_mp/ opt_tbot NAMELIST /noah_mp/ opt_stc NAMELIST /noah_mp/ opt_gla NAMELIST /noah_mp/ opt_rsf NAMELIST /physics/ wtddt NAMELIST /fdda/ fgdt NAMELIST /fdda/ fgdtzero NAMELIST /fdda/ grid_fdda NAMELIST /fdda/ grid_sfdda NAMELIST /fdda/ if_no_pbl_nudging_uv NAMELIST /fdda/ if_no_pbl_nudging_t NAMELIST /fdda/ if_no_pbl_nudging_ph NAMELIST /fdda/ if_no_pbl_nudging_q NAMELIST /fdda/ if_zfac_uv NAMELIST /fdda/ k_zfac_uv NAMELIST /fdda/ if_zfac_t NAMELIST /fdda/ k_zfac_t NAMELIST /fdda/ if_zfac_ph NAMELIST /fdda/ k_zfac_ph NAMELIST /fdda/ if_zfac_q NAMELIST /fdda/ k_zfac_q NAMELIST /fdda/ dk_zfac_uv NAMELIST /fdda/ dk_zfac_t NAMELIST /fdda/ dk_zfac_ph NAMELIST /fdda/ guv NAMELIST /fdda/ guv_sfc NAMELIST /fdda/ gt NAMELIST /fdda/ gt_sfc NAMELIST /fdda/ gq NAMELIST /fdda/ gq_sfc NAMELIST /fdda/ gph NAMELIST /fdda/ dtramp_min NAMELIST /fdda/ if_ramping NAMELIST /fdda/ rinblw NAMELIST /fdda/ xwavenum NAMELIST /fdda/ ywavenum NAMELIST /fdda/ pxlsm_soil_nudge NAMELIST /fdda/ obs_nudge_opt NAMELIST /fdda/ max_obs NAMELIST /fdda/ fdda_start NAMELIST /fdda/ fdda_end NAMELIST /fdda/ obs_nudge_wind NAMELIST /fdda/ obs_coef_wind NAMELIST /fdda/ obs_nudge_temp NAMELIST /fdda/ obs_coef_temp NAMELIST /fdda/ obs_nudge_mois NAMELIST /fdda/ obs_coef_mois NAMELIST /fdda/ obs_nudge_pstr NAMELIST /fdda/ obs_coef_pstr NAMELIST /fdda/ obs_no_pbl_nudge_uv NAMELIST /fdda/ obs_no_pbl_nudge_t NAMELIST /fdda/ obs_no_pbl_nudge_q NAMELIST /fdda/ obs_sfc_scheme_horiz NAMELIST /fdda/ obs_sfc_scheme_vert NAMELIST /fdda/ obs_max_sndng_gap NAMELIST /fdda/ obs_nudgezfullr1_uv NAMELIST /fdda/ obs_nudgezrampr1_uv NAMELIST /fdda/ obs_nudgezfullr2_uv NAMELIST /fdda/ obs_nudgezrampr2_uv NAMELIST /fdda/ obs_nudgezfullr4_uv NAMELIST /fdda/ obs_nudgezrampr4_uv NAMELIST /fdda/ obs_nudgezfullr1_t NAMELIST /fdda/ obs_nudgezrampr1_t NAMELIST /fdda/ obs_nudgezfullr2_t NAMELIST /fdda/ obs_nudgezrampr2_t NAMELIST /fdda/ obs_nudgezfullr4_t NAMELIST /fdda/ obs_nudgezrampr4_t NAMELIST /fdda/ obs_nudgezfullr1_q NAMELIST /fdda/ obs_nudgezrampr1_q NAMELIST /fdda/ obs_nudgezfullr2_q NAMELIST /fdda/ obs_nudgezrampr2_q NAMELIST /fdda/ obs_nudgezfullr4_q NAMELIST /fdda/ obs_nudgezrampr4_q NAMELIST /fdda/ obs_nudgezfullmin NAMELIST /fdda/ obs_nudgezrampmin NAMELIST /fdda/ obs_nudgezmax NAMELIST /fdda/ obs_sfcfact NAMELIST /fdda/ obs_sfcfacr NAMELIST /fdda/ obs_dpsmx NAMELIST /fdda/ obs_rinxy NAMELIST /fdda/ obs_rinsig NAMELIST /fdda/ obs_twindo NAMELIST /fdda/ obs_npfi NAMELIST /fdda/ obs_ionf NAMELIST /fdda/ obs_idynin NAMELIST /fdda/ obs_dtramp NAMELIST /fdda/ obs_prt_max NAMELIST /fdda/ obs_prt_freq NAMELIST /fdda/ obs_ipf_in4dob NAMELIST /fdda/ obs_ipf_errob NAMELIST /fdda/ obs_ipf_nudob NAMELIST /fdda/ obs_ipf_init NAMELIST /fdda/ obs_scl_neg_qv_innov NAMELIST /scm/ scm_force NAMELIST /scm/ scm_force_dx NAMELIST /scm/ num_force_layers NAMELIST /scm/ scm_lu_index NAMELIST /scm/ scm_isltyp NAMELIST /scm/ scm_vegfra NAMELIST /scm/ scm_canwat NAMELIST /scm/ scm_lat NAMELIST /scm/ scm_lon NAMELIST /scm/ scm_th_t_tend NAMELIST /scm/ scm_qv_t_tend NAMELIST /scm/ scm_th_adv NAMELIST /scm/ scm_wind_adv NAMELIST /scm/ scm_qv_adv NAMELIST /scm/ scm_ql_adv NAMELIST /scm/ scm_vert_adv NAMELIST /scm/ num_force_soil_layers NAMELIST /scm/ scm_soilt_force NAMELIST /scm/ scm_soilq_force NAMELIST /scm/ scm_force_th_largescale NAMELIST /scm/ scm_force_qv_largescale NAMELIST /scm/ scm_force_ql_largescale NAMELIST /scm/ scm_force_wind_largescale NAMELIST /scm/ scm_force_skintemp NAMELIST /scm/ scm_force_flux NAMELIST /dynamics/ dyn_opt NAMELIST /dynamics/ rk_ord NAMELIST /dynamics/ w_damping NAMELIST /dynamics/ w_crit_cfl NAMELIST /dynamics/ zadvect_implicit NAMELIST /dynamics/ diff_opt NAMELIST /dynamics/ diff_opt_dfi NAMELIST /dynamics/ km_opt NAMELIST /dynamics/ km_opt_dfi NAMELIST /dynamics/ damp_opt NAMELIST /dynamics/ rad_nudge NAMELIST /dynamics/ gwd_opt NAMELIST /dynamics/ zdamp NAMELIST /dynamics/ dampcoef NAMELIST /dynamics/ khdif NAMELIST /dynamics/ kvdif NAMELIST /dynamics/ diff_6th_factor NAMELIST /dynamics/ diff_6th_factor2 NAMELIST /dynamics/ diff_6th_opt NAMELIST /dynamics/ diff_6th_slopeopt NAMELIST /dynamics/ diff_6th_thresh NAMELIST /dynamics/ use_theta_m NAMELIST /dynamics/ use_q_diabatic NAMELIST /dynamics/ c_s NAMELIST /dynamics/ c_k NAMELIST /dynamics/ smdiv NAMELIST /dynamics/ emdiv NAMELIST /dynamics/ epssm NAMELIST /dynamics/ non_hydrostatic NAMELIST /dynamics/ use_input_w NAMELIST /dynamics/ time_step_sound NAMELIST /dynamics/ h_mom_adv_order NAMELIST /dynamics/ v_mom_adv_order NAMELIST /dynamics/ h_sca_adv_order NAMELIST /dynamics/ v_sca_adv_order NAMELIST /dynamics/ momentum_adv_opt NAMELIST /dynamics/ moist_adv_opt NAMELIST /dynamics/ moist_adv_dfi_opt NAMELIST /dynamics/ chem_adv_opt NAMELIST /dynamics/ tracer_adv_opt NAMELIST /dynamics/ scalar_adv_opt NAMELIST /dynamics/ tke_adv_opt NAMELIST /dynamics/ moist_mix2_off NAMELIST /dynamics/ chem_mix2_off NAMELIST /dynamics/ tracer_mix2_off NAMELIST /dynamics/ scalar_mix2_off NAMELIST /dynamics/ tke_mix2_off NAMELIST /dynamics/ moist_mix6_off NAMELIST /dynamics/ chem_mix6_off NAMELIST /dynamics/ tracer_mix6_off NAMELIST /dynamics/ scalar_mix6_off NAMELIST /dynamics/ tke_mix6_off NAMELIST /dynamics/ top_radiation NAMELIST /dynamics/ mix_isotropic NAMELIST /dynamics/ mix_upper_bound NAMELIST /dynamics/ top_lid NAMELIST /dynamics/ tke_upper_bound NAMELIST /dynamics/ tke_drag_coefficient NAMELIST /dynamics/ tke_heat_flux NAMELIST /dynamics/ pert_coriolis NAMELIST /dynamics/ coriolis2d NAMELIST /dynamics/ mix_full_fields NAMELIST /dynamics/ base_pres NAMELIST /dynamics/ base_temp NAMELIST /dynamics/ base_lapse NAMELIST /dynamics/ iso_temp NAMELIST /dynamics/ base_pres_strat NAMELIST /dynamics/ base_lapse_strat NAMELIST /dynamics/ use_baseparam_fr_nml NAMELIST /dynamics/ fft_filter_lat NAMELIST /dynamics/ coupled_filtering NAMELIST /dynamics/ pos_def NAMELIST /dynamics/ swap_pole_with_next_j NAMELIST /dynamics/ actual_distance_average NAMELIST /dynamics/ rotated_pole NAMELIST /dynamics/ do_coriolis NAMELIST /dynamics/ do_curvature NAMELIST /dynamics/ do_gradp NAMELIST /dynamics/ tracer_opt NAMELIST /dynamics/ tenddiag NAMELIST /bdy_control/ spec_bdy_width NAMELIST /bdy_control/ spec_zone NAMELIST /bdy_control/ relax_zone NAMELIST /bdy_control/ specified NAMELIST /bdy_control/ constant_bc NAMELIST /bdy_control/ periodic_x NAMELIST /bdy_control/ symmetric_xs NAMELIST /bdy_control/ symmetric_xe NAMELIST /bdy_control/ open_xs NAMELIST /bdy_control/ open_xe NAMELIST /bdy_control/ periodic_y NAMELIST /bdy_control/ symmetric_ys NAMELIST /bdy_control/ symmetric_ye NAMELIST /bdy_control/ open_ys NAMELIST /bdy_control/ open_ye NAMELIST /bdy_control/ polar NAMELIST /bdy_control/ nested NAMELIST /bdy_control/ spec_exp NAMELIST /bdy_control/ spec_bdy_final_mu NAMELIST /bdy_control/ real_data_init_type NAMELIST /bdy_control/ have_bcs_moist NAMELIST /bdy_control/ have_bcs_scalar NAMELIST /grib2/ background_proc_id NAMELIST /grib2/ forecast_proc_id NAMELIST /grib2/ production_status NAMELIST /grib2/ compression NAMELIST /physics/ windfarm_opt NAMELIST /physics/ windfarm_ij NAMELIST /physics/ windfarm_ws NAMELIST /physics/ hailcast_opt NAMELIST /physics/ haildt NAMELIST /physics/ lightning_option NAMELIST /physics/ lightning_dt NAMELIST /physics/ lightning_start_seconds NAMELIST /physics/ flashrate_factor NAMELIST /physics/ iccg_method NAMELIST /physics/ iccg_prescribed_num NAMELIST /physics/ iccg_prescribed_den NAMELIST /physics/ cellcount_method NAMELIST /physics/ cldtop_adjustment NAMELIST /physics/ sf_lake_physics NAMELIST /time_control/ auxinput1_inname NAMELIST /time_control/ io_form_auxinput1 NAMELIST /time_control/ override_restart_timers NAMELIST /time_control/ auxhist1_inname NAMELIST /time_control/ auxhist1_outname NAMELIST /time_control/ auxhist1_interval_y NAMELIST /time_control/ auxhist1_interval_d NAMELIST /time_control/ auxhist1_interval_h NAMELIST /time_control/ auxhist1_interval_m NAMELIST /time_control/ auxhist1_interval_s NAMELIST /time_control/ auxhist1_interval NAMELIST /time_control/ auxhist1_begin_y NAMELIST /time_control/ auxhist1_begin_d NAMELIST /time_control/ auxhist1_begin_h NAMELIST /time_control/ auxhist1_begin_m NAMELIST /time_control/ auxhist1_begin_s NAMELIST /time_control/ auxhist1_begin NAMELIST /time_control/ auxhist1_end_y NAMELIST /time_control/ auxhist1_end_d NAMELIST /time_control/ auxhist1_end_h NAMELIST /time_control/ auxhist1_end_m NAMELIST /time_control/ auxhist1_end_s NAMELIST /time_control/ auxhist1_end NAMELIST /time_control/ io_form_auxhist1 NAMELIST /time_control/ frames_per_auxhist1 NAMELIST /time_control/ auxhist2_inname NAMELIST /time_control/ auxhist2_outname NAMELIST /time_control/ auxhist2_interval_y NAMELIST /time_control/ auxhist2_interval_d NAMELIST /time_control/ auxhist2_interval_h NAMELIST /time_control/ auxhist2_interval_m NAMELIST /time_control/ auxhist2_interval_s NAMELIST /time_control/ auxhist2_interval NAMELIST /time_control/ auxhist2_begin_y NAMELIST /time_control/ auxhist2_begin_d NAMELIST /time_control/ auxhist2_begin_h NAMELIST /time_control/ auxhist2_begin_m NAMELIST /time_control/ auxhist2_begin_s NAMELIST /time_control/ auxhist2_begin NAMELIST /time_control/ auxhist2_end_y NAMELIST /time_control/ auxhist2_end_d NAMELIST /time_control/ auxhist2_end_h NAMELIST /time_control/ auxhist2_end_m NAMELIST /time_control/ auxhist2_end_s NAMELIST /time_control/ auxhist2_end NAMELIST /time_control/ io_form_auxhist2 NAMELIST /time_control/ frames_per_auxhist2 NAMELIST /time_control/ auxhist3_inname NAMELIST /time_control/ auxhist3_outname NAMELIST /time_control/ auxhist3_interval_y NAMELIST /time_control/ auxhist3_interval_d NAMELIST /time_control/ auxhist3_interval_h NAMELIST /time_control/ auxhist3_interval_m NAMELIST /time_control/ auxhist3_interval_s NAMELIST /time_control/ auxhist3_interval NAMELIST /time_control/ auxhist3_begin_y NAMELIST /time_control/ auxhist3_begin_d NAMELIST /time_control/ auxhist3_begin_h NAMELIST /time_control/ auxhist3_begin_m NAMELIST /time_control/ auxhist3_begin_s NAMELIST /time_control/ auxhist3_begin NAMELIST /time_control/ auxhist3_end_y NAMELIST /time_control/ auxhist3_end_d NAMELIST /time_control/ auxhist3_end_h NAMELIST /time_control/ auxhist3_end_m NAMELIST /time_control/ auxhist3_end_s NAMELIST /time_control/ auxhist3_end NAMELIST /time_control/ io_form_auxhist3 NAMELIST /time_control/ frames_per_auxhist3 NAMELIST /time_control/ auxhist4_inname NAMELIST /time_control/ auxhist4_outname NAMELIST /time_control/ auxhist4_interval_y NAMELIST /time_control/ auxhist4_interval_d NAMELIST /time_control/ auxhist4_interval_h NAMELIST /time_control/ auxhist4_interval_m NAMELIST /time_control/ auxhist4_interval_s NAMELIST /time_control/ auxhist4_interval NAMELIST /time_control/ auxhist4_begin_y NAMELIST /time_control/ auxhist4_begin_d NAMELIST /time_control/ auxhist4_begin_h NAMELIST /time_control/ auxhist4_begin_m NAMELIST /time_control/ auxhist4_begin_s NAMELIST /time_control/ auxhist4_begin NAMELIST /time_control/ auxhist4_end_y NAMELIST /time_control/ auxhist4_end_d NAMELIST /time_control/ auxhist4_end_h NAMELIST /time_control/ auxhist4_end_m NAMELIST /time_control/ auxhist4_end_s NAMELIST /time_control/ auxhist4_end NAMELIST /time_control/ io_form_auxhist4 NAMELIST /time_control/ frames_per_auxhist4 NAMELIST /time_control/ auxhist5_inname NAMELIST /time_control/ auxhist5_outname NAMELIST /time_control/ auxhist5_interval_y NAMELIST /time_control/ auxhist5_interval_d NAMELIST /time_control/ auxhist5_interval_h NAMELIST /time_control/ auxhist5_interval_m NAMELIST /time_control/ auxhist5_interval_s NAMELIST /time_control/ auxhist5_interval NAMELIST /time_control/ auxhist5_begin_y NAMELIST /time_control/ auxhist5_begin_d NAMELIST /time_control/ auxhist5_begin_h NAMELIST /time_control/ auxhist5_begin_m NAMELIST /time_control/ auxhist5_begin_s NAMELIST /time_control/ auxhist5_begin NAMELIST /time_control/ auxhist5_end_y NAMELIST /time_control/ auxhist5_end_d NAMELIST /time_control/ auxhist5_end_h NAMELIST /time_control/ auxhist5_end_m NAMELIST /time_control/ auxhist5_end_s NAMELIST /time_control/ auxhist5_end NAMELIST /time_control/ io_form_auxhist5 NAMELIST /time_control/ frames_per_auxhist5 NAMELIST /time_control/ auxhist6_inname NAMELIST /time_control/ auxhist6_outname NAMELIST /time_control/ auxhist6_interval_y NAMELIST /time_control/ auxhist6_interval_d NAMELIST /time_control/ auxhist6_interval_h NAMELIST /time_control/ auxhist6_interval_m NAMELIST /time_control/ auxhist6_interval_s NAMELIST /time_control/ auxhist6_interval NAMELIST /time_control/ auxhist6_begin_y NAMELIST /time_control/ auxhist6_begin_d NAMELIST /time_control/ auxhist6_begin_h NAMELIST /time_control/ auxhist6_begin_m NAMELIST /time_control/ auxhist6_begin_s NAMELIST /time_control/ auxhist6_begin NAMELIST /time_control/ auxhist6_end_y NAMELIST /time_control/ auxhist6_end_d NAMELIST /time_control/ auxhist6_end_h NAMELIST /time_control/ auxhist6_end_m NAMELIST /time_control/ auxhist6_end_s NAMELIST /time_control/ auxhist6_end NAMELIST /time_control/ io_form_auxhist6 NAMELIST /time_control/ frames_per_auxhist6 NAMELIST /time_control/ auxhist7_inname NAMELIST /time_control/ auxhist7_outname NAMELIST /time_control/ auxhist7_interval_y NAMELIST /time_control/ auxhist7_interval_d NAMELIST /time_control/ auxhist7_interval_h NAMELIST /time_control/ auxhist7_interval_m NAMELIST /time_control/ auxhist7_interval_s NAMELIST /time_control/ auxhist7_interval NAMELIST /time_control/ auxhist7_begin_y NAMELIST /time_control/ auxhist7_begin_d NAMELIST /time_control/ auxhist7_begin_h NAMELIST /time_control/ auxhist7_begin_m NAMELIST /time_control/ auxhist7_begin_s NAMELIST /time_control/ auxhist7_begin NAMELIST /time_control/ auxhist7_end_y NAMELIST /time_control/ auxhist7_end_d NAMELIST /time_control/ auxhist7_end_h NAMELIST /time_control/ auxhist7_end_m NAMELIST /time_control/ auxhist7_end_s NAMELIST /time_control/ auxhist7_end NAMELIST /time_control/ io_form_auxhist7 NAMELIST /time_control/ frames_per_auxhist7 NAMELIST /time_control/ auxhist8_inname NAMELIST /time_control/ auxhist8_outname NAMELIST /time_control/ auxhist8_interval_y NAMELIST /time_control/ auxhist8_interval_d NAMELIST /time_control/ auxhist8_interval_h NAMELIST /time_control/ auxhist8_interval_m NAMELIST /time_control/ auxhist8_interval_s NAMELIST /time_control/ auxhist8_interval NAMELIST /time_control/ auxhist8_begin_y NAMELIST /time_control/ auxhist8_begin_d NAMELIST /time_control/ auxhist8_begin_h NAMELIST /time_control/ auxhist8_begin_m NAMELIST /time_control/ auxhist8_begin_s NAMELIST /time_control/ auxhist8_begin NAMELIST /time_control/ auxhist8_end_y NAMELIST /time_control/ auxhist8_end_d NAMELIST /time_control/ auxhist8_end_h NAMELIST /time_control/ auxhist8_end_m NAMELIST /time_control/ auxhist8_end_s NAMELIST /time_control/ auxhist8_end NAMELIST /time_control/ io_form_auxhist8 NAMELIST /time_control/ frames_per_auxhist8 NAMELIST /time_control/ auxhist9_inname NAMELIST /time_control/ auxhist9_outname NAMELIST /time_control/ auxhist9_interval_y NAMELIST /time_control/ auxhist9_interval_d NAMELIST /time_control/ auxhist9_interval_h NAMELIST /time_control/ auxhist9_interval_m NAMELIST /time_control/ auxhist9_interval_s NAMELIST /time_control/ auxhist9_interval NAMELIST /time_control/ auxhist9_begin_y NAMELIST /time_control/ auxhist9_begin_d NAMELIST /time_control/ auxhist9_begin_h NAMELIST /time_control/ auxhist9_begin_m NAMELIST /time_control/ auxhist9_begin_s NAMELIST /time_control/ auxhist9_begin NAMELIST /time_control/ auxhist9_end_y NAMELIST /time_control/ auxhist9_end_d NAMELIST /time_control/ auxhist9_end_h NAMELIST /time_control/ auxhist9_end_m NAMELIST /time_control/ auxhist9_end_s NAMELIST /time_control/ auxhist9_end NAMELIST /time_control/ io_form_auxhist9 NAMELIST /time_control/ frames_per_auxhist9 NAMELIST /time_control/ auxhist10_inname NAMELIST /time_control/ auxhist10_outname NAMELIST /time_control/ auxhist10_interval_y NAMELIST /time_control/ auxhist10_interval_d NAMELIST /time_control/ auxhist10_interval_h NAMELIST /time_control/ auxhist10_interval_m NAMELIST /time_control/ auxhist10_interval_s NAMELIST /time_control/ auxhist10_interval NAMELIST /time_control/ auxhist10_begin_y NAMELIST /time_control/ auxhist10_begin_d NAMELIST /time_control/ auxhist10_begin_h NAMELIST /time_control/ auxhist10_begin_m NAMELIST /time_control/ auxhist10_begin_s NAMELIST /time_control/ auxhist10_begin NAMELIST /time_control/ auxhist10_end_y NAMELIST /time_control/ auxhist10_end_d NAMELIST /time_control/ auxhist10_end_h NAMELIST /time_control/ auxhist10_end_m NAMELIST /time_control/ auxhist10_end_s NAMELIST /time_control/ auxhist10_end NAMELIST /time_control/ io_form_auxhist10 NAMELIST /time_control/ frames_per_auxhist10 NAMELIST /time_control/ auxhist11_inname NAMELIST /time_control/ auxhist11_outname NAMELIST /time_control/ auxhist11_interval_y NAMELIST /time_control/ auxhist11_interval_d NAMELIST /time_control/ auxhist11_interval_h NAMELIST /time_control/ auxhist11_interval_m NAMELIST /time_control/ auxhist11_interval_s NAMELIST /time_control/ auxhist11_interval NAMELIST /time_control/ auxhist11_begin_y NAMELIST /time_control/ auxhist11_begin_d NAMELIST /time_control/ auxhist11_begin_h NAMELIST /time_control/ auxhist11_begin_m NAMELIST /time_control/ auxhist11_begin_s NAMELIST /time_control/ auxhist11_begin NAMELIST /time_control/ auxhist11_end_y NAMELIST /time_control/ auxhist11_end_d NAMELIST /time_control/ auxhist11_end_h NAMELIST /time_control/ auxhist11_end_m NAMELIST /time_control/ auxhist11_end_s NAMELIST /time_control/ auxhist11_end NAMELIST /time_control/ io_form_auxhist11 NAMELIST /time_control/ frames_per_auxhist11 NAMELIST /time_control/ auxhist12_inname NAMELIST /time_control/ auxhist12_outname NAMELIST /time_control/ auxhist12_interval_y NAMELIST /time_control/ auxhist12_interval_d NAMELIST /time_control/ auxhist12_interval_h NAMELIST /time_control/ auxhist12_interval_m NAMELIST /time_control/ auxhist12_interval_s NAMELIST /time_control/ auxhist12_interval NAMELIST /time_control/ auxhist12_begin_y NAMELIST /time_control/ auxhist12_begin_d NAMELIST /time_control/ auxhist12_begin_h NAMELIST /time_control/ auxhist12_begin_m NAMELIST /time_control/ auxhist12_begin_s NAMELIST /time_control/ auxhist12_begin NAMELIST /time_control/ auxhist12_end_y NAMELIST /time_control/ auxhist12_end_d NAMELIST /time_control/ auxhist12_end_h NAMELIST /time_control/ auxhist12_end_m NAMELIST /time_control/ auxhist12_end_s NAMELIST /time_control/ auxhist12_end NAMELIST /time_control/ io_form_auxhist12 NAMELIST /time_control/ frames_per_auxhist12 NAMELIST /time_control/ auxhist13_inname NAMELIST /time_control/ auxhist13_outname NAMELIST /time_control/ auxhist13_interval_y NAMELIST /time_control/ auxhist13_interval_d NAMELIST /time_control/ auxhist13_interval_h NAMELIST /time_control/ auxhist13_interval_m NAMELIST /time_control/ auxhist13_interval_s NAMELIST /time_control/ auxhist13_interval NAMELIST /time_control/ auxhist13_begin_y NAMELIST /time_control/ auxhist13_begin_d NAMELIST /time_control/ auxhist13_begin_h NAMELIST /time_control/ auxhist13_begin_m NAMELIST /time_control/ auxhist13_begin_s NAMELIST /time_control/ auxhist13_begin NAMELIST /time_control/ auxhist13_end_y NAMELIST /time_control/ auxhist13_end_d NAMELIST /time_control/ auxhist13_end_h NAMELIST /time_control/ auxhist13_end_m NAMELIST /time_control/ auxhist13_end_s NAMELIST /time_control/ auxhist13_end NAMELIST /time_control/ io_form_auxhist13 NAMELIST /time_control/ frames_per_auxhist13 NAMELIST /time_control/ auxhist14_inname NAMELIST /time_control/ auxhist14_outname NAMELIST /time_control/ auxhist14_interval_y NAMELIST /time_control/ auxhist14_interval_d NAMELIST /time_control/ auxhist14_interval_h NAMELIST /time_control/ auxhist14_interval_m NAMELIST /time_control/ auxhist14_interval_s NAMELIST /time_control/ auxhist14_interval NAMELIST /time_control/ auxhist14_begin_y NAMELIST /time_control/ auxhist14_begin_d NAMELIST /time_control/ auxhist14_begin_h NAMELIST /time_control/ auxhist14_begin_m NAMELIST /time_control/ auxhist14_begin_s NAMELIST /time_control/ auxhist14_begin NAMELIST /time_control/ auxhist14_end_y NAMELIST /time_control/ auxhist14_end_d NAMELIST /time_control/ auxhist14_end_h NAMELIST /time_control/ auxhist14_end_m NAMELIST /time_control/ auxhist14_end_s NAMELIST /time_control/ auxhist14_end NAMELIST /time_control/ io_form_auxhist14 NAMELIST /time_control/ frames_per_auxhist14 NAMELIST /time_control/ auxhist15_inname NAMELIST /time_control/ auxhist15_outname NAMELIST /time_control/ auxhist15_interval_y NAMELIST /time_control/ auxhist15_interval_d NAMELIST /time_control/ auxhist15_interval_h NAMELIST /time_control/ auxhist15_interval_m NAMELIST /time_control/ auxhist15_interval_s NAMELIST /time_control/ auxhist15_interval NAMELIST /time_control/ auxhist15_begin_y NAMELIST /time_control/ auxhist15_begin_d NAMELIST /time_control/ auxhist15_begin_h NAMELIST /time_control/ auxhist15_begin_m NAMELIST /time_control/ auxhist15_begin_s NAMELIST /time_control/ auxhist15_begin NAMELIST /time_control/ auxhist15_end_y NAMELIST /time_control/ auxhist15_end_d NAMELIST /time_control/ auxhist15_end_h NAMELIST /time_control/ auxhist15_end_m NAMELIST /time_control/ auxhist15_end_s NAMELIST /time_control/ auxhist15_end NAMELIST /time_control/ io_form_auxhist15 NAMELIST /time_control/ frames_per_auxhist15 NAMELIST /time_control/ auxhist16_inname NAMELIST /time_control/ auxhist16_outname NAMELIST /time_control/ auxhist16_interval_y NAMELIST /time_control/ auxhist16_interval_d NAMELIST /time_control/ auxhist16_interval_h NAMELIST /time_control/ auxhist16_interval_m NAMELIST /time_control/ auxhist16_interval_s NAMELIST /time_control/ auxhist16_interval NAMELIST /time_control/ auxhist16_begin_y NAMELIST /time_control/ auxhist16_begin_d NAMELIST /time_control/ auxhist16_begin_h NAMELIST /time_control/ auxhist16_begin_m NAMELIST /time_control/ auxhist16_begin_s NAMELIST /time_control/ auxhist16_begin NAMELIST /time_control/ auxhist16_end_y NAMELIST /time_control/ auxhist16_end_d NAMELIST /time_control/ auxhist16_end_h NAMELIST /time_control/ auxhist16_end_m NAMELIST /time_control/ auxhist16_end_s NAMELIST /time_control/ auxhist16_end NAMELIST /time_control/ io_form_auxhist16 NAMELIST /time_control/ frames_per_auxhist16 NAMELIST /time_control/ auxhist17_inname NAMELIST /time_control/ auxhist17_outname NAMELIST /time_control/ auxhist17_interval_y NAMELIST /time_control/ auxhist17_interval_d NAMELIST /time_control/ auxhist17_interval_h NAMELIST /time_control/ auxhist17_interval_m NAMELIST /time_control/ auxhist17_interval_s NAMELIST /time_control/ auxhist17_interval NAMELIST /time_control/ auxhist17_begin_y NAMELIST /time_control/ auxhist17_begin_d NAMELIST /time_control/ auxhist17_begin_h NAMELIST /time_control/ auxhist17_begin_m NAMELIST /time_control/ auxhist17_begin_s NAMELIST /time_control/ auxhist17_begin NAMELIST /time_control/ auxhist17_end_y NAMELIST /time_control/ auxhist17_end_d NAMELIST /time_control/ auxhist17_end_h NAMELIST /time_control/ auxhist17_end_m NAMELIST /time_control/ auxhist17_end_s NAMELIST /time_control/ auxhist17_end NAMELIST /time_control/ io_form_auxhist17 NAMELIST /time_control/ frames_per_auxhist17 NAMELIST /time_control/ auxhist18_inname NAMELIST /time_control/ auxhist18_outname NAMELIST /time_control/ auxhist18_interval_y NAMELIST /time_control/ auxhist18_interval_d NAMELIST /time_control/ auxhist18_interval_h NAMELIST /time_control/ auxhist18_interval_m NAMELIST /time_control/ auxhist18_interval_s NAMELIST /time_control/ auxhist18_interval NAMELIST /time_control/ auxhist18_begin_y NAMELIST /time_control/ auxhist18_begin_d NAMELIST /time_control/ auxhist18_begin_h NAMELIST /time_control/ auxhist18_begin_m NAMELIST /time_control/ auxhist18_begin_s NAMELIST /time_control/ auxhist18_begin NAMELIST /time_control/ auxhist18_end_y NAMELIST /time_control/ auxhist18_end_d NAMELIST /time_control/ auxhist18_end_h NAMELIST /time_control/ auxhist18_end_m NAMELIST /time_control/ auxhist18_end_s NAMELIST /time_control/ auxhist18_end NAMELIST /time_control/ io_form_auxhist18 NAMELIST /time_control/ frames_per_auxhist18 NAMELIST /time_control/ auxhist19_inname NAMELIST /time_control/ auxhist19_outname NAMELIST /time_control/ auxhist19_interval_y NAMELIST /time_control/ auxhist19_interval_d NAMELIST /time_control/ auxhist19_interval_h NAMELIST /time_control/ auxhist19_interval_m NAMELIST /time_control/ auxhist19_interval_s NAMELIST /time_control/ auxhist19_interval NAMELIST /time_control/ auxhist19_begin_y NAMELIST /time_control/ auxhist19_begin_d NAMELIST /time_control/ auxhist19_begin_h NAMELIST /time_control/ auxhist19_begin_m NAMELIST /time_control/ auxhist19_begin_s NAMELIST /time_control/ auxhist19_begin NAMELIST /time_control/ auxhist19_end_y NAMELIST /time_control/ auxhist19_end_d NAMELIST /time_control/ auxhist19_end_h NAMELIST /time_control/ auxhist19_end_m NAMELIST /time_control/ auxhist19_end_s NAMELIST /time_control/ auxhist19_end NAMELIST /time_control/ io_form_auxhist19 NAMELIST /time_control/ frames_per_auxhist19 NAMELIST /time_control/ auxhist20_inname NAMELIST /time_control/ auxhist20_outname NAMELIST /time_control/ auxhist20_interval_y NAMELIST /time_control/ auxhist20_interval_d NAMELIST /time_control/ auxhist20_interval_h NAMELIST /time_control/ auxhist20_interval_m NAMELIST /time_control/ auxhist20_interval_s NAMELIST /time_control/ auxhist20_interval NAMELIST /time_control/ auxhist20_begin_y NAMELIST /time_control/ auxhist20_begin_d NAMELIST /time_control/ auxhist20_begin_h NAMELIST /time_control/ auxhist20_begin_m NAMELIST /time_control/ auxhist20_begin_s NAMELIST /time_control/ auxhist20_begin NAMELIST /time_control/ auxhist20_end_y NAMELIST /time_control/ auxhist20_end_d NAMELIST /time_control/ auxhist20_end_h NAMELIST /time_control/ auxhist20_end_m NAMELIST /time_control/ auxhist20_end_s NAMELIST /time_control/ auxhist20_end NAMELIST /time_control/ io_form_auxhist20 NAMELIST /time_control/ frames_per_auxhist20 NAMELIST /time_control/ auxhist21_inname NAMELIST /time_control/ auxhist21_outname NAMELIST /time_control/ auxhist21_interval_y NAMELIST /time_control/ auxhist21_interval_d NAMELIST /time_control/ auxhist21_interval_h NAMELIST /time_control/ auxhist21_interval_m NAMELIST /time_control/ auxhist21_interval_s NAMELIST /time_control/ auxhist21_interval NAMELIST /time_control/ auxhist21_begin_y NAMELIST /time_control/ auxhist21_begin_d NAMELIST /time_control/ auxhist21_begin_h NAMELIST /time_control/ auxhist21_begin_m NAMELIST /time_control/ auxhist21_begin_s NAMELIST /time_control/ auxhist21_begin NAMELIST /time_control/ auxhist21_end_y NAMELIST /time_control/ auxhist21_end_d NAMELIST /time_control/ auxhist21_end_h NAMELIST /time_control/ auxhist21_end_m NAMELIST /time_control/ auxhist21_end_s NAMELIST /time_control/ auxhist21_end NAMELIST /time_control/ io_form_auxhist21 NAMELIST /time_control/ frames_per_auxhist21 NAMELIST /time_control/ auxhist22_inname NAMELIST /time_control/ auxhist22_outname NAMELIST /time_control/ auxhist22_interval_y NAMELIST /time_control/ auxhist22_interval_d NAMELIST /time_control/ auxhist22_interval_h NAMELIST /time_control/ auxhist22_interval_m NAMELIST /time_control/ auxhist22_interval_s NAMELIST /time_control/ auxhist22_interval NAMELIST /time_control/ auxhist22_begin_y NAMELIST /time_control/ auxhist22_begin_d NAMELIST /time_control/ auxhist22_begin_h NAMELIST /time_control/ auxhist22_begin_m NAMELIST /time_control/ auxhist22_begin_s NAMELIST /time_control/ auxhist22_begin NAMELIST /time_control/ auxhist22_end_y NAMELIST /time_control/ auxhist22_end_d NAMELIST /time_control/ auxhist22_end_h NAMELIST /time_control/ auxhist22_end_m NAMELIST /time_control/ auxhist22_end_s NAMELIST /time_control/ auxhist22_end NAMELIST /time_control/ io_form_auxhist22 NAMELIST /time_control/ frames_per_auxhist22 NAMELIST /time_control/ auxhist23_inname NAMELIST /time_control/ auxhist23_outname NAMELIST /time_control/ auxhist23_interval_y NAMELIST /time_control/ auxhist23_interval_d NAMELIST /time_control/ auxhist23_interval_h NAMELIST /time_control/ auxhist23_interval_m NAMELIST /time_control/ auxhist23_interval_s NAMELIST /time_control/ auxhist23_interval NAMELIST /time_control/ auxhist23_begin_y NAMELIST /time_control/ auxhist23_begin_d NAMELIST /time_control/ auxhist23_begin_h NAMELIST /time_control/ auxhist23_begin_m NAMELIST /time_control/ auxhist23_begin_s NAMELIST /time_control/ auxhist23_begin NAMELIST /time_control/ auxhist23_end_y NAMELIST /time_control/ auxhist23_end_d NAMELIST /time_control/ auxhist23_end_h NAMELIST /time_control/ auxhist23_end_m NAMELIST /time_control/ auxhist23_end_s NAMELIST /time_control/ auxhist23_end NAMELIST /time_control/ io_form_auxhist23 NAMELIST /time_control/ frames_per_auxhist23 NAMELIST /time_control/ auxhist24_inname NAMELIST /time_control/ auxhist24_outname NAMELIST /time_control/ auxhist24_interval_y NAMELIST /time_control/ auxhist24_interval_d NAMELIST /time_control/ auxhist24_interval_h NAMELIST /time_control/ auxhist24_interval_m NAMELIST /time_control/ auxhist24_interval_s NAMELIST /time_control/ auxhist24_interval NAMELIST /time_control/ auxhist24_begin_y NAMELIST /time_control/ auxhist24_begin_d NAMELIST /time_control/ auxhist24_begin_h NAMELIST /time_control/ auxhist24_begin_m NAMELIST /time_control/ auxhist24_begin_s NAMELIST /time_control/ auxhist24_begin NAMELIST /time_control/ auxhist24_end_y NAMELIST /time_control/ auxhist24_end_d NAMELIST /time_control/ auxhist24_end_h NAMELIST /time_control/ auxhist24_end_m NAMELIST /time_control/ auxhist24_end_s NAMELIST /time_control/ auxhist24_end NAMELIST /time_control/ io_form_auxhist24 NAMELIST /time_control/ frames_per_auxhist24 NAMELIST /time_control/ auxinput1_outname NAMELIST /time_control/ auxinput1_interval_y NAMELIST /time_control/ auxinput1_interval_d NAMELIST /time_control/ auxinput1_interval_h NAMELIST /time_control/ auxinput1_interval_m NAMELIST /time_control/ auxinput1_interval_s NAMELIST /time_control/ auxinput1_interval NAMELIST /time_control/ auxinput1_begin_y NAMELIST /time_control/ auxinput1_begin_d NAMELIST /time_control/ auxinput1_begin_h NAMELIST /time_control/ auxinput1_begin_m NAMELIST /time_control/ auxinput1_begin_s NAMELIST /time_control/ auxinput1_begin NAMELIST /time_control/ auxinput1_end_y NAMELIST /time_control/ auxinput1_end_d NAMELIST /time_control/ auxinput1_end_h NAMELIST /time_control/ auxinput1_end_m NAMELIST /time_control/ auxinput1_end_s NAMELIST /time_control/ auxinput1_end NAMELIST /time_control/ frames_per_auxinput1 NAMELIST /time_control/ auxinput2_inname NAMELIST /time_control/ auxinput2_outname NAMELIST /time_control/ auxinput2_interval_y NAMELIST /time_control/ auxinput2_interval_d NAMELIST /time_control/ auxinput2_interval_h NAMELIST /time_control/ auxinput2_interval_m NAMELIST /time_control/ auxinput2_interval_s NAMELIST /time_control/ auxinput2_interval NAMELIST /time_control/ auxinput2_begin_y NAMELIST /time_control/ auxinput2_begin_d NAMELIST /time_control/ auxinput2_begin_h NAMELIST /time_control/ auxinput2_begin_m NAMELIST /time_control/ auxinput2_begin_s NAMELIST /time_control/ auxinput2_begin NAMELIST /time_control/ auxinput2_end_y NAMELIST /time_control/ auxinput2_end_d NAMELIST /time_control/ auxinput2_end_h NAMELIST /time_control/ auxinput2_end_m NAMELIST /time_control/ auxinput2_end_s NAMELIST /time_control/ auxinput2_end NAMELIST /time_control/ io_form_auxinput2 NAMELIST /time_control/ frames_per_auxinput2 NAMELIST /time_control/ auxinput3_inname NAMELIST /time_control/ auxinput3_outname NAMELIST /time_control/ auxinput3_interval_y NAMELIST /time_control/ auxinput3_interval_d NAMELIST /time_control/ auxinput3_interval_h NAMELIST /time_control/ auxinput3_interval_m NAMELIST /time_control/ auxinput3_interval_s NAMELIST /time_control/ auxinput3_interval NAMELIST /time_control/ auxinput3_begin_y NAMELIST /time_control/ auxinput3_begin_d NAMELIST /time_control/ auxinput3_begin_h NAMELIST /time_control/ auxinput3_begin_m NAMELIST /time_control/ auxinput3_begin_s NAMELIST /time_control/ auxinput3_begin NAMELIST /time_control/ auxinput3_end_y NAMELIST /time_control/ auxinput3_end_d NAMELIST /time_control/ auxinput3_end_h NAMELIST /time_control/ auxinput3_end_m NAMELIST /time_control/ auxinput3_end_s NAMELIST /time_control/ auxinput3_end NAMELIST /time_control/ io_form_auxinput3 NAMELIST /time_control/ frames_per_auxinput3 NAMELIST /time_control/ auxinput4_inname NAMELIST /time_control/ auxinput4_outname NAMELIST /time_control/ auxinput4_interval_y NAMELIST /time_control/ auxinput4_interval_d NAMELIST /time_control/ auxinput4_interval_h NAMELIST /time_control/ auxinput4_interval_m NAMELIST /time_control/ auxinput4_interval_s NAMELIST /time_control/ auxinput4_interval NAMELIST /time_control/ auxinput4_begin_y NAMELIST /time_control/ auxinput4_begin_d NAMELIST /time_control/ auxinput4_begin_h NAMELIST /time_control/ auxinput4_begin_m NAMELIST /time_control/ auxinput4_begin_s NAMELIST /time_control/ auxinput4_begin NAMELIST /time_control/ auxinput4_end_y NAMELIST /time_control/ auxinput4_end_d NAMELIST /time_control/ auxinput4_end_h NAMELIST /time_control/ auxinput4_end_m NAMELIST /time_control/ auxinput4_end_s NAMELIST /time_control/ auxinput4_end NAMELIST /time_control/ io_form_auxinput4 NAMELIST /time_control/ frames_per_auxinput4 NAMELIST /time_control/ auxinput5_inname NAMELIST /time_control/ auxinput5_outname NAMELIST /time_control/ auxinput5_interval_y NAMELIST /time_control/ auxinput5_interval_d NAMELIST /time_control/ auxinput5_interval_h NAMELIST /time_control/ auxinput5_interval_m NAMELIST /time_control/ auxinput5_interval_s NAMELIST /time_control/ auxinput5_interval NAMELIST /time_control/ auxinput5_begin_y NAMELIST /time_control/ auxinput5_begin_d NAMELIST /time_control/ auxinput5_begin_h NAMELIST /time_control/ auxinput5_begin_m NAMELIST /time_control/ auxinput5_begin_s NAMELIST /time_control/ auxinput5_begin NAMELIST /time_control/ auxinput5_end_y NAMELIST /time_control/ auxinput5_end_d NAMELIST /time_control/ auxinput5_end_h NAMELIST /time_control/ auxinput5_end_m NAMELIST /time_control/ auxinput5_end_s NAMELIST /time_control/ auxinput5_end NAMELIST /time_control/ io_form_auxinput5 NAMELIST /time_control/ frames_per_auxinput5 NAMELIST /time_control/ auxinput6_inname NAMELIST /time_control/ auxinput6_outname NAMELIST /time_control/ auxinput6_interval_y NAMELIST /time_control/ auxinput6_interval_d NAMELIST /time_control/ auxinput6_interval_h NAMELIST /time_control/ auxinput6_interval_m NAMELIST /time_control/ auxinput6_interval_s NAMELIST /time_control/ auxinput6_interval NAMELIST /time_control/ auxinput6_begin_y NAMELIST /time_control/ auxinput6_begin_d NAMELIST /time_control/ auxinput6_begin_h NAMELIST /time_control/ auxinput6_begin_m NAMELIST /time_control/ auxinput6_begin_s NAMELIST /time_control/ auxinput6_begin NAMELIST /time_control/ auxinput6_end_y NAMELIST /time_control/ auxinput6_end_d NAMELIST /time_control/ auxinput6_end_h NAMELIST /time_control/ auxinput6_end_m NAMELIST /time_control/ auxinput6_end_s NAMELIST /time_control/ auxinput6_end NAMELIST /time_control/ io_form_auxinput6 NAMELIST /time_control/ frames_per_auxinput6 NAMELIST /time_control/ auxinput7_inname NAMELIST /time_control/ auxinput7_outname NAMELIST /time_control/ auxinput7_interval_y NAMELIST /time_control/ auxinput7_interval_d NAMELIST /time_control/ auxinput7_interval_h NAMELIST /time_control/ auxinput7_interval_m NAMELIST /time_control/ auxinput7_interval_s NAMELIST /time_control/ auxinput7_interval NAMELIST /time_control/ auxinput7_begin_y NAMELIST /time_control/ auxinput7_begin_d NAMELIST /time_control/ auxinput7_begin_h NAMELIST /time_control/ auxinput7_begin_m NAMELIST /time_control/ auxinput7_begin_s NAMELIST /time_control/ auxinput7_begin NAMELIST /time_control/ auxinput7_end_y NAMELIST /time_control/ auxinput7_end_d NAMELIST /time_control/ auxinput7_end_h NAMELIST /time_control/ auxinput7_end_m NAMELIST /time_control/ auxinput7_end_s NAMELIST /time_control/ auxinput7_end NAMELIST /time_control/ io_form_auxinput7 NAMELIST /time_control/ frames_per_auxinput7 NAMELIST /time_control/ auxinput8_inname NAMELIST /time_control/ auxinput8_outname NAMELIST /time_control/ auxinput8_interval_y NAMELIST /time_control/ auxinput8_interval_d NAMELIST /time_control/ auxinput8_interval_h NAMELIST /time_control/ auxinput8_interval_m NAMELIST /time_control/ auxinput8_interval_s NAMELIST /time_control/ auxinput8_interval NAMELIST /time_control/ auxinput8_begin_y NAMELIST /time_control/ auxinput8_begin_d NAMELIST /time_control/ auxinput8_begin_h NAMELIST /time_control/ auxinput8_begin_m NAMELIST /time_control/ auxinput8_begin_s NAMELIST /time_control/ auxinput8_begin NAMELIST /time_control/ auxinput8_end_y NAMELIST /time_control/ auxinput8_end_d NAMELIST /time_control/ auxinput8_end_h NAMELIST /time_control/ auxinput8_end_m NAMELIST /time_control/ auxinput8_end_s NAMELIST /time_control/ auxinput8_end NAMELIST /time_control/ io_form_auxinput8 NAMELIST /time_control/ frames_per_auxinput8 NAMELIST /time_control/ auxinput9_inname NAMELIST /time_control/ auxinput9_outname NAMELIST /time_control/ auxinput9_interval_y NAMELIST /time_control/ auxinput9_interval_d NAMELIST /time_control/ auxinput9_interval_h NAMELIST /time_control/ auxinput9_interval_m NAMELIST /time_control/ auxinput9_interval_s NAMELIST /time_control/ auxinput9_interval NAMELIST /time_control/ auxinput9_begin_y NAMELIST /time_control/ auxinput9_begin_d NAMELIST /time_control/ auxinput9_begin_h NAMELIST /time_control/ auxinput9_begin_m NAMELIST /time_control/ auxinput9_begin_s NAMELIST /time_control/ auxinput9_begin NAMELIST /time_control/ auxinput9_end_y NAMELIST /time_control/ auxinput9_end_d NAMELIST /time_control/ auxinput9_end_h NAMELIST /time_control/ auxinput9_end_m NAMELIST /time_control/ auxinput9_end_s NAMELIST /time_control/ auxinput9_end NAMELIST /time_control/ io_form_auxinput9 NAMELIST /time_control/ frames_per_auxinput9 NAMELIST /time_control/ auxinput10_inname NAMELIST /time_control/ auxinput10_outname NAMELIST /time_control/ auxinput10_interval_y NAMELIST /time_control/ auxinput10_interval_d NAMELIST /time_control/ auxinput10_interval_h NAMELIST /time_control/ auxinput10_interval_m NAMELIST /time_control/ auxinput10_interval_s NAMELIST /time_control/ auxinput10_interval NAMELIST /time_control/ auxinput10_begin_y NAMELIST /time_control/ auxinput10_begin_d NAMELIST /time_control/ auxinput10_begin_h NAMELIST /time_control/ auxinput10_begin_m NAMELIST /time_control/ auxinput10_begin_s NAMELIST /time_control/ auxinput10_begin NAMELIST /time_control/ auxinput10_end_y NAMELIST /time_control/ auxinput10_end_d NAMELIST /time_control/ auxinput10_end_h NAMELIST /time_control/ auxinput10_end_m NAMELIST /time_control/ auxinput10_end_s NAMELIST /time_control/ auxinput10_end NAMELIST /time_control/ io_form_auxinput10 NAMELIST /time_control/ frames_per_auxinput10 NAMELIST /time_control/ auxinput11_inname NAMELIST /time_control/ auxinput11_outname NAMELIST /time_control/ auxinput11_interval_y NAMELIST /time_control/ auxinput11_interval_d NAMELIST /time_control/ auxinput11_interval_h NAMELIST /time_control/ auxinput11_interval_m NAMELIST /time_control/ auxinput11_interval_s NAMELIST /time_control/ auxinput11_interval NAMELIST /time_control/ auxinput11_begin_y NAMELIST /time_control/ auxinput11_begin_d NAMELIST /time_control/ auxinput11_begin_h NAMELIST /time_control/ auxinput11_begin_m NAMELIST /time_control/ auxinput11_begin_s NAMELIST /time_control/ auxinput11_begin NAMELIST /time_control/ auxinput11_end_y NAMELIST /time_control/ auxinput11_end_d NAMELIST /time_control/ auxinput11_end_h NAMELIST /time_control/ auxinput11_end_m NAMELIST /time_control/ auxinput11_end_s NAMELIST /time_control/ auxinput11_end NAMELIST /time_control/ io_form_auxinput11 NAMELIST /time_control/ frames_per_auxinput11 NAMELIST /time_control/ auxinput12_inname NAMELIST /time_control/ auxinput12_outname NAMELIST /time_control/ auxinput12_interval_y NAMELIST /time_control/ auxinput12_interval_d NAMELIST /time_control/ auxinput12_interval_h NAMELIST /time_control/ auxinput12_interval_m NAMELIST /time_control/ auxinput12_interval_s NAMELIST /time_control/ auxinput12_interval NAMELIST /time_control/ auxinput12_begin_y NAMELIST /time_control/ auxinput12_begin_d NAMELIST /time_control/ auxinput12_begin_h NAMELIST /time_control/ auxinput12_begin_m NAMELIST /time_control/ auxinput12_begin_s NAMELIST /time_control/ auxinput12_begin NAMELIST /time_control/ auxinput12_end_y NAMELIST /time_control/ auxinput12_end_d NAMELIST /time_control/ auxinput12_end_h NAMELIST /time_control/ auxinput12_end_m NAMELIST /time_control/ auxinput12_end_s NAMELIST /time_control/ auxinput12_end NAMELIST /time_control/ io_form_auxinput12 NAMELIST /time_control/ frames_per_auxinput12 NAMELIST /time_control/ auxinput13_inname NAMELIST /time_control/ auxinput13_outname NAMELIST /time_control/ auxinput13_interval_y NAMELIST /time_control/ auxinput13_interval_d NAMELIST /time_control/ auxinput13_interval_h NAMELIST /time_control/ auxinput13_interval_m NAMELIST /time_control/ auxinput13_interval_s NAMELIST /time_control/ auxinput13_interval NAMELIST /time_control/ auxinput13_begin_y NAMELIST /time_control/ auxinput13_begin_d NAMELIST /time_control/ auxinput13_begin_h NAMELIST /time_control/ auxinput13_begin_m NAMELIST /time_control/ auxinput13_begin_s NAMELIST /time_control/ auxinput13_begin NAMELIST /time_control/ auxinput13_end_y NAMELIST /time_control/ auxinput13_end_d NAMELIST /time_control/ auxinput13_end_h NAMELIST /time_control/ auxinput13_end_m NAMELIST /time_control/ auxinput13_end_s NAMELIST /time_control/ auxinput13_end NAMELIST /time_control/ io_form_auxinput13 NAMELIST /time_control/ frames_per_auxinput13 NAMELIST /time_control/ auxinput14_inname NAMELIST /time_control/ auxinput14_outname NAMELIST /time_control/ auxinput14_interval_y NAMELIST /time_control/ auxinput14_interval_d NAMELIST /time_control/ auxinput14_interval_h NAMELIST /time_control/ auxinput14_interval_m NAMELIST /time_control/ auxinput14_interval_s NAMELIST /time_control/ auxinput14_interval NAMELIST /time_control/ auxinput14_begin_y NAMELIST /time_control/ auxinput14_begin_d NAMELIST /time_control/ auxinput14_begin_h NAMELIST /time_control/ auxinput14_begin_m NAMELIST /time_control/ auxinput14_begin_s NAMELIST /time_control/ auxinput14_begin NAMELIST /time_control/ auxinput14_end_y NAMELIST /time_control/ auxinput14_end_d NAMELIST /time_control/ auxinput14_end_h NAMELIST /time_control/ auxinput14_end_m NAMELIST /time_control/ auxinput14_end_s NAMELIST /time_control/ auxinput14_end NAMELIST /time_control/ io_form_auxinput14 NAMELIST /time_control/ frames_per_auxinput14 NAMELIST /time_control/ auxinput15_inname NAMELIST /time_control/ auxinput15_outname NAMELIST /time_control/ auxinput15_interval_y NAMELIST /time_control/ auxinput15_interval_d NAMELIST /time_control/ auxinput15_interval_h NAMELIST /time_control/ auxinput15_interval_m NAMELIST /time_control/ auxinput15_interval_s NAMELIST /time_control/ auxinput15_interval NAMELIST /time_control/ auxinput15_begin_y NAMELIST /time_control/ auxinput15_begin_d NAMELIST /time_control/ auxinput15_begin_h NAMELIST /time_control/ auxinput15_begin_m NAMELIST /time_control/ auxinput15_begin_s NAMELIST /time_control/ auxinput15_begin NAMELIST /time_control/ auxinput15_end_y NAMELIST /time_control/ auxinput15_end_d NAMELIST /time_control/ auxinput15_end_h NAMELIST /time_control/ auxinput15_end_m NAMELIST /time_control/ auxinput15_end_s NAMELIST /time_control/ auxinput15_end NAMELIST /time_control/ io_form_auxinput15 NAMELIST /time_control/ frames_per_auxinput15 NAMELIST /time_control/ auxinput16_inname NAMELIST /time_control/ auxinput16_outname NAMELIST /time_control/ auxinput16_interval_y NAMELIST /time_control/ auxinput16_interval_d NAMELIST /time_control/ auxinput16_interval_h NAMELIST /time_control/ auxinput16_interval_m NAMELIST /time_control/ auxinput16_interval_s NAMELIST /time_control/ auxinput16_interval NAMELIST /time_control/ auxinput16_begin_y NAMELIST /time_control/ auxinput16_begin_d NAMELIST /time_control/ auxinput16_begin_h NAMELIST /time_control/ auxinput16_begin_m NAMELIST /time_control/ auxinput16_begin_s NAMELIST /time_control/ auxinput16_begin NAMELIST /time_control/ auxinput16_end_y NAMELIST /time_control/ auxinput16_end_d NAMELIST /time_control/ auxinput16_end_h NAMELIST /time_control/ auxinput16_end_m NAMELIST /time_control/ auxinput16_end_s NAMELIST /time_control/ auxinput16_end NAMELIST /time_control/ io_form_auxinput16 NAMELIST /time_control/ frames_per_auxinput16 NAMELIST /time_control/ auxinput17_inname NAMELIST /time_control/ auxinput17_outname NAMELIST /time_control/ auxinput17_interval_y NAMELIST /time_control/ auxinput17_interval_d NAMELIST /time_control/ auxinput17_interval_h NAMELIST /time_control/ auxinput17_interval_m NAMELIST /time_control/ auxinput17_interval_s NAMELIST /time_control/ auxinput17_interval NAMELIST /time_control/ auxinput17_begin_y NAMELIST /time_control/ auxinput17_begin_d NAMELIST /time_control/ auxinput17_begin_h NAMELIST /time_control/ auxinput17_begin_m NAMELIST /time_control/ auxinput17_begin_s NAMELIST /time_control/ auxinput17_begin NAMELIST /time_control/ auxinput17_end_y NAMELIST /time_control/ auxinput17_end_d NAMELIST /time_control/ auxinput17_end_h NAMELIST /time_control/ auxinput17_end_m NAMELIST /time_control/ auxinput17_end_s NAMELIST /time_control/ auxinput17_end NAMELIST /time_control/ io_form_auxinput17 NAMELIST /time_control/ frames_per_auxinput17 NAMELIST /time_control/ auxinput18_inname NAMELIST /time_control/ auxinput18_outname NAMELIST /time_control/ auxinput18_interval_y NAMELIST /time_control/ auxinput18_interval_d NAMELIST /time_control/ auxinput18_interval_h NAMELIST /time_control/ auxinput18_interval_m NAMELIST /time_control/ auxinput18_interval_s NAMELIST /time_control/ auxinput18_interval NAMELIST /time_control/ auxinput18_begin_y NAMELIST /time_control/ auxinput18_begin_d NAMELIST /time_control/ auxinput18_begin_h NAMELIST /time_control/ auxinput18_begin_m NAMELIST /time_control/ auxinput18_begin_s NAMELIST /time_control/ auxinput18_begin NAMELIST /time_control/ auxinput18_end_y NAMELIST /time_control/ auxinput18_end_d NAMELIST /time_control/ auxinput18_end_h NAMELIST /time_control/ auxinput18_end_m NAMELIST /time_control/ auxinput18_end_s NAMELIST /time_control/ auxinput18_end NAMELIST /time_control/ io_form_auxinput18 NAMELIST /time_control/ frames_per_auxinput18 NAMELIST /time_control/ auxinput19_inname NAMELIST /time_control/ auxinput19_outname NAMELIST /time_control/ auxinput19_interval_y NAMELIST /time_control/ auxinput19_interval_d NAMELIST /time_control/ auxinput19_interval_h NAMELIST /time_control/ auxinput19_interval_m NAMELIST /time_control/ auxinput19_interval_s NAMELIST /time_control/ auxinput19_interval NAMELIST /time_control/ auxinput19_begin_y NAMELIST /time_control/ auxinput19_begin_d NAMELIST /time_control/ auxinput19_begin_h NAMELIST /time_control/ auxinput19_begin_m NAMELIST /time_control/ auxinput19_begin_s NAMELIST /time_control/ auxinput19_begin NAMELIST /time_control/ auxinput19_end_y NAMELIST /time_control/ auxinput19_end_d NAMELIST /time_control/ auxinput19_end_h NAMELIST /time_control/ auxinput19_end_m NAMELIST /time_control/ auxinput19_end_s NAMELIST /time_control/ auxinput19_end NAMELIST /time_control/ io_form_auxinput19 NAMELIST /time_control/ frames_per_auxinput19 NAMELIST /time_control/ auxinput20_inname NAMELIST /time_control/ auxinput20_outname NAMELIST /time_control/ auxinput20_interval_y NAMELIST /time_control/ auxinput20_interval_d NAMELIST /time_control/ auxinput20_interval_h NAMELIST /time_control/ auxinput20_interval_m NAMELIST /time_control/ auxinput20_interval_s NAMELIST /time_control/ auxinput20_interval NAMELIST /time_control/ auxinput20_begin_y NAMELIST /time_control/ auxinput20_begin_d NAMELIST /time_control/ auxinput20_begin_h NAMELIST /time_control/ auxinput20_begin_m NAMELIST /time_control/ auxinput20_begin_s NAMELIST /time_control/ auxinput20_begin NAMELIST /time_control/ auxinput20_end_y NAMELIST /time_control/ auxinput20_end_d NAMELIST /time_control/ auxinput20_end_h NAMELIST /time_control/ auxinput20_end_m NAMELIST /time_control/ auxinput20_end_s NAMELIST /time_control/ auxinput20_end NAMELIST /time_control/ io_form_auxinput20 NAMELIST /time_control/ frames_per_auxinput20 NAMELIST /time_control/ auxinput21_inname NAMELIST /time_control/ auxinput21_outname NAMELIST /time_control/ auxinput21_interval_y NAMELIST /time_control/ auxinput21_interval_d NAMELIST /time_control/ auxinput21_interval_h NAMELIST /time_control/ auxinput21_interval_m NAMELIST /time_control/ auxinput21_interval_s NAMELIST /time_control/ auxinput21_interval NAMELIST /time_control/ auxinput21_begin_y NAMELIST /time_control/ auxinput21_begin_d NAMELIST /time_control/ auxinput21_begin_h NAMELIST /time_control/ auxinput21_begin_m NAMELIST /time_control/ auxinput21_begin_s NAMELIST /time_control/ auxinput21_begin NAMELIST /time_control/ auxinput21_end_y NAMELIST /time_control/ auxinput21_end_d NAMELIST /time_control/ auxinput21_end_h NAMELIST /time_control/ auxinput21_end_m NAMELIST /time_control/ auxinput21_end_s NAMELIST /time_control/ auxinput21_end NAMELIST /time_control/ io_form_auxinput21 NAMELIST /time_control/ frames_per_auxinput21 NAMELIST /time_control/ auxinput22_inname NAMELIST /time_control/ auxinput22_outname NAMELIST /time_control/ auxinput22_interval_y NAMELIST /time_control/ auxinput22_interval_d NAMELIST /time_control/ auxinput22_interval_h NAMELIST /time_control/ auxinput22_interval_m NAMELIST /time_control/ auxinput22_interval_s NAMELIST /time_control/ auxinput22_interval NAMELIST /time_control/ auxinput22_begin_y NAMELIST /time_control/ auxinput22_begin_d NAMELIST /time_control/ auxinput22_begin_h NAMELIST /time_control/ auxinput22_begin_m NAMELIST /time_control/ auxinput22_begin_s NAMELIST /time_control/ auxinput22_begin NAMELIST /time_control/ auxinput22_end_y NAMELIST /time_control/ auxinput22_end_d NAMELIST /time_control/ auxinput22_end_h NAMELIST /time_control/ auxinput22_end_m NAMELIST /time_control/ auxinput22_end_s NAMELIST /time_control/ auxinput22_end NAMELIST /time_control/ io_form_auxinput22 NAMELIST /time_control/ frames_per_auxinput22 NAMELIST /time_control/ auxinput23_inname NAMELIST /time_control/ auxinput23_outname NAMELIST /time_control/ auxinput23_interval_y NAMELIST /time_control/ auxinput23_interval_d NAMELIST /time_control/ auxinput23_interval_h NAMELIST /time_control/ auxinput23_interval_m NAMELIST /time_control/ auxinput23_interval_s NAMELIST /time_control/ auxinput23_interval NAMELIST /time_control/ auxinput23_begin_y NAMELIST /time_control/ auxinput23_begin_d NAMELIST /time_control/ auxinput23_begin_h NAMELIST /time_control/ auxinput23_begin_m NAMELIST /time_control/ auxinput23_begin_s NAMELIST /time_control/ auxinput23_begin NAMELIST /time_control/ auxinput23_end_y NAMELIST /time_control/ auxinput23_end_d NAMELIST /time_control/ auxinput23_end_h NAMELIST /time_control/ auxinput23_end_m NAMELIST /time_control/ auxinput23_end_s NAMELIST /time_control/ auxinput23_end NAMELIST /time_control/ io_form_auxinput23 NAMELIST /time_control/ frames_per_auxinput23 NAMELIST /time_control/ auxinput24_inname NAMELIST /time_control/ auxinput24_outname NAMELIST /time_control/ auxinput24_interval_y NAMELIST /time_control/ auxinput24_interval_d NAMELIST /time_control/ auxinput24_interval_h NAMELIST /time_control/ auxinput24_interval_m NAMELIST /time_control/ auxinput24_interval_s NAMELIST /time_control/ auxinput24_interval NAMELIST /time_control/ auxinput24_begin_y NAMELIST /time_control/ auxinput24_begin_d NAMELIST /time_control/ auxinput24_begin_h NAMELIST /time_control/ auxinput24_begin_m NAMELIST /time_control/ auxinput24_begin_s NAMELIST /time_control/ auxinput24_begin NAMELIST /time_control/ auxinput24_end_y NAMELIST /time_control/ auxinput24_end_d NAMELIST /time_control/ auxinput24_end_h NAMELIST /time_control/ auxinput24_end_m NAMELIST /time_control/ auxinput24_end_s NAMELIST /time_control/ auxinput24_end NAMELIST /time_control/ io_form_auxinput24 NAMELIST /time_control/ frames_per_auxinput24 NAMELIST /time_control/ history_interval NAMELIST /time_control/ history_interval2 NAMELIST /time_control/ history_interval_change NAMELIST /time_control/ frames_per_outfile NAMELIST /time_control/ restart NAMELIST /time_control/ restart_interval NAMELIST /time_control/ io_form_input NAMELIST /time_control/ io_form_history NAMELIST /time_control/ io_form_restart NAMELIST /time_control/ io_form_boundary NAMELIST /time_control/ debug_level NAMELIST /time_control/ self_test_domain NAMELIST /time_control/ history_outname NAMELIST /time_control/ history_inname NAMELIST /time_control/ use_netcdf_classic NAMELIST /time_control/ history_interval_d NAMELIST /time_control/ history_interval_h NAMELIST /time_control/ history_interval_m NAMELIST /time_control/ history_interval_s NAMELIST /time_control/ inputout_interval_d NAMELIST /time_control/ inputout_interval_h NAMELIST /time_control/ inputout_interval_m NAMELIST /time_control/ inputout_interval_s NAMELIST /time_control/ inputout_interval NAMELIST /time_control/ restart_interval_d NAMELIST /time_control/ restart_interval_h NAMELIST /time_control/ restart_interval_m NAMELIST /time_control/ restart_interval_s NAMELIST /time_control/ history_begin_y NAMELIST /time_control/ history_begin_d NAMELIST /time_control/ history_begin_h NAMELIST /time_control/ history_begin_m NAMELIST /time_control/ history_begin_s NAMELIST /time_control/ history_begin NAMELIST /time_control/ inputout_begin_y NAMELIST /time_control/ inputout_begin_d NAMELIST /time_control/ inputout_begin_h NAMELIST /time_control/ inputout_begin_m NAMELIST /time_control/ inputout_begin_s NAMELIST /time_control/ restart_begin_y NAMELIST /time_control/ restart_begin_d NAMELIST /time_control/ restart_begin_h NAMELIST /time_control/ restart_begin_m NAMELIST /time_control/ restart_begin_s NAMELIST /time_control/ restart_begin NAMELIST /time_control/ history_end_y NAMELIST /time_control/ history_end_d NAMELIST /time_control/ history_end_h NAMELIST /time_control/ history_end_m NAMELIST /time_control/ history_end_s NAMELIST /time_control/ history_end NAMELIST /time_control/ inputout_end_y NAMELIST /time_control/ inputout_end_d NAMELIST /time_control/ inputout_end_h NAMELIST /time_control/ inputout_end_m NAMELIST /time_control/ inputout_end_s NAMELIST /time_control/ reset_simulation_start NAMELIST /domains/ sr_x NAMELIST /domains/ sr_y NAMELIST /fdda/ sgfdda_inname NAMELIST /fdda/ gfdda_inname NAMELIST /fdda/ sgfdda_interval_d NAMELIST /fdda/ sgfdda_interval_h NAMELIST /fdda/ sgfdda_interval_m NAMELIST /fdda/ sgfdda_interval_s NAMELIST /fdda/ sgfdda_interval_y NAMELIST /fdda/ sgfdda_interval NAMELIST /fdda/ gfdda_interval_d NAMELIST /fdda/ gfdda_interval_h NAMELIST /fdda/ gfdda_interval_m NAMELIST /fdda/ gfdda_interval_s NAMELIST /fdda/ gfdda_interval_y NAMELIST /fdda/ gfdda_interval NAMELIST /fdda/ sgfdda_begin_y NAMELIST /fdda/ sgfdda_begin_d NAMELIST /fdda/ sgfdda_begin_h NAMELIST /fdda/ sgfdda_begin_m NAMELIST /fdda/ sgfdda_begin_s NAMELIST /fdda/ gfdda_begin_y NAMELIST /fdda/ gfdda_begin_d NAMELIST /fdda/ gfdda_begin_h NAMELIST /fdda/ gfdda_begin_m NAMELIST /fdda/ gfdda_begin_s NAMELIST /fdda/ sgfdda_end_y NAMELIST /fdda/ sgfdda_end_d NAMELIST /fdda/ sgfdda_end_h NAMELIST /fdda/ sgfdda_end_m NAMELIST /fdda/ sgfdda_end_s NAMELIST /fdda/ gfdda_end_y NAMELIST /fdda/ gfdda_end_d NAMELIST /fdda/ gfdda_end_h NAMELIST /fdda/ gfdda_end_m NAMELIST /fdda/ gfdda_end_s NAMELIST /fdda/ io_form_sgfdda NAMELIST /fdda/ io_form_gfdda NAMELIST /time_control/ iofields_filename NAMELIST /time_control/ ignore_iofields_warning NAMELIST /time_control/ ncd_nofill NAMELIST /chem/ enh_vermix NAMELIST /chem/ bb_dcycle NAMELIST /chem/ flam_part NAMELIST /chem/ emi_inname NAMELIST /chem/ fireemi_inname NAMELIST /chem/ input_chem_inname NAMELIST /chem/ emi_outname NAMELIST /chem/ fireemi_outname NAMELIST /chem/ input_chem_outname NAMELIST /chem/ io_style_emissions NAMELIST /chem/ bioemdt NAMELIST /chem/ photdt NAMELIST /chem/ chemdt NAMELIST /chem/ ne_area NAMELIST /chem/ kemit NAMELIST /chem/ nmegan NAMELIST /chem/ kfuture NAMELIST /chem/ kfire NAMELIST /chem/ kemit_aircraft NAMELIST /chem/ kdvel NAMELIST /chem/ ndepvel NAMELIST /chem/ kdepvel NAMELIST /chem/ erosion_dim NAMELIST /chem/ biomass_emiss_opt NAMELIST /chem/ cam_mam_mode NAMELIST /chem/ cam_mam_nspec NAMELIST /chem/ cam_mp_mam_cpled NAMELIST /chem/ lightning_opt NAMELIST /chem/ lightning_time_step NAMELIST /chem/ temp_upper NAMELIST /chem/ temp_lower NAMELIST /chem/ n_ic NAMELIST /chem/ n_cg NAMELIST /chem/ passive_ltng NAMELIST /chem/ lflash_data NAMELIST /chem/ flashrate_method NAMELIST /chem/ vprm_opt NAMELIST /chem/ wpeat NAMELIST /chem/ wflood NAMELIST /chem/ term_opt NAMELIST /chem/ chem_conv_tr NAMELIST /chem/ conv_tr_wetscav NAMELIST /chem/ conv_tr_aqchem NAMELIST /chem/ chem_opt NAMELIST /chem/ gaschem_onoff NAMELIST /chem/ aerchem_onoff NAMELIST /chem/ wetscav_onoff NAMELIST /chem/ dustwd_onoff NAMELIST /chem/ cldchem_onoff NAMELIST /chem/ is_full_tuv NAMELIST /chem/ lambda_cutoff NAMELIST /chem/ cld_od_opt NAMELIST /chem/ pht_cldfrc_opt NAMELIST /chem/ vertmix_onoff NAMELIST /chem/ chem_in_opt NAMELIST /chem/ phot_opt NAMELIST /chem/ gas_drydep_opt NAMELIST /chem/ aer_drydep_opt NAMELIST /chem/ aero_diag_opt NAMELIST /chem/ aero_cw_diag_opt NAMELIST /chem/ kfcup_diag NAMELIST /chem/ diagnostic_chem NAMELIST /chem/ aer_aerodynres_opt NAMELIST /chem/ emiss_opt NAMELIST /chem/ emiss_opt_vol NAMELIST /chem/ dust_opt NAMELIST /chem/ dust_schme NAMELIST /chem/ dmsemis_opt NAMELIST /chem/ seas_opt NAMELIST /chem/ bio_emiss_opt NAMELIST /chem/ biomass_burn_opt NAMELIST /chem/ plumerisefire_frq NAMELIST /chem/ emiss_inpt_opt NAMELIST /chem/ gas_bc_opt NAMELIST /chem/ gas_ic_opt NAMELIST /chem/ aer_bc_opt NAMELIST /chem/ aer_ic_opt NAMELIST /chem/ have_bcs_chem NAMELIST /chem/ have_bcs_tracer NAMELIST /chem/ scale_fire_emiss NAMELIST /chem/ aer_ra_feedback NAMELIST /chem/ aer_op_opt NAMELIST /chem/ opt_pars_out NAMELIST /chem/ diagnostic_dep NAMELIST /chem/ aircraft_emiss_opt NAMELIST /chem/ have_bcs_upper NAMELIST /chem/ fixed_ubc_press NAMELIST /chem/ fixed_ubc_inname NAMELIST /chem/ trop_lev_inname NAMELIST /chem/ exo_coldens_inname NAMELIST /chem/ wes_seasonal_inname NAMELIST /chem/ chemdiag NAMELIST /chem/ dust_alpha NAMELIST /chem/ dust_gamma NAMELIST /chem/ dust_smtune NAMELIST /chem/ dust_ustune NAMELIST /chem/ dust_dsr NAMELIST /chem/ dust_veg NAMELIST /chem/ dust_soils NAMELIST /chem/ dust_smois NAMELIST /chem/ emiss_ash_hgt NAMELIST /chem/ depo_fact NAMELIST /chem/ track_chem_num NAMELIST /chem/ track_chem_name NAMELIST /chem/ track_rad_num NAMELIST /chem/ track_tuv_num NAMELIST /chem/ track_tuv_lev NAMELIST /chem/ n2o5_hetchem NAMELIST /chem/ af_lambda_start NAMELIST /chem/ af_lambda_end NAMELIST /chem/ plumerise_flag NAMELIST /chem/ debug_chem NAMELIST /chem/ simple_dir_fdb NAMELIST /chem/ simple_ind_fdb NAMELIST /chem/ lnox_opt NAMELIST /chem/ lnox_passive NAMELIST /physics/ ltng_temp_upper NAMELIST /physics/ ltng_temp_lower NAMELIST /chem/ has_o3_exo_coldens NAMELIST /chem/ du_at_grnd NAMELIST /chem/ scale_o3_to_grnd_exo_coldens NAMELIST /chem/ scale_o3_to_du_at_grnd NAMELIST /fire/ ifire NAMELIST /fire/ fire_boundary_guard NAMELIST /fire/ fire_num_ignitions NAMELIST /fire/ fire_ignition_ros1 NAMELIST /fire/ fire_ignition_start_lon1 NAMELIST /fire/ fire_ignition_start_lat1 NAMELIST /fire/ fire_ignition_end_lon1 NAMELIST /fire/ fire_ignition_end_lat1 NAMELIST /fire/ fire_ignition_radius1 NAMELIST /fire/ fire_ignition_start_time1 NAMELIST /fire/ fire_ignition_end_time1 NAMELIST /fire/ fire_ignition_ros2 NAMELIST /fire/ fire_ignition_start_lon2 NAMELIST /fire/ fire_ignition_start_lat2 NAMELIST /fire/ fire_ignition_end_lon2 NAMELIST /fire/ fire_ignition_end_lat2 NAMELIST /fire/ fire_ignition_radius2 NAMELIST /fire/ fire_ignition_start_time2 NAMELIST /fire/ fire_ignition_end_time2 NAMELIST /fire/ fire_ignition_ros3 NAMELIST /fire/ fire_ignition_start_lon3 NAMELIST /fire/ fire_ignition_start_lat3 NAMELIST /fire/ fire_ignition_end_lon3 NAMELIST /fire/ fire_ignition_end_lat3 NAMELIST /fire/ fire_ignition_radius3 NAMELIST /fire/ fire_ignition_start_time3 NAMELIST /fire/ fire_ignition_end_time3 NAMELIST /fire/ fire_ignition_ros4 NAMELIST /fire/ fire_ignition_start_lon4 NAMELIST /fire/ fire_ignition_start_lat4 NAMELIST /fire/ fire_ignition_end_lon4 NAMELIST /fire/ fire_ignition_end_lat4 NAMELIST /fire/ fire_ignition_radius4 NAMELIST /fire/ fire_ignition_start_time4 NAMELIST /fire/ fire_ignition_end_time4 NAMELIST /fire/ fire_ignition_ros5 NAMELIST /fire/ fire_ignition_start_lon5 NAMELIST /fire/ fire_ignition_start_lat5 NAMELIST /fire/ fire_ignition_end_lon5 NAMELIST /fire/ fire_ignition_end_lat5 NAMELIST /fire/ fire_ignition_radius5 NAMELIST /fire/ fire_ignition_start_time5 NAMELIST /fire/ fire_ignition_end_time5 NAMELIST /fire/ fire_ignition_start_x1 NAMELIST /fire/ fire_ignition_start_y1 NAMELIST /fire/ fire_ignition_end_x1 NAMELIST /fire/ fire_ignition_end_y1 NAMELIST /fire/ fire_ignition_start_x2 NAMELIST /fire/ fire_ignition_start_y2 NAMELIST /fire/ fire_ignition_end_x2 NAMELIST /fire/ fire_ignition_end_y2 NAMELIST /fire/ fire_ignition_start_x3 NAMELIST /fire/ fire_ignition_start_y3 NAMELIST /fire/ fire_ignition_end_x3 NAMELIST /fire/ fire_ignition_end_y3 NAMELIST /fire/ fire_ignition_start_x4 NAMELIST /fire/ fire_ignition_start_y4 NAMELIST /fire/ fire_ignition_end_x4 NAMELIST /fire/ fire_ignition_end_y4 NAMELIST /fire/ fire_ignition_start_x5 NAMELIST /fire/ fire_ignition_start_y5 NAMELIST /fire/ fire_ignition_end_x5 NAMELIST /fire/ fire_ignition_end_y5 NAMELIST /fire/ fire_lat_init NAMELIST /fire/ fire_lon_init NAMELIST /fire/ fire_ign_time NAMELIST /fire/ fire_shape NAMELIST /fire/ fire_sprd_mdl NAMELIST /fire/ fire_crwn_hgt NAMELIST /fire/ fire_ext_grnd NAMELIST /fire/ fire_ext_crwn NAMELIST /fire/ fire_wind_height NAMELIST /fire/ fire_fuel_read NAMELIST /fire/ fire_fuel_cat NAMELIST /fire/ fire_print_msg NAMELIST /fire/ fire_print_file NAMELIST /fire/ fire_fuel_left_method NAMELIST /fire/ fire_fuel_left_irl NAMELIST /fire/ fire_fuel_left_jrl NAMELIST /fire/ fire_back_weight NAMELIST /fire/ fire_grows_only NAMELIST /fire/ fire_upwinding NAMELIST /fire/ fire_upwind_split NAMELIST /fire/ fire_viscosity NAMELIST /fire/ fire_lfn_ext_up NAMELIST /fire/ fire_topo_from_atm NAMELIST /fire/ fire_advection NAMELIST /fire/ fire_test_steps NAMELIST /fire/ fire_const_time NAMELIST /fire/ fire_const_grnhfx NAMELIST /fire/ fire_const_grnqfx NAMELIST /fire/ fire_atm_feedback NAMELIST /fire/ fire_mountain_type NAMELIST /fire/ fire_mountain_height NAMELIST /fire/ fire_mountain_start_x NAMELIST /fire/ fire_mountain_start_y NAMELIST /fire/ fire_mountain_end_x NAMELIST /fire/ fire_mountain_end_y NAMELIST /fire/ delt_perturbation NAMELIST /fire/ xrad_perturbation NAMELIST /fire/ yrad_perturbation NAMELIST /fire/ zrad_perturbation NAMELIST /fire/ hght_perturbation NAMELIST /fire/ stretch_grd NAMELIST /fire/ stretch_hyp NAMELIST /fire/ z_grd_scale NAMELIST /fire/ sfc_full_init NAMELIST /fire/ sfc_lu_index NAMELIST /fire/ sfc_tsk NAMELIST /fire/ sfc_tmn NAMELIST /fire/ fire_read_lu NAMELIST /fire/ fire_read_tsk NAMELIST /fire/ fire_read_tmn NAMELIST /fire/ fire_read_atm_ht NAMELIST /fire/ fire_read_fire_ht NAMELIST /fire/ fire_read_atm_grad NAMELIST /fire/ fire_read_fire_grad NAMELIST /fire/ sfc_vegfra NAMELIST /fire/ sfc_canwat NAMELIST /fire/ sfc_ivgtyp NAMELIST /fire/ sfc_isltyp NAMELIST /dynamics/ do_avgflx_em NAMELIST /dynamics/ do_avgflx_cugd NAMELIST /stoch/ nens NAMELIST /stoch/ lmax_ideal NAMELIST /stoch/ kmax_ideal NAMELIST /stoch/ stepstoch NAMELIST /stoch/ skebs NAMELIST /stoch/ stoch_force_opt NAMELIST /stoch/ skebs_vertstruc NAMELIST /stoch/ stoch_vertstruc_opt NAMELIST /stoch/ tot_backscat_psi NAMELIST /stoch/ tot_backscat_t NAMELIST /stoch/ ztau_psi NAMELIST /stoch/ ztau_t NAMELIST /stoch/ rexponent_psi NAMELIST /stoch/ rexponent_t NAMELIST /stoch/ zsigma2_eps NAMELIST /stoch/ zsigma2_eta NAMELIST /stoch/ kminforc NAMELIST /stoch/ lminforc NAMELIST /stoch/ kminforct NAMELIST /stoch/ lminforct NAMELIST /stoch/ kmaxforc NAMELIST /stoch/ lmaxforc NAMELIST /stoch/ kmaxforct NAMELIST /stoch/ lmaxforct NAMELIST /stoch/ iseed_skebs NAMELIST /stoch/ sppt NAMELIST /stoch/ gridpt_stddev_sppt NAMELIST /stoch/ stddev_cutoff_sppt NAMELIST /stoch/ lengthscale_sppt NAMELIST /stoch/ timescale_sppt NAMELIST /stoch/ sppt_vertstruc NAMELIST /stoch/ iseed_sppt NAMELIST /stoch/ rand_perturb NAMELIST /stoch/ gridpt_stddev_rand_pert NAMELIST /stoch/ stddev_cutoff_rand_pert NAMELIST /stoch/ lengthscale_rand_pert NAMELIST /stoch/ timescale_rand_pert NAMELIST /stoch/ rand_pert_vertstruc NAMELIST /stoch/ iseed_rand_pert NAMELIST /stoch/ spp NAMELIST /stoch/ hrrr_cycling NAMELIST /stoch/ spp_conv NAMELIST /stoch/ gridpt_stddev_spp_conv NAMELIST /stoch/ stddev_cutoff_spp_conv NAMELIST /stoch/ lengthscale_spp_conv NAMELIST /stoch/ timescale_spp_conv NAMELIST /stoch/ vertstruc_spp_conv NAMELIST /stoch/ iseed_spp_conv NAMELIST /stoch/ spp_pbl NAMELIST /stoch/ gridpt_stddev_spp_pbl NAMELIST /stoch/ stddev_cutoff_spp_pbl NAMELIST /stoch/ lengthscale_spp_pbl NAMELIST /stoch/ timescale_spp_pbl NAMELIST /stoch/ vertstruc_spp_pbl NAMELIST /stoch/ iseed_spp_pbl NAMELIST /stoch/ spp_mp NAMELIST /stoch/ gridpt_stddev_spp_mp NAMELIST /stoch/ stddev_cutoff_spp_mp NAMELIST /stoch/ lengthscale_spp_mp NAMELIST /stoch/ timescale_spp_mp NAMELIST /stoch/ vertstruc_spp_mp NAMELIST /stoch/ iseed_spp_mp NAMELIST /stoch/ spp_lsm NAMELIST /stoch/ gridpt_stddev_spp_lsm NAMELIST /stoch/ stddev_cutoff_spp_lsm NAMELIST /stoch/ lengthscale_spp_lsm NAMELIST /stoch/ timescale_spp_lsm NAMELIST /stoch/ vertstruc_spp_lsm NAMELIST /stoch/ iseed_spp_lsm NAMELIST /dynamics/ sfs_opt NAMELIST /dynamics/ m_opt NAMELIST /physics/ lakedepth_default NAMELIST /physics/ lake_min_elev NAMELIST /physics/ use_lakedepth NAMELIST /diags/ p_lev_diags NAMELIST /diags/ p_lev_diags_dfi NAMELIST /diags/ num_press_levels NAMELIST /diags/ press_levels NAMELIST /diags/ use_tot_or_hyd_p NAMELIST /diags/ extrap_below_grnd NAMELIST /diags/ p_lev_missing NAMELIST /diags/ z_lev_diags NAMELIST /diags/ z_lev_diags_dfi NAMELIST /diags/ num_z_levels NAMELIST /diags/ z_levels NAMELIST /diags/ z_lev_missing NAMELIST /afwa/ afwa_diag_opt NAMELIST /afwa/ afwa_ptype_opt NAMELIST /afwa/ afwa_vil_opt NAMELIST /afwa/ afwa_radar_opt NAMELIST /afwa/ afwa_severe_opt NAMELIST /afwa/ afwa_icing_opt NAMELIST /afwa/ afwa_vis_opt NAMELIST /afwa/ afwa_cloud_opt NAMELIST /afwa/ afwa_therm_opt NAMELIST /afwa/ afwa_turb_opt NAMELIST /afwa/ afwa_buoy_opt NAMELIST /afwa/ afwa_ptype_ccn_tmp NAMELIST /afwa/ afwa_ptype_tot_melt NAMELIST /afwa/ afwa_bad_data_check NAMELIST /time_control/ mean_diag NAMELIST /time_control/ mean_freq NAMELIST /time_control/ mean_interval NAMELIST /time_control/ diurnal_diag NAMELIST /physics/ nssl_ipelec NAMELIST /physics/ nssl_isaund NAMELIST /physics/ nssl_iscreen NAMELIST /physics/ nssl_lightrad NAMELIST /physics/ nssl_idischarge NAMELIST /physics/ nssl_ibrkd NAMELIST /physics/ nssl_ecrit NAMELIST /physics/ nssl_disfrac NAMELIST /physics/ elec_physics NAMELIST /stoch/ perturb_bdy NAMELIST /stoch/ perturb_chem_bdy NAMELIST /domains/ num_gca_levels NAMELIST /domains/ gca_input_opt NAMELIST /dynamics/ hybrid_opt NAMELIST /dynamics/ etac NAMELIST /domains/ num_wif_levels NAMELIST /domains/ wif_input_opt CALL MPI_INITIALIZED( mpi_inited, ierr ) IF ( .NOT. mpi_inited ) THEN IF ( coupler_on ) THEN CALL cpl_init( mpi_comm_here ) ELSE CALL mpi_init ( ierr ) mpi_comm_here = MPI_COMM_WORLD END IF CALL wrf_set_dm_communicator( mpi_comm_here ) CALL wrf_termio_dup( mpi_comm_here ) END IF CALL wrf_get_dm_communicator( mpi_comm_here ) CALL MPI_Comm_rank ( mpi_comm_here, mytask_local, ierr ) ; CALL MPI_Comm_size ( mpi_comm_here, ntasks_local, ierr ) ; mpi_comm_allcompute = mpi_comm_here IF ( mytask_local .EQ. 0 ) THEN max_dom = 1 OPEN ( unit=27, file="namelist.input", form="formatted", status="old" ) READ ( UNIT = 27 , NML = domains , IOSTAT=io_status ) REWIND(27) nio_groups = 1 nio_tasks_per_group = 0 poll_servers = .false. READ ( 27 , NML = namelist_quilt, IOSTAT=io_status ) CLOSE(27) END IF CALL mpi_bcast( nio_tasks_per_group , max_domains , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( nio_groups , 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( max_dom, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( parent_id, max_domains , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL quilting_disabled( quilting_is_turned_off ) IF ( quilting_is_turned_off ) THEN num_io_tasks = 0 nio_tasks_per_group = 0 nio_groups = 1 ELSE num_io_tasks = nio_tasks_per_group(1)*nio_groups END IF CALL nl_set_max_dom(1,max_dom) IF ( mytask_local .EQ. 0 ) THEN OPEN ( unit=27, file="namelist.input", form="formatted", status="old" ) nproc_x = -1 nproc_y = -1 READ ( 27 , NML = domains, IOSTAT=io_status ) CLOSE ( 27 ) OPEN ( unit=27, file="namelist.input", form="formatted", status="old" ) tasks_per_split = ntasks_local nest_pes_x = 0 nest_pes_y = 0 IF ( nproc_x .EQ. -1 .OR. nproc_y .EQ. -1 ) THEN CALL compute_mesh( ntasks_local-num_io_tasks, n_x, n_y ) ELSE n_x = nproc_x n_y = nproc_y END IF comm_start = 0 nest_pes_x(1:max_dom) = n_x nest_pes_y(1:max_dom) = n_y READ ( 27 , NML = dm_task_split, IOSTAT=io_status ) CLOSE ( 27 ) END IF CALL mpi_bcast( io_status, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) IF ( io_status .NE. 0 ) THEN END IF CALL mpi_bcast( tasks_per_split, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( nproc_x, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( nproc_y, 1 , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( comm_start, max_domains , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( nest_pes_x, max_domains , MPI_INTEGER , 0 , mpi_comm_here, ierr ) CALL mpi_bcast( nest_pes_y, max_domains , MPI_INTEGER , 0 , mpi_comm_here, ierr ) nkids = 1 which_kid = 0 DO i = 2, max_dom IF ( 1 .le. parent_id(i) .AND. parent_id(i) .LE. max_domains ) THEN which_kid(i) = nkids(parent_id(i)) nkids(parent_id(i)) = nkids(parent_id(i)) + 1 ELSE WRITE(wrf_err_message,*)'invalid parent id for domain ',i CALL wrf_error_fatal3("",5634,& TRIM(wrf_err_message)) END IF END DO num_compute_tasks = -99 DO nest_id = 1,max_dom IF ( nest_id .EQ. 1 ) THEN nest_task_offsets(nest_id) = comm_start(nest_id) ELSE IF ( comm_start(nest_id) .LT. comm_start(parent_id(nest_id)) ) THEN WRITE(wrf_err_message,& "('nest domain ',i3,'comm_start (',i3,') lt parent ',i3,' comm_start (',i3,')')") & nest_id,comm_start,parent_id(nest_id),comm_start(parent_id(nest_id)) CALL wrf_error_fatal3("",5647,& TRIM(wrf_err_message)) ELSE IF ( comm_start(nest_id) .LT. & comm_start(parent_id(nest_id)) & +nest_pes_x(parent_id(nest_id))*nest_pes_y(parent_id(nest_id))) THEN nest_task_offsets(nest_id) = comm_start(nest_id)-comm_start(parent_id(nest_id)) ELSE nest_task_offsets(nest_id) = nest_pes_x(parent_id(nest_id))*nest_pes_y(parent_id(nest_id)) END IF END IF IF ((comm_start(nest_id)+nest_pes_x(nest_id)*nest_pes_y(nest_id)) .GT. num_compute_tasks ) THEN num_compute_tasks = (comm_start(nest_id)+nest_pes_x(nest_id)*nest_pes_y(nest_id)) END IF END DO IF ( .TRUE. ) THEN CALL MPI_Comm_rank ( mpi_comm_here, mytask_local, ierr ) ; CALL MPI_Comm_rank ( mpi_comm_here, origmytask, ierr ) ; CALL mpi_comm_size ( mpi_comm_here, ntasks_local, ierr ) ; ALLOCATE( icolor(ntasks_local) ) ALLOCATE( icolor2(ntasks_local) ) ALLOCATE( idomain(ntasks_local) ) k = 0 comms_i_am_in = MPI_UNDEFINED DO i = 1, max_dom inthisone = .FALSE. icolor = 0 DO j = comm_start(i), comm_start(i)+nest_pes_x(i)*nest_pes_y(i)-1 IF ( j+1 .GT. ntasks_local ) THEN WRITE(wrf_err_message,*)"check comm_start, nest_pes_x, nest_pes_y settings in namelist for comm ",i CALL wrf_error_fatal3("",5686,& wrf_err_message) END IF icolor(j+1) = 1 END DO IF ( icolor(mytask_local+1) .EQ. 1 ) inthisone = .TRUE. CALL MPI_Comm_dup(mpi_comm_here,comdup,ierr) CALL MPI_Comm_split(comdup,icolor(mytask_local+1),mytask_local,mpi_comm_local,ierr) IF ( inthisone ) THEN dims(1) = nest_pes_y(i) dims(2) = nest_pes_x(i) isperiodic(1) = .false. isperiodic(2) = .false. CALL mpi_cart_create( mpi_comm_local, 2, dims, isperiodic, .false., comms_i_am_in(i), ierr ) END IF END DO local_communicator = MPI_UNDEFINED CALL wrf_set_dm_quilt_comm( mpi_comm_here ) DO i = 1, max_dom local_communicator_store(i) = comms_i_am_in(i) domain_active_this_task(i) = ( local_communicator_store(i) .NE. MPI_UNDEFINED ) IF ( local_communicator_store(i) .NE. MPI_UNDEFINED ) THEN CALL MPI_Comm_size( local_communicator_store(i), ntasks_store(i), ierr ) CALL MPI_Comm_rank( local_communicator_store(i), mytask_store(i), ierr ) CALL mpi_cart_coords( local_communicator_store(i), mytask_store(i), 2, coords, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",5712,& 'MPI_cart_coords fails ') mytask_y_store(i) = coords(1) mytask_x_store(i) = coords(2) CALL MPI_Comm_dup( local_communicator_store(i), comdup2, ierr ) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",5717,& 'MPI_Comm_dup fails ') CALL MPI_Comm_split(comdup2,mytask_y_store(i),mytask_store(i),local_communicator_x_store(i),ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",5720,& 'MPI_Comm_split fails for y ') CALL MPI_Comm_split(comdup2,mytask_x_store(i),mytask_store(i),local_communicator_y_store(i),ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",5723,& 'MPI_Comm_split fails for x ') CALL MPI_Comm_size( local_communicator_x_store(i), ntasks_x_store(i), ierr ) CALL MPI_Comm_rank( local_communicator_x_store(i), mytask_x_store(i), ierr ) CALL MPI_Comm_size( local_communicator_y_store(i), ntasks_y_store(i), ierr ) CALL MPI_Comm_rank( local_communicator_y_store(i), mytask_y_store(i), ierr ) END IF END DO intercomm_active = .FALSE. ntasks_local = num_compute_tasks DO nest_id = 2, max_dom par_id = parent_id(nest_id) icolor2 = 0 DO j = 1,ntasks_local IF ( local_communicator_store( par_id ) .NE. MPI_UNDEFINED .OR. local_communicator_store( nest_id ) .NE. MPI_UNDEFINED ) icolor2(j)=1 END DO icolor2 = 0 mytask_is_nest = .FALSE. mytask_is_par = .FALSE. DO j = 1,ntasks_local IF ( comm_start(nest_id) .LE. j-1 .AND. j-1 .LT. comm_start(nest_id) + nest_pes_x(nest_id)*nest_pes_y(nest_id) ) THEN icolor2(j)=1 if ( j-1 .EQ. mytask_local ) mytask_is_nest=.TRUE. END IF IF ( comm_start(par_id ) .LE. j-1 .AND. j-1 .LT. comm_start(par_id ) + nest_pes_x(par_id )*nest_pes_y(par_id ) ) THEN icolor2(j)=1 if ( j-1 .EQ. mytask_local ) mytask_is_par=.TRUE. END IF END DO i = icolor2(mytask_local+1) CALL MPI_Comm_dup(mpi_comm_here,comdup,ierr) CALL MPI_Comm_split(comdup,i,origmytask,mpi_comm_me_and_mom,ierr) IF ( mytask_is_nest ) THEN intercomm_active(nest_id) = .TRUE. mpi_comm_to_mom(nest_id) = mpi_comm_me_and_mom END IF IF ( mytask_is_par ) THEN intercomm_active(par_id) = .TRUE. mpi_comm_to_kid(which_kid(nest_id),par_id) = mpi_comm_me_and_mom END IF END DO DEALLOCATE( icolor ) DEALLOCATE( icolor2 ) DEALLOCATE( idomain ) ELSE IF ( ( tasks_per_split .LE. ntasks_local .AND. tasks_per_split .LE. 0 ) ) THEN domain_active_this_task(1) = .TRUE. IF ( mod( ntasks_local, tasks_per_split ) .NE. 0 ) THEN CALL wrf_message( 'WARNING: tasks_per_split does not evenly divide ntasks. Some tasks will be wasted.' ) END IF ALLOCATE( icolor(ntasks_local) ) j = 0 DO WHILE ( j .LT. ntasks_local / tasks_per_split ) DO i = 1, tasks_per_split icolor( i + j * tasks_per_split ) = j END DO j = j + 1 END DO CALL MPI_Comm_dup(mpi_comm_here,comdup,ierr) CALL MPI_Comm_split(comdup,icolor(mytask_local+1),mytask_local,mpi_comm_local,ierr) CALL wrf_set_dm_communicator( mpi_comm_local ) CALL store_communicators_for_domain(1) DEALLOCATE( icolor ) ELSE domain_active_this_task(1) = .TRUE. mpi_comm_local = mpi_comm_here CALL wrf_set_dm_communicator( mpi_comm_local ) CALL store_communicators_for_domain(1) END IF CALL instate_communicators_for_domain(1) END SUBROUTINE split_communicator SUBROUTINE init_module_dm IMPLICIT NONE INTEGER mpi_comm_local, mpi_comm_here, ierr, mytask, nproc LOGICAL mpi_inited CALL mpi_initialized( mpi_inited, ierr ) IF ( .NOT. mpi_inited ) THEN CALL mpi_init ( ierr ) mpi_comm_here = MPI_COMM_WORLD CALL wrf_set_dm_communicator ( mpi_comm_here ) END IF CALL wrf_get_dm_communicator( mpi_comm_local ) END SUBROUTINE init_module_dm SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy ) USE module_domain, ONLY : domain IMPLICIT NONE TYPE (domain), INTENT(INOUT) :: parent, nest INTEGER, INTENT(IN) :: dx,dy RETURN END SUBROUTINE wrf_dm_move_nest SUBROUTINE get_full_obs_vector( nsta, nerrf, niobf, & mp_local_uobmask, & mp_local_vobmask, & mp_local_cobmask, errf ) INTEGER, INTENT(IN) :: nsta INTEGER, INTENT(IN) :: nerrf INTEGER, INTENT(IN) :: niobf LOGICAL, INTENT(IN) :: MP_LOCAL_UOBMASK(NIOBF) LOGICAL, INTENT(IN) :: MP_LOCAL_VOBMASK(NIOBF) LOGICAL, INTENT(IN) :: MP_LOCAL_COBMASK(NIOBF) REAL, INTENT(INOUT) :: errf(nerrf, niobf) integer i, n, nlocal_dot, nlocal_crs REAL UVT_BUFFER(NIOBF) REAL QRK_BUFFER(NIOBF) REAL SFP_BUFFER(NIOBF) REAL PBL_BUFFER(NIOBF) REAL QATOB_BUFFER(NIOBF) INTEGER N_BUFFER(NIOBF) REAL FULL_BUFFER(NIOBF) INTEGER IFULL_BUFFER(NIOBF) INTEGER IDISPLACEMENT(1024) INTEGER ICOUNT(1024) INTEGER :: MPI_COMM_COMP INTEGER :: NPROCS INTEGER :: IERR CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP) CALL MPI_COMM_SIZE( MPI_COMM_COMP, NPROCS, IERR ) NLOCAL_DOT = 0 DO N = 1, NSTA IF ( MP_LOCAL_UOBMASK(N) ) THEN NLOCAL_DOT = NLOCAL_DOT + 1 UVT_BUFFER(NLOCAL_DOT) = ERRF(1,N) SFP_BUFFER(NLOCAL_DOT) = ERRF(7,N) QRK_BUFFER(NLOCAL_DOT) = ERRF(9,N) N_BUFFER(NLOCAL_DOT) = N END IF END DO CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, & ICOUNT,1,MPI_INTEGER, & MPI_COMM_COMP,IERR) I = 1 IDISPLACEMENT(1) = 0 DO I = 2, NPROCS IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1) END DO CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER, & IFULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_INTEGER, MPI_COMM_COMP, IERR) CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(1,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(7,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_DOT, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(9,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO NLOCAL_DOT = 0 DO N = 1, NSTA IF ( MP_LOCAL_VOBMASK(N) ) THEN NLOCAL_DOT = NLOCAL_DOT + 1 UVT_BUFFER(NLOCAL_DOT) = ERRF(2,N) SFP_BUFFER(NLOCAL_DOT) = ERRF(8,N) N_BUFFER(NLOCAL_DOT) = N END IF END DO CALL MPI_ALLGATHER(NLOCAL_DOT,1,MPI_INTEGER, & ICOUNT,1,MPI_INTEGER, & MPI_COMM_COMP,IERR) I = 1 IDISPLACEMENT(1) = 0 DO I = 2, NPROCS IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1) END DO CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_DOT, MPI_INTEGER, & IFULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_INTEGER, MPI_COMM_COMP, IERR) CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_DOT, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(2,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_DOT, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(8,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO NLOCAL_CRS = 0 DO N = 1, NSTA IF ( MP_LOCAL_COBMASK(N) ) THEN NLOCAL_CRS = NLOCAL_CRS + 1 UVT_BUFFER(NLOCAL_CRS) = ERRF(3,N) QRK_BUFFER(NLOCAL_CRS) = ERRF(4,N) PBL_BUFFER(NLOCAL_CRS) = ERRF(5,N) SFP_BUFFER(NLOCAL_CRS) = ERRF(6,N) QATOB_BUFFER(NLOCAL_CRS) = ERRF(10,N) N_BUFFER(NLOCAL_CRS) = N END IF END DO CALL MPI_ALLGATHER(NLOCAL_CRS,1,MPI_INTEGER, & ICOUNT,1,MPI_INTEGER, & MPI_COMM_COMP,IERR) IDISPLACEMENT(1) = 0 DO I = 2, NPROCS IDISPLACEMENT(I) = IDISPLACEMENT(I-1) + ICOUNT(I-1) END DO CALL MPI_ALLGATHERV( N_BUFFER, NLOCAL_CRS, MPI_INTEGER, & IFULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_INTEGER, MPI_COMM_COMP, IERR) CALL MPI_ALLGATHERV( UVT_BUFFER, NLOCAL_CRS, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(3,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( QRK_BUFFER, NLOCAL_CRS, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(4,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( PBL_BUFFER, NLOCAL_CRS, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(5,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( SFP_BUFFER, NLOCAL_CRS, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(6,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO CALL MPI_ALLGATHERV( QATOB_BUFFER, NLOCAL_CRS, MPI_REAL, & FULL_BUFFER, ICOUNT, IDISPLACEMENT, & MPI_REAL, MPI_COMM_COMP, IERR) DO N = 1, NSTA ERRF(10,IFULL_BUFFER(N)) = FULL_BUFFER(N) END DO END SUBROUTINE get_full_obs_vector SUBROUTINE wrf_dm_maxtile_real ( val , tile) IMPLICIT NONE REAL val, val_all( ntasks ) INTEGER tile INTEGER ierr INTEGER i, comm CALL wrf_get_dm_communicator ( comm ) CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr ) val = val_all(1) tile = 1 DO i = 2, ntasks IF ( val_all(i) .GT. val ) THEN tile = i val = val_all(i) END IF END DO END SUBROUTINE wrf_dm_maxtile_real SUBROUTINE wrf_dm_mintile_real ( val , tile) IMPLICIT NONE REAL val, val_all( ntasks ) INTEGER tile INTEGER ierr INTEGER i, comm CALL wrf_get_dm_communicator ( comm ) CALL mpi_allgather ( val, 1, getrealmpitype(), val_all , 1, getrealmpitype(), comm, ierr ) val = val_all(1) tile = 1 DO i = 2, ntasks IF ( val_all(i) .LT. val ) THEN tile = i val = val_all(i) END IF END DO END SUBROUTINE wrf_dm_mintile_real SUBROUTINE wrf_dm_mintile_double ( val , tile) IMPLICIT NONE DOUBLE PRECISION val, val_all( ntasks ) INTEGER tile INTEGER ierr INTEGER i, comm CALL wrf_get_dm_communicator ( comm ) CALL mpi_allgather ( val, 1, MPI_DOUBLE_PRECISION, val_all , 1, MPI_DOUBLE_PRECISION, comm, ierr ) val = val_all(1) tile = 1 DO i = 2, ntasks IF ( val_all(i) .LT. val ) THEN tile = i val = val_all(i) END IF END DO END SUBROUTINE wrf_dm_mintile_double SUBROUTINE wrf_dm_tile_val_int ( val , tile) IMPLICIT NONE INTEGER val, val_all( ntasks ) INTEGER tile INTEGER ierr INTEGER i, comm CALL wrf_get_dm_communicator ( comm ) CALL mpi_allgather ( val, 1, MPI_INTEGER, val_all , 1, MPI_INTEGER, comm, ierr ) val = val_all(tile) END SUBROUTINE wrf_dm_tile_val_int SUBROUTINE wrf_get_hostname ( str ) CHARACTER*(*) str CHARACTER tmp(512) INTEGER i , n, cs CALL rsl_lite_get_hostname( tmp, 512, n, cs ) DO i = 1, n str(i:i) = tmp(i) END DO RETURN END SUBROUTINE wrf_get_hostname SUBROUTINE wrf_get_hostid ( hostid ) INTEGER hostid CHARACTER tmp(512) INTEGER i, sz, n, cs CALL rsl_lite_get_hostname( tmp, 512, n, cs ) hostid = cs RETURN END SUBROUTINE wrf_get_hostid END MODULE module_dm SUBROUTINE push_communicators_for_domain( id ) USE module_dm INTEGER, INTENT(IN) :: id IF ( communicator_stack_cursor .GE. max_domains ) CALL wrf_error_fatal3("",6101,& "push_communicators_for_domain would excede stacksize") communicator_stack_cursor = communicator_stack_cursor + 1 id_stack(communicator_stack_cursor) = current_id local_communicator_stack( communicator_stack_cursor ) = local_communicator local_communicator_periodic_stack( communicator_stack_cursor ) = local_communicator_periodic local_iocommunicator_stack( communicator_stack_cursor ) = local_iocommunicator local_communicator_x_stack( communicator_stack_cursor ) = local_communicator_x local_communicator_y_stack( communicator_stack_cursor ) = local_communicator_y ntasks_stack( communicator_stack_cursor ) = ntasks ntasks_y_stack( communicator_stack_cursor ) = ntasks_y ntasks_x_stack( communicator_stack_cursor ) = ntasks_x mytask_stack( communicator_stack_cursor ) = mytask mytask_x_stack( communicator_stack_cursor ) = mytask_x mytask_y_stack( communicator_stack_cursor ) = mytask_y CALL instate_communicators_for_domain( id ) END SUBROUTINE push_communicators_for_domain SUBROUTINE pop_communicators_for_domain USE module_dm IMPLICIT NONE IF ( communicator_stack_cursor .LT. 1 ) CALL wrf_error_fatal3("",6121,& "pop_communicators_for_domain on empty stack") current_id = id_stack(communicator_stack_cursor) local_communicator = local_communicator_stack( communicator_stack_cursor ) local_communicator_periodic = local_communicator_periodic_stack( communicator_stack_cursor ) local_iocommunicator = local_iocommunicator_stack( communicator_stack_cursor ) local_communicator_x = local_communicator_x_stack( communicator_stack_cursor ) local_communicator_y = local_communicator_y_stack( communicator_stack_cursor ) ntasks = ntasks_stack( communicator_stack_cursor ) ntasks_y = ntasks_y_stack( communicator_stack_cursor ) ntasks_x = ntasks_x_stack( communicator_stack_cursor ) mytask = mytask_stack( communicator_stack_cursor ) mytask_x = mytask_x_stack( communicator_stack_cursor ) mytask_y = mytask_y_stack( communicator_stack_cursor ) communicator_stack_cursor = communicator_stack_cursor - 1 END SUBROUTINE pop_communicators_for_domain SUBROUTINE instate_communicators_for_domain( id ) USE module_dm IMPLICIT NONE INTEGER, INTENT(IN) :: id INTEGER ierr current_id = id local_communicator = local_communicator_store( id ) local_communicator_periodic = local_communicator_periodic_store( id ) local_iocommunicator = local_iocommunicator_store( id ) local_communicator_x = local_communicator_x_store( id ) local_communicator_y = local_communicator_y_store( id ) ntasks = ntasks_store( id ) mytask = mytask_store( id ) ntasks_x = ntasks_x_store( id ) ntasks_y = ntasks_y_store( id ) mytask_x = mytask_x_store( id ) mytask_y = mytask_y_store( id ) END SUBROUTINE instate_communicators_for_domain SUBROUTINE store_communicators_for_domain( id ) USE module_dm IMPLICIT NONE INTEGER, INTENT(IN) :: id local_communicator_store( id ) = local_communicator local_communicator_periodic_store( id ) = local_communicator_periodic local_iocommunicator_store( id ) = local_iocommunicator local_communicator_x_store( id ) = local_communicator_x local_communicator_y_store( id ) = local_communicator_y ntasks_store( id ) = ntasks ntasks_x_store( id ) = ntasks_x ntasks_y_store( id ) = ntasks_y mytask_store( id ) = mytask mytask_x_store( id ) = mytask_x mytask_y_store( id ) = mytask_y END SUBROUTINE store_communicators_for_domain SUBROUTINE wrf_dm_patch_domain ( id , domdesc , parent_id , parent_domdesc , & sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & sd2 , ed2 , sp2 , ep2 , sm2 , em2 , & sd3 , ed3 , sp3 , ep3 , sm3 , em3 , & sp1x , ep1x , sm1x , em1x , & sp2x , ep2x , sm2x , em2x , & sp3x , ep3x , sm3x , em3x , & sp1y , ep1y , sm1y , em1y , & sp2y , ep2y , sm2y , em2y , & sp3y , ep3y , sm3y , em3y , & bdx , bdy ) USE module_domain, ONLY : domain, head_grid, find_grid_by_id USE module_dm, ONLY : patch_domain_rsl_lite IMPLICIT NONE INTEGER, INTENT(IN) :: sd1 , ed1 , sd2 , ed2 , sd3 , ed3 , bdx , bdy INTEGER, INTENT(OUT) :: sp1 , ep1 , sp2 , ep2 , sp3 , ep3 , & sm1 , em1 , sm2 , em2 , sm3 , em3 INTEGER :: sp1x , ep1x , sp2x , ep2x , sp3x , ep3x , & sm1x , em1x , sm2x , em2x , sm3x , em3x INTEGER :: sp1y , ep1y , sp2y , ep2y , sp3y , ep3y , & sm1y , em1y , sm2y , em2y , sm3y , em3y INTEGER, INTENT(INOUT):: id , domdesc , parent_id , parent_domdesc TYPE(domain), POINTER :: parent TYPE(domain), POINTER :: grid_ptr NULLIFY( parent ) grid_ptr => head_grid CALL find_grid_by_id( parent_id , grid_ptr , parent ) CALL push_communicators_for_domain(id) CALL patch_domain_rsl_lite ( id , parent, parent_id , & sd1 , ed1 , sp1 , ep1 , sm1 , em1 , & sd2 , ed2 , sp2 , ep2 , sm2 , em2 , & sd3 , ed3 , sp3 , ep3 , sm3 , em3 , & sp1x , ep1x , sm1x , em1x , & sp2x , ep2x , sm2x , em2x , & sp3x , ep3x , sm3x , em3x , & sp1y , ep1y , sm1y , em1y , & sp2y , ep2y , sm2y , em2y , & sp3y , ep3y , sm3y , em3y , & bdx , bdy ) CALL pop_communicators_for_domain RETURN END SUBROUTINE wrf_dm_patch_domain SUBROUTINE wrf_termio_dup( comm ) IMPLICIT NONE INTEGER, INTENT(IN) :: comm INTEGER mytask, ntasks INTEGER ierr INCLUDE 'mpif.h' CALL mpi_comm_size(comm, ntasks, ierr ) CALL mpi_comm_rank(comm, mytask, ierr ) write(0,*)'starting wrf task ',mytask,' of ',ntasks CALL rsl_error_dup1( mytask ) END SUBROUTINE wrf_termio_dup SUBROUTINE wrf_get_myproc( myproc ) USE module_dm , ONLY : mytask IMPLICIT NONE INTEGER myproc myproc = mytask RETURN END SUBROUTINE wrf_get_myproc SUBROUTINE wrf_get_nproc( nproc ) USE module_dm , ONLY : ntasks IMPLICIT NONE INTEGER nproc nproc = ntasks RETURN END SUBROUTINE wrf_get_nproc SUBROUTINE wrf_get_nprocx( nprocx ) USE module_dm , ONLY : ntasks_x IMPLICIT NONE INTEGER nprocx nprocx = ntasks_x RETURN END SUBROUTINE wrf_get_nprocx SUBROUTINE wrf_get_nprocy( nprocy ) USE module_dm , ONLY : ntasks_y IMPLICIT NONE INTEGER nprocy nprocy = ntasks_y RETURN END SUBROUTINE wrf_get_nprocy SUBROUTINE wrf_dm_bcast_bytes ( buf , size ) USE module_dm , ONLY : local_communicator IMPLICIT NONE INCLUDE 'mpif.h' INTEGER size INTEGER*1 BUF(size) CALL BYTE_BCAST ( buf , size, local_communicator ) RETURN END SUBROUTINE wrf_dm_bcast_bytes SUBROUTINE wrf_dm_bcast_string( BUF, N1 ) IMPLICIT NONE INTEGER n1 CHARACTER*(*) buf INTEGER ibuf(256),i,n CHARACTER*256 tstr n = n1 CALL wrf_dm_bcast_integer( n , 1 ) IF (n .GT. 256) n = 256 IF (n .GT. 0 ) then DO i = 1, n ibuf(I) = ichar(buf(I:I)) END DO CALL wrf_dm_bcast_integer( ibuf, n ) buf = '' DO i = 1, n buf(i:i) = char(ibuf(i)) END DO END IF RETURN END SUBROUTINE wrf_dm_bcast_string SUBROUTINE wrf_dm_bcast_string_comm( BUF, N1, COMM ) IMPLICIT NONE INTEGER n1 INTEGER COMM CHARACTER*(*) buf INTEGER ibuf(256),i,n CHARACTER*256 tstr n = n1 CALL BYTE_BCAST( n, 4, COMM ) IF (n .GT. 256) n = 256 IF (n .GT. 0 ) then DO i = 1, n ibuf(I) = ichar(buf(I:I)) END DO CALL BYTE_BCAST( ibuf, N*4, COMM ) buf = '' DO i = 1, n buf(i:i) = char(ibuf(i)) END DO END IF RETURN END SUBROUTINE wrf_dm_bcast_string_comm SUBROUTINE wrf_dm_bcast_integer( BUF, N1 ) IMPLICIT NONE INTEGER n1 INTEGER buf(*) CALL wrf_dm_bcast_bytes ( BUF , N1 * 4 ) RETURN END SUBROUTINE wrf_dm_bcast_integer SUBROUTINE wrf_dm_bcast_double( BUF, N1 ) IMPLICIT NONE INTEGER n1 REAL buf(*) CALL wrf_dm_bcast_bytes ( BUF , N1 * 8 ) RETURN END SUBROUTINE wrf_dm_bcast_double SUBROUTINE wrf_dm_bcast_real( BUF, N1 ) IMPLICIT NONE INTEGER n1 REAL buf(*) CALL wrf_dm_bcast_bytes ( BUF , N1 * 4 ) RETURN END SUBROUTINE wrf_dm_bcast_real SUBROUTINE wrf_dm_bcast_logical( BUF, N1 ) IMPLICIT NONE INTEGER n1 LOGICAL buf(*) CALL wrf_dm_bcast_bytes ( BUF , N1 * 4 ) RETURN END SUBROUTINE wrf_dm_bcast_logical SUBROUTINE write_68( grid, v , s , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) USE module_domain, ONLY : domain IMPLICIT NONE TYPE(domain) , INTENT (INOUT) :: grid CHARACTER *(*) s INTEGER ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: v INTEGER i,j,k,ierr logical, external :: wrf_dm_on_monitor real globbuf( ids:ide, kds:kde, jds:jde ) character*3 ord, stag if ( kds == kde ) then ord = 'xy' stag = 'xy' CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) else stag = 'xyz' ord = 'xzy' CALL wrf_patch_to_global_real ( v, globbuf, grid%domdesc, stag, ord, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & its, ite, kts, kte, jts, jte ) endif if ( wrf_dm_on_monitor() ) THEN WRITE(68,*) ide-ids+1, jde-jds+1 , s DO j = jds, jde DO i = ids, ide WRITE(68,*) globbuf(i,1,j) END DO END DO endif RETURN END SUBROUTINE wrf_abort USE module_cpl, ONLY : coupler_on, cpl_abort IMPLICIT NONE INCLUDE 'mpif.h' INTEGER ierr IF ( coupler_on ) THEN CALL cpl_abort( 'wrf_abort', 'look for abort message in rsl* files' ) ELSE CALL mpi_abort(MPI_COMM_WORLD,1,ierr) END IF END SUBROUTINE wrf_abort SUBROUTINE wrf_dm_shutdown IMPLICIT NONE INTEGER ierr CALL MPI_FINALIZE( ierr ) RETURN END SUBROUTINE wrf_dm_shutdown LOGICAL FUNCTION wrf_dm_on_monitor() IMPLICIT NONE INCLUDE 'mpif.h' INTEGER tsk, ierr, mpi_comm_local CALL wrf_get_dm_communicator( mpi_comm_local ) IF ( mpi_comm_local .NE. MPI_UNDEFINED ) THEN CALL mpi_comm_rank ( mpi_comm_local, tsk , ierr ) wrf_dm_on_monitor = tsk .EQ. 0 ELSE wrf_dm_on_monitor = .FALSE. END IF RETURN END FUNCTION wrf_dm_on_monitor SUBROUTINE rsl_comm_iter_init(shw,ps,pe) INTEGER shw, ps, pe INTEGER iter, plus_send_start, plus_recv_start, & minus_send_start, minus_recv_start COMMON /rcii/ iter, plus_send_start, plus_recv_start, & minus_send_start, minus_recv_start iter = 0 minus_send_start = ps minus_recv_start = ps-1 plus_send_start = pe plus_recv_start = pe+1 END SUBROUTINE rsl_comm_iter_init LOGICAL FUNCTION rsl_comm_iter ( id , is_intermediate, & shw , xy , ds, de_in, ps, pe, nds,nde, & sendbeg_m, sendw_m, sendbeg_p, sendw_p, & recvbeg_m, recvw_m, recvbeg_p, recvw_p ) USE module_dm, ONLY : ntasks_x, ntasks_y, mytask_x, mytask_y, minx, miny, & nest_pes_x, nest_pes_y IMPLICIT NONE INTEGER, INTENT(IN) :: id,shw,xy,ds,de_in,ps,pe,nds,nde LOGICAL, INTENT(IN) :: is_intermediate INTEGER, INTENT(OUT) :: sendbeg_m, sendw_m, sendbeg_p, sendw_p INTEGER, INTENT(OUT) :: recvbeg_m, recvw_m, recvbeg_p, recvw_p INTEGER k, kn, ni, nj, de, Px, Py, nt, ntx, nty, me, lb, ub, ierr INTEGER dum LOGICAL went INTEGER iter, plus_send_start, plus_recv_start, & minus_send_start, minus_recv_start INTEGER parent_grid_ratio, parent_start COMMON /rcii/ iter, plus_send_start, plus_recv_start, & minus_send_start, minus_recv_start de = de_in ntx = nest_pes_x(id) nty = nest_pes_y(id) IF ( xy .EQ. 1 ) THEN nt = ntasks_x me = mytask_x dum = 2 * nty IF ( is_intermediate ) THEN CALL nl_get_i_parent_start(id,parent_start) CALL nl_get_parent_grid_ratio(id,parent_grid_ratio) END IF ELSE nt = ntasks_y me = mytask_y dum = 2 * ntx IF ( is_intermediate ) THEN CALL nl_get_j_parent_start(id,parent_start) CALL nl_get_parent_grid_ratio(id,parent_grid_ratio) END IF END IF iter = iter + 1 went = .FALSE. sendw_m = 0 sendbeg_m = 1 IF ( me .GT. 0 ) THEN lb = minus_send_start sendbeg_m = lb-ps+1 DO k = lb,ps+shw-1 went = .TRUE. IF ( xy .eq. 1 ) THEN IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (kn,1,nds,nde,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6491,& 'error code returned by task_for_point in module_dm.F (h)') ELSE CALL task_for_point (k,1,ds,de,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6495,& 'error code returned by task_for_point in module_dm.F (i)') END IF IF ( Px .NE. me+(iter-1) ) THEN exit END IF ELSE IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (1,kn,1,dum,nds,nde,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6505,& 'error code returned by task_for_point in module_dm.F (h)') ELSE CALL task_for_point (1,k,1,dum,ds,de,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6509,& 'error code returned by task_for_point in module_dm.F (i)') END IF IF ( Py .NE. me+(iter-1) ) THEN exit END IF END IF minus_send_start = minus_send_start+1 sendw_m = sendw_m + 1 END DO END IF recvw_m = 0 recvbeg_m = 1 IF ( me .GT. 0 ) THEN ub = minus_recv_start recvbeg_m = ps - ub DO k = minus_recv_start,ps-shw,-1 went = .TRUE. IF ( xy .eq. 1 ) THEN IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (kn,1,nds,nde,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6532,& 'error code returned by task_for_point in module_dm.F (j)') ELSE CALL task_for_point (k,1,ds,de,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6536,& 'error code returned by task_for_point in module_dm.F (k)') END IF IF ( Px .NE. me-iter ) THEN exit END IF ELSE IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (1,kn,1,dum,nds,nde,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6546,& 'error code returned by task_for_point in module_dm.F (j)') ELSE CALL task_for_point (1,k,1,dum,ds,de,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6550,& 'error code returned by task_for_point in module_dm.F (k)') END IF IF ( Py .NE. me-iter ) THEN exit END IF END IF minus_recv_start = minus_recv_start-1 recvw_m = recvw_m + 1 END DO END IF sendw_p = 0 sendbeg_p = 1 IF ( ( xy .eq. 1 .and. me .LT. ntx-1 ) .OR. ( xy .eq. 0 .and. me .LT. nty-1 ) ) THEN ub = plus_send_start sendbeg_p = pe - ub + 1 DO k = ub,pe-shw+1,-1 went = .TRUE. IF ( xy .eq. 1 ) THEN IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (kn,1,nds,nde,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6573,& 'error code returned by task_for_point in module_dm.F (l)') ELSE CALL task_for_point (k,1,ds,de,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6577,& 'error code returned by task_for_point in module_dm.F (m)') END IF IF ( Px .NE. me-(iter-1) ) THEN exit END IF ELSE IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (1,kn,1,dum,nds,nde,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6587,& 'error code returned by task_for_point in module_dm.F (l)') ELSE CALL task_for_point (1,k,1,dum,ds,de,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6591,& 'error code returned by task_for_point in module_dm.F (m)') END IF IF ( Py .NE. me-(iter-1) ) THEN exit END IF END IF plus_send_start = plus_send_start - 1 sendw_p = sendw_p + 1 END DO END IF recvw_p = 0 recvbeg_p = 1 IF ( ( xy .eq. 1 .and. me .LT. ntx-1 ) .OR. ( xy .eq. 0 .and. me .LT. nty-1 ) ) THEN lb = plus_recv_start recvbeg_p = lb - pe DO k = lb,pe+shw went = .TRUE. IF ( xy .eq. 1 ) THEN IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (kn,1,nds,nde,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6614,& 'error code returned by task_for_point in module_dm.F (n)') ELSE CALL task_for_point (k,1,ds,de,1,dum,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6618,& 'error code returned by task_for_point in module_dm.F (o)') END IF IF ( Px .NE. me+iter ) THEN exit END IF ELSE IF ( is_intermediate ) THEN kn = ( k - parent_start ) * parent_grid_ratio + 1 + 1 ; CALL task_for_point (1,kn,1,dum,nds,nde,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6628,& 'error code returned by task_for_point in module_dm.F (n)') ELSE CALL task_for_point (1,k,1,dum,ds,de,ntx,nty,Px,Py,minx,miny,ierr) IF ( ierr .NE. 0 ) CALL wrf_error_fatal3("",6632,& 'error code returned by task_for_point in module_dm.F (o)') END IF IF ( Py .NE. me+iter ) THEN exit END IF END IF plus_recv_start = plus_recv_start + 1 recvw_p = recvw_p + 1 END DO END IF rsl_comm_iter = went END FUNCTION rsl_comm_iter INTEGER FUNCTION wrf_dm_monitor_rank() IMPLICIT NONE wrf_dm_monitor_rank = 0 RETURN END FUNCTION wrf_dm_monitor_rank SUBROUTINE wrf_get_dm_communicator_for_id ( id, communicator ) USE module_dm , ONLY : local_communicator_store, mpi_comm_allcompute IMPLICIT NONE INTEGER , INTENT(IN) :: id INTEGER , INTENT(OUT) :: communicator IF ( id .le. 0 ) THEN communicator = mpi_comm_allcompute ELSE communicator = local_communicator_store(id) END IF RETURN END SUBROUTINE wrf_get_dm_communicator_for_id SUBROUTINE wrf_get_dm_communicator ( communicator ) USE module_dm , ONLY : local_communicator IMPLICIT NONE INTEGER , INTENT(OUT) :: communicator communicator = local_communicator RETURN END SUBROUTINE wrf_get_dm_communicator SUBROUTINE wrf_get_dm_communicator_x ( communicator ) USE module_dm , ONLY : local_communicator_x IMPLICIT NONE INTEGER , INTENT(OUT) :: communicator communicator = local_communicator_x RETURN END SUBROUTINE wrf_get_dm_communicator_x SUBROUTINE wrf_get_dm_communicator_y ( communicator ) USE module_dm , ONLY : local_communicator_y IMPLICIT NONE INTEGER , INTENT(OUT) :: communicator communicator = local_communicator_y RETURN END SUBROUTINE wrf_get_dm_communicator_y SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator ) USE module_dm , ONLY : local_iocommunicator IMPLICIT NONE INTEGER , INTENT(OUT) :: iocommunicator iocommunicator = local_iocommunicator RETURN END SUBROUTINE wrf_get_dm_iocommunicator SUBROUTINE wrf_set_dm_communicator ( communicator ) USE module_dm , ONLY : local_communicator IMPLICIT NONE INTEGER , INTENT(IN) :: communicator local_communicator = communicator RETURN END SUBROUTINE wrf_set_dm_communicator SUBROUTINE wrf_set_dm_iocommunicator ( iocommunicator ) USE module_dm , ONLY : local_iocommunicator IMPLICIT NONE INTEGER , INTENT(IN) :: iocommunicator local_iocommunicator = iocommunicator RETURN END SUBROUTINE wrf_set_dm_iocommunicator SUBROUTINE wrf_get_dm_ntasks_x ( retval ) USE module_dm , ONLY : ntasks_x IMPLICIT NONE INTEGER , INTENT(OUT) :: retval retval = ntasks_x RETURN END SUBROUTINE wrf_get_dm_ntasks_x SUBROUTINE wrf_get_dm_ntasks_y ( retval ) USE module_dm , ONLY : ntasks_y IMPLICIT NONE INTEGER , INTENT(OUT) :: retval retval = ntasks_y RETURN END SUBROUTINE wrf_get_dm_ntasks_y SUBROUTINE wrf_set_dm_quilt_comm ( communicator ) USE module_dm , ONLY : local_quilt_comm IMPLICIT NONE INTEGER , INTENT(IN) :: communicator local_quilt_comm = communicator RETURN END SUBROUTINE wrf_set_dm_quilt_comm SUBROUTINE wrf_get_dm_quilt_comm ( communicator ) USE module_dm , ONLY : local_quilt_comm IMPLICIT NONE INTEGER , INTENT(OUT) :: communicator communicator = local_quilt_comm RETURN END SUBROUTINE wrf_get_dm_quilt_comm SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc REAL globbuf(*) REAL buf(*) CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_patch_to_global_real SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc REAL globbuf(*) REAL buf(*) CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,8,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_patch_to_global_double SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc INTEGER globbuf(*) INTEGER buf(*) CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_patch_to_global_integer SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc LOGICAL globbuf(*) LOGICAL buf(*) CALL wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_patch_to_global_logical SUBROUTINE wrf_patch_to_global_generic (buf,globbuf,domdesc,stagger,ordering,typesize,& DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,& MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,& PS1a,PE1a,PS2a,PE2a,PS3a,PE3a ) USE module_driver_constants USE module_timing USE module_wrf_error, ONLY : wrf_at_debug_level USE module_dm, ONLY : local_communicator, ntasks IMPLICIT NONE INTEGER DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,& MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,& PS1a,PE1a,PS2a,PE2a,PS3a,PE3A CHARACTER *(*) stagger,ordering INTEGER domdesc,typesize,ierr REAL globbuf(*) REAL buf(*) INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 INTEGER ids,ide,jds,jde,kds,kde,& ims,ime,jms,jme,kms,kme,& ips,ipe,jps,jpe,kps,kpe LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char INTEGER i, j, k, ndim INTEGER Patch(3,2), Gpatch(3,2,ntasks) REAL, ALLOCATABLE :: tmpbuf( : ) REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/4*typesize+32 ) DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a SELECT CASE ( TRIM(ordering) ) CASE ( 'xy', 'yx' ) ndim = 2 CASE DEFAULT ndim = 3 END SELECT SELECT CASE ( TRIM(ordering) ) CASE ( 'xyz','xy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1 CASE ( 'yxz','yx' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1 CASE ( 'zxy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1 CASE ( 'xzy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1 CASE DEFAULT END SELECT IF ( wrf_dm_on_monitor() ) THEN ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/4*typesize+32 ), STAT=ierr ) ELSE ALLOCATE ( tmpbuf ( 1 ), STAT=ierr ) END IF IF ( ierr .ne. 0 ) CALL wrf_error_fatal3("",6879,& 'allocating tmpbuf in wrf_patch_to_global_generic') Patch(1,1) = ps1 ; Patch(1,2) = pe1 Patch(2,1) = ps2 ; Patch(2,2) = pe2 Patch(3,1) = ps3 ; Patch(3,2) = pe3 IF ( typesize .EQ. 4 ) THEN CALL just_patch_r ( buf , locbuf , size(locbuf)*4/typesize, & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 4 ) THEN CALL just_patch_i ( buf , locbuf , size(locbuf)*4/typesize, & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 8 ) THEN CALL just_patch_d ( buf , locbuf , size(locbuf)*4/typesize, & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 4 ) THEN CALL just_patch_l ( buf , locbuf , size(locbuf)*4/typesize, & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) END IF CALL collect_on_comm0 ( local_communicator , 4 , & Patch , 6 , & GPatch , 6*ntasks ) CALL collect_on_comm0 ( local_communicator , typesize , & locbuf , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1), & tmpbuf , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) ) ndim = len(TRIM(ordering)) IF ( wrf_at_debug_level(500) ) THEN CALL start_timing END IF IF ( ndim .GE. 2 .AND. wrf_dm_on_monitor() ) THEN IF ( typesize .EQ. 4 ) THEN CALL patch_2_outbuf_r ( tmpbuf , globbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) ELSE IF ( typesize .EQ. 4 ) THEN CALL patch_2_outbuf_i ( tmpbuf , globbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) ELSE IF ( typesize .EQ. 8 ) THEN CALL patch_2_outbuf_d ( tmpbuf , globbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) ELSE IF ( typesize .EQ. 4 ) THEN CALL patch_2_outbuf_l ( tmpbuf , globbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) END IF END IF IF ( wrf_at_debug_level(500) ) THEN CALL end_timing('wrf_patch_to_global_generic') END IF DEALLOCATE( tmpbuf ) RETURN END SUBROUTINE wrf_patch_to_global_generic SUBROUTINE just_patch_i ( inbuf , outbuf, noutbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE INTEGER , INTENT(IN) :: noutbuf INTEGER , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 INTEGER , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(IN) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( icurs ) = inbuf( i, j, k ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE just_patch_i SUBROUTINE just_patch_r ( inbuf , outbuf, noutbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE INTEGER , INTENT(IN) :: noutbuf REAL , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 REAL , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf INTEGER :: i,j,k , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( icurs ) = inbuf( i, j, k ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE just_patch_r SUBROUTINE just_patch_d ( inbuf , outbuf, noutbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE INTEGER , INTENT(IN) :: noutbuf DOUBLE PRECISION , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 DOUBLE PRECISION , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( icurs ) = inbuf( i, j, k ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE just_patch_d SUBROUTINE just_patch_l ( inbuf , outbuf, noutbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE INTEGER , INTENT(IN) :: noutbuf LOGICAL , DIMENSION(noutbuf) , INTENT(OUT) :: outbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 LOGICAL , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(in) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( icurs ) = inbuf( i, j, k ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE just_patch_l SUBROUTINE patch_2_outbuf_r( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3, & GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE REAL , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) REAL , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( i, j, k ) = inbuf( icurs ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE patch_2_outbuf_r SUBROUTINE patch_2_outbuf_i( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) INTEGER , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( i, j, k ) = inbuf( icurs ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE patch_2_outbuf_i SUBROUTINE patch_2_outbuf_d( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE DOUBLE PRECISION , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) DOUBLE PRECISION , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( i, j, k ) = inbuf( icurs ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE patch_2_outbuf_d SUBROUTINE patch_2_outbuf_l( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE LOGICAL , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) LOGICAL , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(out) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( i, j, k ) = inbuf( icurs ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE patch_2_outbuf_l SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc REAL globbuf(*) REAL buf(*) CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_global_to_patch_real SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc REAL globbuf(*) REAL buf(*) CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,8,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_global_to_patch_double SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc INTEGER globbuf(*) INTEGER buf(*) CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_global_to_patch_integer SUBROUTINE wrf_global_to_patch_logical (globbuf,buf,domdesc,stagger,ordering,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) IMPLICIT NONE INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 CHARACTER *(*) stagger,ordering INTEGER fid,domdesc LOGICAL globbuf(*) LOGICAL buf(*) CALL wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,4,& DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 ) RETURN END SUBROUTINE wrf_global_to_patch_logical SUBROUTINE wrf_global_to_patch_generic (globbuf,buf,domdesc,stagger,ordering,typesize,& DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,& MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,& PS1a,PE1a,PS2a,PE2a,PS3a,PE3a ) USE module_dm, ONLY : local_communicator, ntasks USE module_driver_constants IMPLICIT NONE INTEGER DS1a,DE1a,DS2a,DE2a,DS3a,DE3a,& MS1a,ME1a,MS2a,ME2a,MS3a,ME3a,& PS1a,PE1a,PS2a,PE2a,PS3a,PE3A CHARACTER *(*) stagger,ordering INTEGER domdesc,typesize,ierr REAL globbuf(*) REAL buf(*) INTEGER DS1,DE1,DS2,DE2,DS3,DE3,& MS1,ME1,MS2,ME2,MS3,ME3,& PS1,PE1,PS2,PE2,PS3,PE3 LOGICAL, EXTERNAL :: wrf_dm_on_monitor, has_char INTEGER i,j,k,ord,ord2d,ndim INTEGER Patch(3,2), Gpatch(3,2,ntasks) REAL, ALLOCATABLE :: tmpbuf( : ) REAL locbuf( (PE1a-PS1a+1)*(PE2a-PS2a+1)*(PE3a-PS3a+1)/4*typesize+32 ) DS1 = DS1a ; DE1 = DE1a ; DS2=DS2a ; DE2 = DE2a ; DS3 = DS3a ; DE3 = DE3a MS1 = MS1a ; ME1 = ME1a ; MS2=MS2a ; ME2 = ME2a ; MS3 = MS3a ; ME3 = ME3a PS1 = PS1a ; PE1 = PE1a ; PS2=PS2a ; PE2 = PE2a ; PS3 = PS3a ; PE3 = PE3a SELECT CASE ( TRIM(ordering) ) CASE ( 'xy', 'yx' ) ndim = 2 CASE DEFAULT ndim = 3 END SELECT SELECT CASE ( TRIM(ordering) ) CASE ( 'xyz','xy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE2 = DE2+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1 CASE ( 'yxz','yx' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE1 = DE1+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE3 = DE3+1 CASE ( 'zxy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE2 = DE2+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE1 = DE1+1 CASE ( 'xzy' ) IF ( .NOT. has_char( stagger, 'x' ) ) DE1 = DE1+1 IF ( .NOT. has_char( stagger, 'y' ) ) DE3 = DE3+1 IF ( ndim .EQ. 3 .AND. .NOT. has_char( stagger, 'z' ) ) DE2 = DE2+1 CASE DEFAULT END SELECT IF ( wrf_dm_on_monitor() ) THEN ALLOCATE ( tmpbuf ( (DE1-DS1+1)*(DE2-DS2+1)*(DE3-DS3+1)/4*typesize+32 ), STAT=ierr ) ELSE ALLOCATE ( tmpbuf ( 1 ), STAT=ierr ) END IF IF ( ierr .ne. 0 ) CALL wrf_error_fatal3("",7253,& 'allocating tmpbuf in wrf_global_to_patch_generic') Patch(1,1) = ps1 ; Patch(1,2) = pe1 Patch(2,1) = ps2 ; Patch(2,2) = pe2 Patch(3,1) = ps3 ; Patch(3,2) = pe3 CALL collect_on_comm0 ( local_communicator , 4 , & Patch , 6 , & GPatch , 6*ntasks ) ndim = len(TRIM(ordering)) IF ( wrf_dm_on_monitor() .AND. ndim .GE. 2 ) THEN IF ( typesize .EQ. 4 ) THEN CALL outbuf_2_patch_r ( globbuf , tmpbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & MS1, ME1, MS2, ME2, MS3, ME3 , & GPATCH ) ELSE IF ( typesize .EQ. 4 ) THEN CALL outbuf_2_patch_i ( globbuf , tmpbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) ELSE IF ( typesize .EQ. 8 ) THEN CALL outbuf_2_patch_d ( globbuf , tmpbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) ELSE IF ( typesize .EQ. 4 ) THEN CALL outbuf_2_patch_l ( globbuf , tmpbuf , & DS1, DE1, DS2, DE2, DS3, DE3 , & GPATCH ) END IF END IF CALL dist_on_comm0 ( local_communicator , typesize , & tmpbuf , (de1-ds1+1)*(de2-ds2+1)*(de3-ds3+1) , & locbuf , (pe1-ps1+1)*(pe2-ps2+1)*(pe3-ps3+1) ) IF ( typesize .EQ. 4 ) THEN CALL all_sub_r ( locbuf , buf , & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 4 ) THEN CALL all_sub_i ( locbuf , buf , & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 8 ) THEN CALL all_sub_d ( locbuf , buf , & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) ELSE IF ( typesize .EQ. 4 ) THEN CALL all_sub_l ( locbuf , buf , & PS1, PE1, PS2, PE2, PS3, PE3 , & MS1, ME1, MS2, ME2, MS3, ME3 ) END IF DEALLOCATE ( tmpbuf ) RETURN END SUBROUTINE wrf_global_to_patch_generic SUBROUTINE all_sub_i ( inbuf , outbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 INTEGER , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( i, j, k ) = inbuf ( icurs ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE all_sub_i SUBROUTINE all_sub_r ( inbuf , outbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE REAL , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 REAL , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( i, j, k ) = inbuf ( icurs ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE all_sub_r SUBROUTINE all_sub_d ( inbuf , outbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE DOUBLE PRECISION , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 DOUBLE PRECISION , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( i, j, k ) = inbuf ( icurs ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE all_sub_d SUBROUTINE all_sub_l ( inbuf , outbuf, & PS1,PE1,PS2,PE2,PS3,PE3, & MS1,ME1,MS2,ME2,MS3,ME3 ) IMPLICIT NONE LOGICAL , DIMENSION(*) , INTENT(IN) :: inbuf INTEGER MS1,ME1,MS2,ME2,MS3,ME3 INTEGER PS1,PE1,PS2,PE2,PS3,PE3 LOGICAL , DIMENSION( MS1:ME1,MS2:ME2,MS3:ME3 ) , INTENT(OUT) :: outbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO k = PS3, PE3 DO j = PS2, PE2 DO i = PS1, PE1 outbuf( i, j, k ) = inbuf ( icurs ) icurs = icurs + 1 END DO END DO END DO RETURN END SUBROUTINE all_sub_l SUBROUTINE outbuf_2_patch_r( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3, & MS1, ME1, MS2, ME2, MS3, ME3 , & GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE REAL , DIMENSION(*) , INTENT(OUT) :: outbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) INTEGER MS1,ME1,MS2,ME2,MS3,ME3 REAL , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( icurs ) = inbuf( i,j,k ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE outbuf_2_patch_r SUBROUTINE outbuf_2_patch_i( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE INTEGER , DIMENSION(*) , INTENT(OUT) :: outbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) INTEGER , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( icurs ) = inbuf( i,j,k ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE outbuf_2_patch_i SUBROUTINE outbuf_2_patch_d( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE DOUBLE PRECISION , DIMENSION(*) , INTENT(OUT) :: outbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) DOUBLE PRECISION , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( icurs ) = inbuf( i,j,k ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE outbuf_2_patch_d SUBROUTINE outbuf_2_patch_l( inbuf, outbuf, & DS1,DE1,DS2,DE2,DS3,DE3,& GPATCH ) USE module_dm, ONLY : ntasks IMPLICIT NONE LOGICAL , DIMENSION(*) , INTENT(OUT) :: outbuf INTEGER DS1,DE1,DS2,DE2,DS3,DE3,GPATCH(3,2,ntasks) LOGICAL , DIMENSION( DS1:DE1,DS2:DE2,DS3:DE3 ) , INTENT(IN) :: inbuf INTEGER :: i,j,k,n , icurs icurs = 1 DO n = 1, ntasks DO k = GPATCH( 3,1,n ), GPATCH( 3,2,n ) DO j = GPATCH( 2,1,n ), GPATCH( 2,2,n ) DO i = GPATCH( 1,1,n ), GPATCH( 1,2,n ) outbuf( icurs ) = inbuf( i,j,k ) icurs = icurs + 1 END DO END DO END DO END DO RETURN END SUBROUTINE outbuf_2_patch_l SUBROUTINE wrf_dm_nestexchange_init CALL rsl_lite_nesting_reset END SUBROUTINE wrf_dm_nestexchange_init SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, local_communicator, mytask, & nest_pes_x, nest_pes_y USE module_comm_nesting_dm, ONLY : halo_force_down_sub USE module_model_constants IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: ngrid TYPE(domain), POINTER :: pgrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k,kk TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7,itrace REAL dummy_xs, dummy_xe, dummy_ys, dummy_ye REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n REAL, DIMENSION(:,:,:), ALLOCATABLE :: p, al REAL :: pfu, pfd, phm, temp, qvf, qvf1, qvf2 CALL get_ijk_from_grid ( pgrid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) nlev = ckde - ckds + 1 CALL rsl_lite_from_parent_info(pig,pjg,retval) DO while ( retval .eq. 1 ) IF ( SIZE(grid%xlat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lu_index) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lu_index(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%u_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%u_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%v_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%v_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%w_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%w_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ph_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%ph_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%phb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%phb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%t_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_init) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%t_init(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%mu_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%mu_2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%mub) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%mub(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%alb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%alb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%pb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%q2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%th2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%th2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%psfc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%psfc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%u10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%u10(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%v10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%v10(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lpi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lpi(pig,pjg) = xv(1) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) dfi_moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%qvold) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qvold(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qnwfa2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qnwfa2d(pig,pjg) = xv(1) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) dfi_scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%toposlpx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%toposlpx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%toposlpy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%toposlpy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%slope) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%slope(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%slp_azi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%slp_azi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shdmax) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shdmax(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shdmin) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shdmin(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%landusef) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%landusef(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%soilctop) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_cat grid%soilctop(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%soilcbot) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_cat grid%soilcbot(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tslb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tslb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smois) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smois(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh2o) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%sh2o(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smcrel) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smcrel(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%xice) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xice(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%icedepth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%icedepth(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xicem) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xicem(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%albsi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%albsi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowsi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowsi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%smstav) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%smstav(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sfcrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sfcrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%udrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%udrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ivgtyp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ivgtyp(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%isltyp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%isltyp(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%vegfra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%vegfra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acgrdflx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acgrdflx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acsnow) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acsnow(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acgraup) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acgraup(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acsnom) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acsnom(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acfrain) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acfrain(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowh) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowh(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canwat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canwat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sstsk) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sstsk(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lake_depth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lake_depth(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%uoce) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%uoce(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%voce) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%voce(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%uc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%uc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cmcr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cmcr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgrl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tgrl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smr_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smr_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%trl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%trl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tbl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tbl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tgl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tgl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sh_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lh_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%g_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%g_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rn_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rn_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ts_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ts_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%frc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%frc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%utype_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%utype_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%imperv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%imperv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canfra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canfra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%var2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%var2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oc12d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oc12d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa3(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa4(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol3(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol4(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%var2dss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%var2dss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oc12dss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oc12dss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa1ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa1ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa2ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa2ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa3ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa3ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa4ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa4ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol1ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol1ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol2ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol2ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol3ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol3ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol4ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol4ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ctopo) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ctopo(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ctopo2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ctopo2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%o3rad) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%o3rad(pig,k,pjg) = xv(k) ENDDO ENDIF DO itrace = PARAM_FIRST_SCALAR, num_aerod CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) aerod(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%f_ice_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_ice_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%f_rain_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_rain_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%f_rimef_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_rimef_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_tmp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_tmp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_s) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_s(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_depth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_depth(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_u(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_v(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_lat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_lat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_lon) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_lon(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_tini) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_tini(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_sini) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_sini(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%h_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qv_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qv_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qc_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qc_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%msft) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msft(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfu) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfu(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msftx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msftx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfty) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfty(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfux) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfux(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfuy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfuy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvx_inv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvx_inv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%f) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%f(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%e) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%e(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sina) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sina(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cosa) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cosa(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ht) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ht(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ht_shad) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ht_shad(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsk) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tsk(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainsh) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainsh(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%frain) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%frain(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_rainc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_rainc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_rainnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_rainnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snownc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snownc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%graupelnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%graupelnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hailnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hailnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%refl_10cm(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%composite_refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%composite_refl_10cm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm_1km) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%refl_10cm_1km(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm_4km) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%refl_10cm_4km(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%th_old) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%th_old(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qv_old) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qv_old(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%vmi3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vmi3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%di3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%di3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rhopo3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%rhopo3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%w_up) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%w_up(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rthraten) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%rthraten(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%swdown) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdown(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gsw) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gsw(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%glw) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%glw(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swnorm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swnorm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%diffuse_frac) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%diffuse_frac(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddir) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddir(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddni) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddni(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddif) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddif(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddnic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddnic(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddifc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddifc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gg(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%coszen_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%coszen_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdown_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdown_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddir_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddir_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlat_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat_u(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong_u(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlat_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat_v(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong_v(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%clat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%clat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%isnowxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%isnowxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canicexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canicexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canliqxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canliqxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%eahxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%eahxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tahxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tahxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cmxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cmxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fwetxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fwetxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sneqvoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sneqvoxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%alboldxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%alboldxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qsnowxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qsnowxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wslakexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wslakexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%zwtxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%zwtxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%waxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%waxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wtxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wtxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsnoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%tsnoxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%zsnsoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snso_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snso_layers grid%zsnsoxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snicexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%snicexy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snliqxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%snliqxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lfmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lfmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rtmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rtmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%stmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%stmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%woodxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%woodxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%stblcpxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%stblcpxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fastcpxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fastcpxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xsaixy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xsaixy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2mvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2mbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%q2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2mvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%q2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2mbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tradxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tradxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%neexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%neexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gppxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gppxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nppxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nppxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fvegxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fvegxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qinxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qinxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%runsfxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%runsfxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%runsbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%runsbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ecanxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ecanxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%edirxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%edirxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%etranxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%etranxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fsaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fsaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%firaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%firaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aparxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aparxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%psnxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%psnxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%savxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%savxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sagxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sagxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rssunxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rssunxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rsshaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rsshaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bgapxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bgapxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wgapxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wgapxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shcxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shcxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ghvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ghvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ghbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ghbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%irgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%irgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ircxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ircxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%irbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%irbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%trxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%trxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evcxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evcxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chleafxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chleafxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chucxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chucxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chv2xy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chv2xy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chb2xy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chb2xy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chstarxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chstarxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fdepthxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fdepthxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%eqzwt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%eqzwt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rechclim) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rechclim(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rivermask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rivermask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%riverbedxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%riverbedxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nonriverxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nonriverxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%grainxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%grainxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gddxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gddxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%croptype) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((5)-(1)+1)*4,xv) DO k = 1,5 grid%croptype(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%planting) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%planting(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%harvest) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%harvest(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%season_gdd) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%season_gdd(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsk_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tsk_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qsfc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%qsfc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tslb_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tslb_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smois_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%smois_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh2o_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%sh2o_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%canwat_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%canwat_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snow_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snow_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowh_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snowh_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snowc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tr_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tr_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tb_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tb_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tg_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tg_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ts_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%ts_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ts_rul2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%ts_rul2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%qc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%uc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%uc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%trl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%trl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tbl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tbl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tgl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tgl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%mosaic_cat_index) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%mosaic_cat_index(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%landusef2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%landusef2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tmn) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tmn(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tyr) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tyr(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tyra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tyra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tdly) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tdly(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tlag) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%lagday)-(1)+1)*4,xv) DO k = 1,config_flags%lagday grid%tlag(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%xland) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xland(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%achfx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%achfx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclhf) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclhf(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_c) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_c(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_c1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_c1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_nc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_nc1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow_acc_nc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow_acc_nc1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t0ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t0ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%h0ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%h0ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%huml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%huml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hvml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hvml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tmoml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tmoml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%erod) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%erosion_dim)-(1)+1)*4,xv) DO k = 1,config_flags%erosion_dim grid%erod(pig,pjg,k) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qlsink) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qlsink(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precr) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precr(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%preci) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%preci(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precs) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precs(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precg(pig,k,pjg) = xv(k) ENDDO ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) chem(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) tracer(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%vertstrucc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vertstrucc(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%vertstrucs) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vertstrucs(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_sf) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_sf(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_pbl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_pbl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_conv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_conv(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ru_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%ru_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rv_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rv_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rt_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rt_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rand_pert) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rand_pert(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_conv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_conv(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_pbl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_pbl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_mp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_mp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_lsm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_lsm(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rstoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rstoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%numc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%numc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nump) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nump(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowdp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowdp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%wtc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%wtc(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%wtp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%wtp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osno) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osno(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_grnd) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_grnd(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_veg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_veg(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2ocan) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2ocan(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2ocan_col) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2ocan_col(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t2m_max) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2m_max(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2m_min) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2m_min(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2clm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2clm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_ref2m) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_ref2m(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%albedosubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%albedosubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lhsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%lhsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%hfxsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%hfxsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lwupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%lwupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%q2subgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%q2subgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sabvsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%sabvsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sabgsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%sabgsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%nrasubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%nrasubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%swupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%swupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lakedepth2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lakedepth2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%savedtke12d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%savedtke12d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowdp2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowdp2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%h2osno2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%h2osno2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snl2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snl2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_grnd2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_grnd2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%t_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lake_icefrac3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%lake_icefrac3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%z_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%z_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dz_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%dz_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%t_soisno3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_ice3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_liq3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_vol3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%z3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%z3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dz3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%dz3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%zi3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((16)-(1)+1)*4,xv) DO k = 1,16 grid%zi3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%watsat3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%watsat3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%csol3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%csol3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tkmg3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tkmg3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tkdry3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tkdry3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tksatu3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tksatu3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_u_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_u_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_v_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_v_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_t_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_t_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pcb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%pcb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%pc_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%pc_2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%landmask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%landmask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lakemask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lakemask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sst) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sst(pig,pjg) = xv(1) ENDIF CALL rsl_lite_from_parent_info(pig,pjg,retval) ENDDO if (ngrid%vert_refine_method .NE. 0) then hsca_m = 6.7 p_top_m = ngrid%p_top p_surf_m = 1.e5 mu_m = p_surf_m - p_top_m do k = 1,ckde pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) enddo do k = 1,ckde-1 pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) enddo alt_u_c(1) = alt_w_c(1) alt_u_c(ckde+1) = alt_w_c(ckde) do k = 1,nkde pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) enddo do k = 1,nkde-1 pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) enddo alt_u_n(1) = alt_w_n(1) alt_u_n(nkde+1) = alt_w_n(nkde) endif CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) IF (ngrid%vert_refine_method .NE. 0) THEN IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%u_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%v_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting_w( & grid%w_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & alt_w_c, alt_w_n ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting_w( & grid%ph_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & alt_w_c, alt_w_n ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%t_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO IF ( ngrid%this_is_an_ideal_run ) THEN IF ( SIZE( grid%t_init, 1 ) * SIZE( grid%t_init, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( grid%t_init, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) END IF END IF DO j = MAX(jds,jps),MIN(jde-1,jpe) DO i = MAX(ids,ips),MIN(ide-1,ipe) DO k=kds,kde-1 grid%t_2(i,k,j) = grid%t_2(i,k,j)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) moist(i,k,j,P_QV) = moist(i,k,j,P_QV)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) END DO END DO END DO DO j = MAX(jds,jps),MIN(jde-1,jpe) DO i = MAX(ids,ips),MIN(ide-1,ipe) DO k = 1, kpe-1 grid%pb(i,k,j) = ngrid%c3h(k)*(ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + ngrid%c4h(k) + ngrid%p_top IF ( .NOT. ngrid%this_is_an_ideal_run ) THEN temp = MAX ( ngrid%tiso, ngrid%t00 + ngrid%tlp*LOG(grid%pb(i,k,j)/ngrid%p00) ) IF ( grid%pb(i,k,j) .LT. ngrid%p_strat ) THEN temp = ngrid%tiso + ngrid%tlp_strat * LOG ( grid%pb(i,k,j)/ngrid%p_strat ) END IF grid%t_init(i,k,j) = temp*(ngrid%p00/grid%pb(i,k,j))**(r_d/cp) - t0 END IF grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm END DO grid%phb(i,1,j) = grid%ht(i,j) * g IF (grid%hypsometric_opt == 1) THEN DO kk = 2,kpe k = kk - 1 grid%phb(i,kk,j) = grid%phb(i,k,j) - ngrid%dnw(k)*(ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))*grid%alb(i,k,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN DO k = 2,kpe pfu = ngrid%c3f(k )*grid%MUB(i,j) + ngrid%c4f(k ) + ngrid%p_top pfd = ngrid%c3f(k-1)*grid%MUB(i,j) + ngrid%c4f(k-1) + ngrid%p_top phm = ngrid%c3h(k-1)*grid%MUB(i,j) + ngrid%c4h(k-1) + ngrid%p_top grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO ELSE CALL wrf_error_fatal3("",10438,& 'module_dm: hypsometric_opt should be 1 or 2' ) END IF END DO END DO ALLOCATE( p (ips:ipe, kps:kpe, jps:jpe) ) ALLOCATE( al(ips:ipe, kps:kpe, jps:jpe) ) DO j = MAX(jds,jps),MIN(jde-1,jpe) DO i = MAX(ids,ips),MIN(ide-1,ipe) kk = kpe-1 k = kk+1 qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 p(i,kk,j) = - 0.5*((ngrid%c1f(k)*grid%Mu_2(i,j))+qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/ngrid%rdnw(kk)/qvf2 qvf = 1. + rvovrd*moist(i,kk,j,P_QV) al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) DO kk=kpe-2,1,-1 k = kk + 1 qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 p(i,kk,j) = p(i,kk+1,j) - ((ngrid%c1f(k)*grid%Mu_2(i,j)) + qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/qvf2/ngrid%rdn(kk+1) qvf = 1. + rvovrd*moist(i,kk,j,P_QV) al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) END DO IF (grid%hypsometric_opt == 1) THEN DO kk = 2,kpe k = kk - 1 grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & ngrid%dnw(kk-1) * ( ((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))+(ngrid%c1h(k)*grid%mu_2(i,j)))*al(i,kk-1,j) & + (ngrid%c1h(k)*grid%mu_2(i,j))*grid%alb(i,kk-1,j) ) END DO ELSE IF (grid%hypsometric_opt == 2) THEN grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kpe pfu = ngrid%c3f(k )*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k ) + ngrid%p_top pfd = ngrid%c3f(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k-1) + ngrid%p_top phm = ngrid%c3h(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4h(k-1) + ngrid%p_top grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + (grid%alb(i,k-1,j)+al(i,k-1,j))*phm*LOG(pfd/pfu) END DO DO k = 1,kpe grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) END DO END IF END DO END DO DEALLOCATE(p) DEALLOCATE(al) DO j = MAX(jds,jps),MIN(jde-1,jpe) DO i = MAX(ids,ips),MIN(ide-1,ipe) DO k=kps,kpe grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*((ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)) + (ngrid%c1f(k)*grid%Mu_2(i,j))) END DO END DO END DO DO j = MAX(jds,jps),MIN(jde-1,jpe) DO i = MAX(ids,ips),MIN(ide-1,ipe) DO k=kps,kpe-1 grid%t_2(i,k,j) = grid%t_2(i,k,j)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) moist(i,k,j,P_QV) = moist(i,k,j,P_QV)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) END DO END DO END DO END IF CALL HALO_FORCE_DOWN_sub ( grid, & num_moist, & moist, & num_dfi_moist, & dfi_moist, & num_scalar, & scalar, & num_dfi_scalar, & dfi_scalar, & num_chem, & chem, & num_tracer, & tracer, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%u_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%u_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%u_bxs & ,dummy_xe ,ngrid%u_bxe & ,dummy_ys ,ngrid%u_bys & ,dummy_ye ,ngrid%u_bye & ,dummy_xs ,ngrid%u_btxs & ,dummy_xe ,ngrid%u_btxe & ,dummy_ys ,ngrid%u_btys & ,dummy_ye ,ngrid%u_btye & ,grid%dt,ngrid%dt& ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%v_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%v_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%v_bxs & ,dummy_xe ,ngrid%v_bxe & ,dummy_ys ,ngrid%v_bys & ,dummy_ye ,ngrid%v_bye & ,dummy_xs ,ngrid%v_btxs & ,dummy_xe ,ngrid%v_btxe & ,dummy_ys ,ngrid%v_btys & ,dummy_ye ,ngrid%v_btye & ,grid%dt,ngrid%dt& ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%w_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%w_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%w_bxs & ,dummy_xe ,ngrid%w_bxe & ,dummy_ys ,ngrid%w_bys & ,dummy_ye ,ngrid%w_bye & ,dummy_xs ,ngrid%w_btxs & ,dummy_xe ,ngrid%w_btxe & ,dummy_ys ,ngrid%w_btys & ,dummy_ye ,ngrid%w_btye & ,grid%dt,ngrid%dt& ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%ph_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%ph_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%ph_bxs & ,dummy_xe ,ngrid%ph_bxe & ,dummy_ys ,ngrid%ph_bys & ,dummy_ye ,ngrid%ph_bye & ,dummy_xs ,ngrid%ph_btxs & ,dummy_xe ,ngrid%ph_btxe & ,dummy_ys ,ngrid%ph_btys & ,dummy_ye ,ngrid%ph_btye & ,grid%dt,ngrid%dt& ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%t_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%t_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%t_bxs & ,dummy_xe ,ngrid%t_bxe & ,dummy_ys ,ngrid%t_bys & ,dummy_ye ,ngrid%t_bye & ,dummy_xs ,ngrid%t_btxs & ,dummy_xe ,ngrid%t_btxe & ,dummy_ys ,ngrid%t_btys & ,dummy_ye ,ngrid%t_btye & ,grid%dt,ngrid%dt& ) ENDIF IF ( SIZE( grid%mu_2, 1 ) * SIZE( grid%mu_2, 2 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%mu_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%mu_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%mu_bxs & ,dummy_xe ,ngrid%mu_bxe & ,dummy_ys ,ngrid%mu_bys & ,dummy_ye ,ngrid%mu_bye & ,dummy_xs ,ngrid%mu_btxs & ,dummy_xe ,ngrid%mu_btxe & ,dummy_ys ,ngrid%mu_btys & ,dummy_ye ,ngrid%mu_btye & ,grid%dt,ngrid%dt& ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,moist_bxs(cjms,1,1,itrace) ,ngrid%moist_bxs(njms,1,1,itrace) & ,moist_bxe(cjms,1,1,itrace) ,ngrid%moist_bxe(njms,1,1,itrace) & ,moist_bys(cims,1,1,itrace) ,ngrid%moist_bys(nims,1,1,itrace) & ,moist_bye(cims,1,1,itrace) ,ngrid%moist_bye(nims,1,1,itrace) & ,moist_btxs(cjms,1,1,itrace) ,ngrid%moist_btxs(njms,1,1,itrace) & ,moist_btxe(cjms,1,1,itrace) ,ngrid%moist_btxe(njms,1,1,itrace) & ,moist_btys(cims,1,1,itrace) ,ngrid%moist_btys(nims,1,1,itrace) & ,moist_btye(cims,1,1,itrace) ,ngrid%moist_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dfi_moist_bxs(cjms,1,1,itrace) ,ngrid%dfi_moist_bxs(njms,1,1,itrace) & ,dfi_moist_bxe(cjms,1,1,itrace) ,ngrid%dfi_moist_bxe(njms,1,1,itrace) & ,dfi_moist_bys(cims,1,1,itrace) ,ngrid%dfi_moist_bys(nims,1,1,itrace) & ,dfi_moist_bye(cims,1,1,itrace) ,ngrid%dfi_moist_bye(nims,1,1,itrace) & ,dfi_moist_btxs(cjms,1,1,itrace) ,ngrid%dfi_moist_btxs(njms,1,1,itrace) & ,dfi_moist_btxe(cjms,1,1,itrace) ,ngrid%dfi_moist_btxe(njms,1,1,itrace) & ,dfi_moist_btys(cims,1,1,itrace) ,ngrid%dfi_moist_btys(nims,1,1,itrace) & ,dfi_moist_btye(cims,1,1,itrace) ,ngrid%dfi_moist_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,scalar_bxs(cjms,1,1,itrace) ,ngrid%scalar_bxs(njms,1,1,itrace) & ,scalar_bxe(cjms,1,1,itrace) ,ngrid%scalar_bxe(njms,1,1,itrace) & ,scalar_bys(cims,1,1,itrace) ,ngrid%scalar_bys(nims,1,1,itrace) & ,scalar_bye(cims,1,1,itrace) ,ngrid%scalar_bye(nims,1,1,itrace) & ,scalar_btxs(cjms,1,1,itrace) ,ngrid%scalar_btxs(njms,1,1,itrace) & ,scalar_btxe(cjms,1,1,itrace) ,ngrid%scalar_btxe(njms,1,1,itrace) & ,scalar_btys(cims,1,1,itrace) ,ngrid%scalar_btys(nims,1,1,itrace) & ,scalar_btye(cims,1,1,itrace) ,ngrid%scalar_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dfi_scalar_bxs(cjms,1,1,itrace) ,ngrid%dfi_scalar_bxs(njms,1,1,itrace) & ,dfi_scalar_bxe(cjms,1,1,itrace) ,ngrid%dfi_scalar_bxe(njms,1,1,itrace) & ,dfi_scalar_bys(cims,1,1,itrace) ,ngrid%dfi_scalar_bys(nims,1,1,itrace) & ,dfi_scalar_bye(cims,1,1,itrace) ,ngrid%dfi_scalar_bye(nims,1,1,itrace) & ,dfi_scalar_btxs(cjms,1,1,itrace) ,ngrid%dfi_scalar_btxs(njms,1,1,itrace) & ,dfi_scalar_btxe(cjms,1,1,itrace) ,ngrid%dfi_scalar_btxe(njms,1,1,itrace) & ,dfi_scalar_btys(cims,1,1,itrace) ,ngrid%dfi_scalar_btys(nims,1,1,itrace) & ,dfi_scalar_btye(cims,1,1,itrace) ,ngrid%dfi_scalar_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO IF ( SIZE( grid%ht_shad, 1 ) * SIZE( grid%ht_shad, 2 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%ht_shad, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ht_shad, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%ht_shad_bxs & ,dummy_xe ,ngrid%ht_shad_bxe & ,dummy_ys ,ngrid%ht_shad_bys & ,dummy_ye ,ngrid%ht_shad_bye & ,dummy_xs ,ngrid%ht_shad_btxs & ,dummy_xe ,ngrid%ht_shad_btxe & ,dummy_ys ,ngrid%ht_shad_btys & ,dummy_ye ,ngrid%ht_shad_btye & ,grid%dt,ngrid%dt& ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%chem(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,chem_bxs(cjms,1,1,itrace) ,ngrid%chem_bxs(njms,1,1,itrace) & ,chem_bxe(cjms,1,1,itrace) ,ngrid%chem_bxe(njms,1,1,itrace) & ,chem_bys(cims,1,1,itrace) ,ngrid%chem_bys(nims,1,1,itrace) & ,chem_bye(cims,1,1,itrace) ,ngrid%chem_bye(nims,1,1,itrace) & ,chem_btxs(cjms,1,1,itrace) ,ngrid%chem_btxs(njms,1,1,itrace) & ,chem_btxe(cjms,1,1,itrace) ,ngrid%chem_btxe(njms,1,1,itrace) & ,chem_btys(cims,1,1,itrace) ,ngrid%chem_btys(nims,1,1,itrace) & ,chem_btye(cims,1,1,itrace) ,ngrid%chem_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL bdy_interp ( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%tracer(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,tracer_bxs(cjms,1,1,itrace) ,ngrid%tracer_bxs(njms,1,1,itrace) & ,tracer_bxe(cjms,1,1,itrace) ,ngrid%tracer_bxe(njms,1,1,itrace) & ,tracer_bys(cims,1,1,itrace) ,ngrid%tracer_bys(nims,1,1,itrace) & ,tracer_bye(cims,1,1,itrace) ,ngrid%tracer_bye(nims,1,1,itrace) & ,tracer_btxs(cjms,1,1,itrace) ,ngrid%tracer_btxs(njms,1,1,itrace) & ,tracer_btxe(cjms,1,1,itrace) ,ngrid%tracer_btxe(njms,1,1,itrace) & ,tracer_btys(cims,1,1,itrace) ,ngrid%tracer_btys(nims,1,1,itrace) & ,tracer_btye(cims,1,1,itrace) ,ngrid%tracer_btye(nims,1,1,itrace) & ,grid%dt,ngrid%dt& ) ENDIF ENDDO IF ( SIZE( grid%pc_2, 1 ) * SIZE( grid%pc_2, 2 ) .GT. 1 ) THEN CALL bdy_interp ( & grid%pc_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%pc_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,dummy_xs ,ngrid%pc_bxs & ,dummy_xe ,ngrid%pc_bxe & ,dummy_ys ,ngrid%pc_bys & ,dummy_ye ,ngrid%pc_bye & ,dummy_xs ,ngrid%pc_btxs & ,dummy_xe ,ngrid%pc_btxe & ,dummy_ys ,ngrid%pc_btys & ,dummy_ye ,ngrid%pc_btye & ,grid%dt,ngrid%dt& ) ENDIF RETURN END SUBROUTINE force_domain_em_part2 SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & nest_task_offsets, nest_pes_x, nest_pes_y, which_kid, & intercomm_active, mpi_comm_to_kid, mpi_comm_to_mom, & mytask, get_dm_max_halo_width USE module_timing IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: intermediate_grid TYPE(domain), POINTER :: ngrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k INTEGER iparstrt,jparstrt,sw TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & iims, iime, ijms, ijme, ikms, ikme, & iips, iipe, ijps, ijpe, ikps, ikpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr INTEGER thisdomain_max_halo_width INTEGER local_comm, myproc, nproc INTEGER ioffset, ierr CALL wrf_get_dm_communicator ( local_comm ) CALL wrf_get_myproc( myproc ) CALL wrf_get_nproc( nproc ) CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( intermediate_grid , & iids, iide, ijds, ijde, ikds, ikde, & iims, iime, ijms, ijme, ikms, ikme, & iips, iipe, ijps, ijpe, ikps, ikpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) CALL nl_get_shw ( intermediate_grid%id, sw ) icoord = iparstrt - sw jcoord = jparstrt - sw idim_cd = iide - iids + 1 jdim_cd = ijde - ijds + 1 nlev = ckde - ckds + 1 CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) IF ( grid%active_this_task ) THEN msize = (205 + ((num_moist - PARAM_FIRST_SCALAR + 1)) & + ((num_dfi_moist - PARAM_FIRST_SCALAR + 1)) & + ((num_scalar - PARAM_FIRST_SCALAR + 1)) & + ((num_dfi_scalar - PARAM_FIRST_SCALAR + 1)) & + ((num_aerod - PARAM_FIRST_SCALAR + 1)) & + ((num_ozmixm - PARAM_FIRST_SCALAR + 1)) & + ((num_aerosolc - PARAM_FIRST_SCALAR + 1)) & + ((num_fdda3d - PARAM_FIRST_SCALAR + 1)) & + ((num_fdda2d - PARAM_FIRST_SCALAR + 1)) & + ((num_advh_t - PARAM_FIRST_SCALAR + 1)) & + ((num_advz_t - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_ant - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_dust - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_seas - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_seas2 - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_vol - PARAM_FIRST_SCALAR + 1)) & + ((num_ebu - PARAM_FIRST_SCALAR + 1)) & + ((num_ebu_in - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_aircraft - PARAM_FIRST_SCALAR + 1)) & + ((num_ext_coef - PARAM_FIRST_SCALAR + 1)) & + ((num_bscat_coef - PARAM_FIRST_SCALAR + 1)) & + ((num_asym_par - PARAM_FIRST_SCALAR + 1)) & + ((num_conv_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_chem_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_vmix_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_advh_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_advz_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_dvel - PARAM_FIRST_SCALAR + 1)) & + ((num_vprm_in - PARAM_FIRST_SCALAR + 1)) & + ((num_wet_in - PARAM_FIRST_SCALAR + 1)) & + ((num_chem - PARAM_FIRST_SCALAR + 1)) & + ((num_tracer - PARAM_FIRST_SCALAR + 1)) & + ((num_nba_mij - PARAM_FIRST_SCALAR + 1)) & + ((num_nba_rij - PARAM_FIRST_SCALAR + 1)) )* nlev + 318 CALL rsl_lite_to_child_info( msize*4 & ,cips,cipe,cjps,cjpe & ,iids,iide,ijds,ijde & ,nids,nide,njds,njde & ,pgr , sw & ,nest_task_offsets(ngrid%id) & ,nest_pes_x(grid%id) & ,nest_pes_y(grid%id) & ,nest_pes_x(intermediate_grid%id) & ,nest_pes_y(intermediate_grid%id) & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) DO while ( retval .eq. 1 ) IF ( SIZE(grid%xlat) .GT. 1 ) THEN xv(1)=grid%xlat(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xlong) .GT. 1 ) THEN xv(1)=grid%xlong(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lu_index) .GT. 1 ) THEN xv(1)=grid%lu_index(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN xv(1)=grid%t_max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN xv(1)=grid%ght_max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%max_p) .GT. 1 ) THEN xv(1)=grid%max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN xv(1)=grid%t_min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN xv(1)=grid%ght_min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%min_p) .GT. 1 ) THEN xv(1)=grid%min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%u_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%u_2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%v_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%v_2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%w_2) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= grid%w_2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%ph_2) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= grid%ph_2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%phb) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= grid%phb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%t_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%t_2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%t_init) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%t_init(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%mu_2) .GT. 1 ) THEN xv(1)=grid%mu_2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%mub) .GT. 1 ) THEN xv(1)=grid%mub(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%alb) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%alb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%pb) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%pb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%q2) .GT. 1 ) THEN xv(1)=grid%q2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t2) .GT. 1 ) THEN xv(1)=grid%t2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%th2) .GT. 1 ) THEN xv(1)=grid%th2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%psfc) .GT. 1 ) THEN xv(1)=grid%psfc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%u10) .GT. 1 ) THEN xv(1)=grid%u10(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%v10) .GT. 1 ) THEN xv(1)=grid%v10(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lpi) .GT. 1 ) THEN xv(1)=grid%lpi(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist DO k = ckds,(ckde-1) xv(k)= moist(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist DO k = ckds,(ckde-1) xv(k)= dfi_moist(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%qvold) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%qvold(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qnwfa2d) .GT. 1 ) THEN xv(1)=grid%qnwfa2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar DO k = ckds,(ckde-1) xv(k)= scalar(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar DO k = ckds,(ckde-1) xv(k)= dfi_scalar(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%toposlpx) .GT. 1 ) THEN xv(1)=grid%toposlpx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%toposlpy) .GT. 1 ) THEN xv(1)=grid%toposlpy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%slope) .GT. 1 ) THEN xv(1)=grid%slope(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%slp_azi) .GT. 1 ) THEN xv(1)=grid%slp_azi(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%shdmax) .GT. 1 ) THEN xv(1)=grid%shdmax(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%shdmin) .GT. 1 ) THEN xv(1)=grid%shdmin(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%landusef) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= grid%landusef(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%soilctop) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_cat xv(k)= grid%soilctop(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%soilcbot) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_cat xv(k)= grid%soilcbot(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tslb) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%tslb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smois) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%smois(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh2o) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%sh2o(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smcrel) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%smcrel(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%xice) .GT. 1 ) THEN xv(1)=grid%xice(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%icedepth) .GT. 1 ) THEN xv(1)=grid%icedepth(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xicem) .GT. 1 ) THEN xv(1)=grid%xicem(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%albsi) .GT. 1 ) THEN xv(1)=grid%albsi(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snowsi) .GT. 1 ) THEN xv(1)=grid%snowsi(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%smstav) .GT. 1 ) THEN xv(1)=grid%smstav(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sfcrunoff) .GT. 1 ) THEN xv(1)=grid%sfcrunoff(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%udrunoff) .GT. 1 ) THEN xv(1)=grid%udrunoff(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ivgtyp) .GT. 1 ) THEN xv(1)=grid%ivgtyp(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%isltyp) .GT. 1 ) THEN xv(1)=grid%isltyp(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%vegfra) .GT. 1 ) THEN xv(1)=grid%vegfra(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acgrdflx) .GT. 1 ) THEN xv(1)=grid%acgrdflx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acsnow) .GT. 1 ) THEN xv(1)=grid%acsnow(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acgraup) .GT. 1 ) THEN xv(1)=grid%acgraup(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acrunoff) .GT. 1 ) THEN xv(1)=grid%acrunoff(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acsnom) .GT. 1 ) THEN xv(1)=grid%acsnom(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acfrain) .GT. 1 ) THEN xv(1)=grid%acfrain(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snow) .GT. 1 ) THEN xv(1)=grid%snow(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snowh) .GT. 1 ) THEN xv(1)=grid%snowh(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%canwat) .GT. 1 ) THEN xv(1)=grid%canwat(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sstsk) .GT. 1 ) THEN xv(1)=grid%sstsk(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lake_depth) .GT. 1 ) THEN xv(1)=grid%lake_depth(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%uoce) .GT. 1 ) THEN xv(1)=grid%uoce(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%voce) .GT. 1 ) THEN xv(1)=grid%voce(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tr_urb2d) .GT. 1 ) THEN xv(1)=grid%tr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tgr_urb2d) .GT. 1 ) THEN xv(1)=grid%tgr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tb_urb2d) .GT. 1 ) THEN xv(1)=grid%tb_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tg_urb2d) .GT. 1 ) THEN xv(1)=grid%tg_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tc_urb2d) .GT. 1 ) THEN xv(1)=grid%tc_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%qc_urb2d) .GT. 1 ) THEN xv(1)=grid%qc_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%uc_urb2d) .GT. 1 ) THEN xv(1)=grid%uc_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xxxr_urb2d) .GT. 1 ) THEN xv(1)=grid%xxxr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xxxb_urb2d) .GT. 1 ) THEN xv(1)=grid%xxxb_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xxxg_urb2d) .GT. 1 ) THEN xv(1)=grid%xxxg_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xxxc_urb2d) .GT. 1 ) THEN xv(1)=grid%xxxc_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%cmcr_urb2d) .GT. 1 ) THEN xv(1)=grid%cmcr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%drelr_urb2d) .GT. 1 ) THEN xv(1)=grid%drelr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%drelb_urb2d) .GT. 1 ) THEN xv(1)=grid%drelb_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%drelg_urb2d) .GT. 1 ) THEN xv(1)=grid%drelg_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumr_urb2d) .GT. 1 ) THEN xv(1)=grid%flxhumr_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumb_urb2d) .GT. 1 ) THEN xv(1)=grid%flxhumb_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumg_urb2d) .GT. 1 ) THEN xv(1)=grid%flxhumg_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tgrl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%tgrl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smr_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%smr_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%trl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%trl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tbl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%tbl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tgl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= grid%tgl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh_urb2d) .GT. 1 ) THEN xv(1)=grid%sh_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lh_urb2d) .GT. 1 ) THEN xv(1)=grid%lh_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%g_urb2d) .GT. 1 ) THEN xv(1)=grid%g_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rn_urb2d) .GT. 1 ) THEN xv(1)=grid%rn_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ts_urb2d) .GT. 1 ) THEN xv(1)=grid%ts_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%frc_urb2d) .GT. 1 ) THEN xv(1)=grid%frc_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%utype_urb2d) .GT. 1 ) THEN xv(1)=grid%utype_urb2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%imperv) .GT. 1 ) THEN xv(1)=grid%imperv(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%canfra) .GT. 1 ) THEN xv(1)=grid%canfra(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%var2d) .GT. 1 ) THEN xv(1)=grid%var2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oc12d) .GT. 1 ) THEN xv(1)=grid%oc12d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa1) .GT. 1 ) THEN xv(1)=grid%oa1(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa2) .GT. 1 ) THEN xv(1)=grid%oa2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa3) .GT. 1 ) THEN xv(1)=grid%oa3(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa4) .GT. 1 ) THEN xv(1)=grid%oa4(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol1) .GT. 1 ) THEN xv(1)=grid%ol1(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol2) .GT. 1 ) THEN xv(1)=grid%ol2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol3) .GT. 1 ) THEN xv(1)=grid%ol3(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol4) .GT. 1 ) THEN xv(1)=grid%ol4(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%var2dss) .GT. 1 ) THEN xv(1)=grid%var2dss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oc12dss) .GT. 1 ) THEN xv(1)=grid%oc12dss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa1ss) .GT. 1 ) THEN xv(1)=grid%oa1ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa2ss) .GT. 1 ) THEN xv(1)=grid%oa2ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa3ss) .GT. 1 ) THEN xv(1)=grid%oa3ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%oa4ss) .GT. 1 ) THEN xv(1)=grid%oa4ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol1ss) .GT. 1 ) THEN xv(1)=grid%ol1ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol2ss) .GT. 1 ) THEN xv(1)=grid%ol2ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol3ss) .GT. 1 ) THEN xv(1)=grid%ol3ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ol4ss) .GT. 1 ) THEN xv(1)=grid%ol4ss(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ctopo) .GT. 1 ) THEN xv(1)=grid%ctopo(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ctopo2) .GT. 1 ) THEN xv(1)=grid%ctopo2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%o3rad) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%o3rad(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_aerod DO k = ckds,(ckde-1) xv(k)= aerod(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%f_ice_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%f_ice_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%f_rain_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%f_rain_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%f_rimef_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%f_rimef_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%om_tmp) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_tmp(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_s) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_s(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_depth) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_depth(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_u) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_u(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_v) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_v(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_lat) .GT. 1 ) THEN xv(1)=grid%om_lat(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%om_lon) .GT. 1 ) THEN xv(1)=grid%om_lon(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%om_ml) .GT. 1 ) THEN xv(1)=grid%om_ml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%om_tini) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_tini(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_sini) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= grid%om_sini(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%h_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qv_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%qv_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qc_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%qc_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%msft) .GT. 1 ) THEN xv(1)=grid%msft(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfu) .GT. 1 ) THEN xv(1)=grid%msfu(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfv) .GT. 1 ) THEN xv(1)=grid%msfv(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msftx) .GT. 1 ) THEN xv(1)=grid%msftx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfty) .GT. 1 ) THEN xv(1)=grid%msfty(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfux) .GT. 1 ) THEN xv(1)=grid%msfux(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfuy) .GT. 1 ) THEN xv(1)=grid%msfuy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfvx) .GT. 1 ) THEN xv(1)=grid%msfvx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfvx_inv) .GT. 1 ) THEN xv(1)=grid%msfvx_inv(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%msfvy) .GT. 1 ) THEN xv(1)=grid%msfvy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%f) .GT. 1 ) THEN xv(1)=grid%f(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%e) .GT. 1 ) THEN xv(1)=grid%e(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sina) .GT. 1 ) THEN xv(1)=grid%sina(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%cosa) .GT. 1 ) THEN xv(1)=grid%cosa(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ht) .GT. 1 ) THEN xv(1)=grid%ht(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ht_shad) .GT. 1 ) THEN xv(1)=grid%ht_shad(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tsk) .GT. 1 ) THEN xv(1)=grid%tsk(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rainc) .GT. 1 ) THEN xv(1)=grid%rainc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rainsh) .GT. 1 ) THEN xv(1)=grid%rainsh(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rainnc) .GT. 1 ) THEN xv(1)=grid%rainnc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%frain) .GT. 1 ) THEN xv(1)=grid%frain(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_rainc) .GT. 1 ) THEN xv(1)=grid%i_rainc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_rainnc) .GT. 1 ) THEN xv(1)=grid%i_rainnc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snownc) .GT. 1 ) THEN xv(1)=grid%snownc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%graupelnc) .GT. 1 ) THEN xv(1)=grid%graupelnc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%hailnc) .GT. 1 ) THEN xv(1)=grid%hailnc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%refl_10cm(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%composite_refl_10cm) .GT. 1 ) THEN xv(1)=grid%composite_refl_10cm(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm_1km) .GT. 1 ) THEN xv(1)=grid%refl_10cm_1km(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm_4km) .GT. 1 ) THEN xv(1)=grid%refl_10cm_4km(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%th_old) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%th_old(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qv_old) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%qv_old(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%vmi3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%vmi3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%di3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%di3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%rhopo3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%rhopo3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%w_up) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%w_up(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%rthraten) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%rthraten(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%swdown) .GT. 1 ) THEN xv(1)=grid%swdown(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%gsw) .GT. 1 ) THEN xv(1)=grid%gsw(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%glw) .GT. 1 ) THEN xv(1)=grid%glw(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swnorm) .GT. 1 ) THEN xv(1)=grid%swnorm(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%diffuse_frac) .GT. 1 ) THEN xv(1)=grid%diffuse_frac(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddir) .GT. 1 ) THEN xv(1)=grid%swddir(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddni) .GT. 1 ) THEN xv(1)=grid%swddni(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddif) .GT. 1 ) THEN xv(1)=grid%swddif(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddnic) .GT. 1 ) THEN xv(1)=grid%swddnic(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddifc) .GT. 1 ) THEN xv(1)=grid%swddifc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%gx) .GT. 1 ) THEN xv(1)=grid%gx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%bx) .GT. 1 ) THEN xv(1)=grid%bx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%gg) .GT. 1 ) THEN xv(1)=grid%gg(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%bb) .GT. 1 ) THEN xv(1)=grid%bb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%coszen_ref) .GT. 1 ) THEN xv(1)=grid%coszen_ref(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swdown_ref) .GT. 1 ) THEN xv(1)=grid%swdown_ref(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swddir_ref) .GT. 1 ) THEN xv(1)=grid%swddir_ref(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswupt) .GT. 1 ) THEN xv(1)=grid%acswupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswuptc) .GT. 1 ) THEN xv(1)=grid%acswuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnt) .GT. 1 ) THEN xv(1)=grid%acswdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswdntc) .GT. 1 ) THEN xv(1)=grid%acswdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswupb) .GT. 1 ) THEN xv(1)=grid%acswupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswupbc) .GT. 1 ) THEN xv(1)=grid%acswupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnb) .GT. 1 ) THEN xv(1)=grid%acswdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnbc) .GT. 1 ) THEN xv(1)=grid%acswdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupt) .GT. 1 ) THEN xv(1)=grid%aclwupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwuptc) .GT. 1 ) THEN xv(1)=grid%aclwuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnt) .GT. 1 ) THEN xv(1)=grid%aclwdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdntc) .GT. 1 ) THEN xv(1)=grid%aclwdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupb) .GT. 1 ) THEN xv(1)=grid%aclwupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupbc) .GT. 1 ) THEN xv(1)=grid%aclwupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnb) .GT. 1 ) THEN xv(1)=grid%aclwdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnbc) .GT. 1 ) THEN xv(1)=grid%aclwdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupt) .GT. 1 ) THEN xv(1)=grid%i_acswupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswuptc) .GT. 1 ) THEN xv(1)=grid%i_acswuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnt) .GT. 1 ) THEN xv(1)=grid%i_acswdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdntc) .GT. 1 ) THEN xv(1)=grid%i_acswdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupb) .GT. 1 ) THEN xv(1)=grid%i_acswupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupbc) .GT. 1 ) THEN xv(1)=grid%i_acswupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnb) .GT. 1 ) THEN xv(1)=grid%i_acswdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnbc) .GT. 1 ) THEN xv(1)=grid%i_acswdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupt) .GT. 1 ) THEN xv(1)=grid%i_aclwupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwuptc) .GT. 1 ) THEN xv(1)=grid%i_aclwuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnt) .GT. 1 ) THEN xv(1)=grid%i_aclwdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdntc) .GT. 1 ) THEN xv(1)=grid%i_aclwdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupb) .GT. 1 ) THEN xv(1)=grid%i_aclwupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupbc) .GT. 1 ) THEN xv(1)=grid%i_aclwupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnb) .GT. 1 ) THEN xv(1)=grid%i_aclwdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnbc) .GT. 1 ) THEN xv(1)=grid%i_aclwdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swupt) .GT. 1 ) THEN xv(1)=grid%swupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swuptc) .GT. 1 ) THEN xv(1)=grid%swuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swdnt) .GT. 1 ) THEN xv(1)=grid%swdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swdntc) .GT. 1 ) THEN xv(1)=grid%swdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swupb) .GT. 1 ) THEN xv(1)=grid%swupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swupbc) .GT. 1 ) THEN xv(1)=grid%swupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swdnb) .GT. 1 ) THEN xv(1)=grid%swdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%swdnbc) .GT. 1 ) THEN xv(1)=grid%swdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwupt) .GT. 1 ) THEN xv(1)=grid%lwupt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwuptc) .GT. 1 ) THEN xv(1)=grid%lwuptc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnt) .GT. 1 ) THEN xv(1)=grid%lwdnt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwdntc) .GT. 1 ) THEN xv(1)=grid%lwdntc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwupb) .GT. 1 ) THEN xv(1)=grid%lwupb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwupbc) .GT. 1 ) THEN xv(1)=grid%lwupbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnb) .GT. 1 ) THEN xv(1)=grid%lwdnb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnbc) .GT. 1 ) THEN xv(1)=grid%lwdnbc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xlat_u) .GT. 1 ) THEN xv(1)=grid%xlat_u(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xlong_u) .GT. 1 ) THEN xv(1)=grid%xlong_u(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xlat_v) .GT. 1 ) THEN xv(1)=grid%xlat_v(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xlong_v) .GT. 1 ) THEN xv(1)=grid%xlong_v(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%clat) .GT. 1 ) THEN xv(1)=grid%clat(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%isnowxy) .GT. 1 ) THEN xv(1)=grid%isnowxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tvxy) .GT. 1 ) THEN xv(1)=grid%tvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tgxy) .GT. 1 ) THEN xv(1)=grid%tgxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%canicexy) .GT. 1 ) THEN xv(1)=grid%canicexy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%canliqxy) .GT. 1 ) THEN xv(1)=grid%canliqxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%eahxy) .GT. 1 ) THEN xv(1)=grid%eahxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tahxy) .GT. 1 ) THEN xv(1)=grid%tahxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%cmxy) .GT. 1 ) THEN xv(1)=grid%cmxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chxy) .GT. 1 ) THEN xv(1)=grid%chxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%fwetxy) .GT. 1 ) THEN xv(1)=grid%fwetxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sneqvoxy) .GT. 1 ) THEN xv(1)=grid%sneqvoxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%alboldxy) .GT. 1 ) THEN xv(1)=grid%alboldxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%qsnowxy) .GT. 1 ) THEN xv(1)=grid%qsnowxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%wslakexy) .GT. 1 ) THEN xv(1)=grid%wslakexy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%zwtxy) .GT. 1 ) THEN xv(1)=grid%zwtxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%waxy) .GT. 1 ) THEN xv(1)=grid%waxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%wtxy) .GT. 1 ) THEN xv(1)=grid%wtxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tsnoxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= grid%tsnoxy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%zsnsoxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snso_layers xv(k)= grid%zsnsoxy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_snso_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snicexy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= grid%snicexy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snliqxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= grid%snliqxy(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lfmassxy) .GT. 1 ) THEN xv(1)=grid%lfmassxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rtmassxy) .GT. 1 ) THEN xv(1)=grid%rtmassxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%stmassxy) .GT. 1 ) THEN xv(1)=grid%stmassxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%woodxy) .GT. 1 ) THEN xv(1)=grid%woodxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%stblcpxy) .GT. 1 ) THEN xv(1)=grid%stblcpxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%fastcpxy) .GT. 1 ) THEN xv(1)=grid%fastcpxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%xsaixy) .GT. 1 ) THEN xv(1)=grid%xsaixy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t2mvxy) .GT. 1 ) THEN xv(1)=grid%t2mvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t2mbxy) .GT. 1 ) THEN xv(1)=grid%t2mbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%q2mvxy) .GT. 1 ) THEN xv(1)=grid%q2mvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%q2mbxy) .GT. 1 ) THEN xv(1)=grid%q2mbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tradxy) .GT. 1 ) THEN xv(1)=grid%tradxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%neexy) .GT. 1 ) THEN xv(1)=grid%neexy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%gppxy) .GT. 1 ) THEN xv(1)=grid%gppxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%nppxy) .GT. 1 ) THEN xv(1)=grid%nppxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%fvegxy) .GT. 1 ) THEN xv(1)=grid%fvegxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%qinxy) .GT. 1 ) THEN xv(1)=grid%qinxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%runsfxy) .GT. 1 ) THEN xv(1)=grid%runsfxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%runsbxy) .GT. 1 ) THEN xv(1)=grid%runsbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ecanxy) .GT. 1 ) THEN xv(1)=grid%ecanxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%edirxy) .GT. 1 ) THEN xv(1)=grid%edirxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%etranxy) .GT. 1 ) THEN xv(1)=grid%etranxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%fsaxy) .GT. 1 ) THEN xv(1)=grid%fsaxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%firaxy) .GT. 1 ) THEN xv(1)=grid%firaxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aparxy) .GT. 1 ) THEN xv(1)=grid%aparxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%psnxy) .GT. 1 ) THEN xv(1)=grid%psnxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%savxy) .GT. 1 ) THEN xv(1)=grid%savxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sagxy) .GT. 1 ) THEN xv(1)=grid%sagxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rssunxy) .GT. 1 ) THEN xv(1)=grid%rssunxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rsshaxy) .GT. 1 ) THEN xv(1)=grid%rsshaxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%bgapxy) .GT. 1 ) THEN xv(1)=grid%bgapxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%wgapxy) .GT. 1 ) THEN xv(1)=grid%wgapxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tgvxy) .GT. 1 ) THEN xv(1)=grid%tgvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tgbxy) .GT. 1 ) THEN xv(1)=grid%tgbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chvxy) .GT. 1 ) THEN xv(1)=grid%chvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chbxy) .GT. 1 ) THEN xv(1)=grid%chbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%shgxy) .GT. 1 ) THEN xv(1)=grid%shgxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%shcxy) .GT. 1 ) THEN xv(1)=grid%shcxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%shbxy) .GT. 1 ) THEN xv(1)=grid%shbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%evgxy) .GT. 1 ) THEN xv(1)=grid%evgxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%evbxy) .GT. 1 ) THEN xv(1)=grid%evbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ghvxy) .GT. 1 ) THEN xv(1)=grid%ghvxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ghbxy) .GT. 1 ) THEN xv(1)=grid%ghbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%irgxy) .GT. 1 ) THEN xv(1)=grid%irgxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%ircxy) .GT. 1 ) THEN xv(1)=grid%ircxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%irbxy) .GT. 1 ) THEN xv(1)=grid%irbxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%trxy) .GT. 1 ) THEN xv(1)=grid%trxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%evcxy) .GT. 1 ) THEN xv(1)=grid%evcxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chleafxy) .GT. 1 ) THEN xv(1)=grid%chleafxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chucxy) .GT. 1 ) THEN xv(1)=grid%chucxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chv2xy) .GT. 1 ) THEN xv(1)=grid%chv2xy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chb2xy) .GT. 1 ) THEN xv(1)=grid%chb2xy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%chstarxy) .GT. 1 ) THEN xv(1)=grid%chstarxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%fdepthxy) .GT. 1 ) THEN xv(1)=grid%fdepthxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%eqzwt) .GT. 1 ) THEN xv(1)=grid%eqzwt(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rechclim) .GT. 1 ) THEN xv(1)=grid%rechclim(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%rivermask) .GT. 1 ) THEN xv(1)=grid%rivermask(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%riverbedxy) .GT. 1 ) THEN xv(1)=grid%riverbedxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%nonriverxy) .GT. 1 ) THEN xv(1)=grid%nonriverxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%grainxy) .GT. 1 ) THEN xv(1)=grid%grainxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%gddxy) .GT. 1 ) THEN xv(1)=grid%gddxy(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%croptype) .GT. 1 ) THEN DO k = 1,5 xv(k)= grid%croptype(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((5)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%planting) .GT. 1 ) THEN xv(1)=grid%planting(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%harvest) .GT. 1 ) THEN xv(1)=grid%harvest(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%season_gdd) .GT. 1 ) THEN xv(1)=grid%season_gdd(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tsk_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%tsk_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qsfc_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%qsfc_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tslb_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%tslb_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smois_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%smois_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh2o_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%sh2o_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%canwat_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%canwat_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snow_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%snow_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowh_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%snowh_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowc_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%snowc_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tr_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%tr_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tb_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%tb_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tg_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%tg_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%tc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%ts_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%ts_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%ts_rul2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%ts_rul2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%qc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%uc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= grid%uc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%trl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%trl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tbl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%tbl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tgl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= grid%tgl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%mosaic_cat_index) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= grid%mosaic_cat_index(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%landusef2) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= grid%landusef2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tmn) .GT. 1 ) THEN xv(1)=grid%tmn(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tyr) .GT. 1 ) THEN xv(1)=grid%tyr(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tyra) .GT. 1 ) THEN xv(1)=grid%tyra(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tdly) .GT. 1 ) THEN xv(1)=grid%tdly(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tlag) .GT. 1 ) THEN DO k = 1,config_flags%lagday xv(k)= grid%tlag(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%lagday)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%xland) .GT. 1 ) THEN xv(1)=grid%xland(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%achfx) .GT. 1 ) THEN xv(1)=grid%achfx(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%aclhf) .GT. 1 ) THEN xv(1)=grid%aclhf(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snowc) .GT. 1 ) THEN xv(1)=grid%snowc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_c) .GT. 1 ) THEN xv(1)=grid%prec_acc_c(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_c1) .GT. 1 ) THEN xv(1)=grid%prec_acc_c1(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_nc) .GT. 1 ) THEN xv(1)=grid%prec_acc_nc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_nc1) .GT. 1 ) THEN xv(1)=grid%prec_acc_nc1(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snow_acc_nc) .GT. 1 ) THEN xv(1)=grid%snow_acc_nc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snow_acc_nc1) .GT. 1 ) THEN xv(1)=grid%snow_acc_nc1(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tml) .GT. 1 ) THEN xv(1)=grid%tml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t0ml) .GT. 1 ) THEN xv(1)=grid%t0ml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%hml) .GT. 1 ) THEN xv(1)=grid%hml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%h0ml) .GT. 1 ) THEN xv(1)=grid%h0ml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%huml) .GT. 1 ) THEN xv(1)=grid%huml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%hvml) .GT. 1 ) THEN xv(1)=grid%hvml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%tmoml) .GT. 1 ) THEN xv(1)=grid%tmoml(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%erod) .GT. 1 ) THEN DO k = 1,config_flags%erosion_dim xv(k)= grid%erod(pig,pjg,k) ENDDO CALL rsl_lite_to_child_msg(((config_flags%erosion_dim)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qlsink) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%qlsink(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precr) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%precr(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%preci) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%preci(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precs) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%precs(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precg) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%precg(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem DO k = ckds,(ckde-1) xv(k)= chem(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer DO k = ckds,(ckde-1) xv(k)= tracer(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%vertstrucc) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%vertstrucc(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%vertstrucs) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%vertstrucs(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%field_sf) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_sf(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%field_pbl) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_pbl(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%field_conv) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_conv(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%ru_tendf_stoch) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%ru_tendf_stoch(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%rv_tendf_stoch) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%rv_tendf_stoch(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%rt_tendf_stoch) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%rt_tendf_stoch(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%rand_pert) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%rand_pert(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pattern_spp_conv) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%pattern_spp_conv(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pattern_spp_pbl) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%pattern_spp_pbl(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pattern_spp_mp) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%pattern_spp_mp(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pattern_spp_lsm) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%pattern_spp_lsm(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%rstoch) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%rstoch(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%numc) .GT. 1 ) THEN xv(1)=grid%numc(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%nump) .GT. 1 ) THEN xv(1)=grid%nump(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snl) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snl(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowdp) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowdp(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%wtc) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%wtc(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%wtp) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%wtp(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osno) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osno(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_grnd) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_grnd(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_veg) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_veg(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2ocan) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2ocan(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2ocan_col) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2ocan_col(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t2m_max) .GT. 1 ) THEN xv(1)=grid%t2m_max(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t2m_min) .GT. 1 ) THEN xv(1)=grid%t2m_min(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t2clm) .GT. 1 ) THEN xv(1)=grid%t2clm(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t_ref2m) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_ref2m(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq6(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq7(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq8(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq9(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_liq10(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice6(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice7(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice8(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice9(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_ice10(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno6(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno7(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno8(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno9(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_soisno10(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%dzsnow1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%dzsnow2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%dzsnow3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%dzsnow4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%dzsnow5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowrds1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowrds2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowrds3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowrds4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%snowrds5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake6(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake7(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake8(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake9(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%t_lake10(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol1(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol2(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol3(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol4(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol5(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol6(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol7(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol8(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol9(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%h2osoi_vol10(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%albedosubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%albedosubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lhsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%lhsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%hfxsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%hfxsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lwupsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%lwupsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%q2subgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%q2subgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sabvsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%sabvsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sabgsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%sabgsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%nrasubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%nrasubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%swupsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= grid%swupsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lakedepth2d) .GT. 1 ) THEN xv(1)=grid%lakedepth2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%savedtke12d) .GT. 1 ) THEN xv(1)=grid%savedtke12d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snowdp2d) .GT. 1 ) THEN xv(1)=grid%snowdp2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%h2osno2d) .GT. 1 ) THEN xv(1)=grid%h2osno2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%snl2d) .GT. 1 ) THEN xv(1)=grid%snl2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t_grnd2d) .GT. 1 ) THEN xv(1)=grid%t_grnd2d(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%t_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%t_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lake_icefrac3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%lake_icefrac3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%z_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%z_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dz_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%dz_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%t_soisno3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%h2osoi_ice3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%h2osoi_liq3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%h2osoi_vol3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%z3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%z3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dz3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= grid%dz3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%zi3d) .GT. 1 ) THEN DO k = 1,16 xv(k)= grid%zi3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((16)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%watsat3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%watsat3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%csol3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%csol3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tkmg3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%tkmg3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tkdry3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%tkdry3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tksatu3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= grid%tksatu3d(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%field_u_tend_perturb) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_u_tend_perturb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%field_v_tend_perturb) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_v_tend_perturb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%field_t_tend_perturb) .GT. 1 ) THEN DO k = 1,config_flags%num_stoch_levels xv(k)= grid%field_t_tend_perturb(pig,k,pjg) ENDDO CALL rsl_lite_to_child_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pcb) .GT. 1 ) THEN xv(1)=grid%pcb(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%pc_2) .GT. 1 ) THEN xv(1)=grid%pc_2(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%landmask) .GT. 1 ) THEN xv(1)=grid%landmask(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%lakemask) .GT. 1 ) THEN xv(1)=grid%lakemask(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF IF ( SIZE(grid%sst) .GT. 1 ) THEN xv(1)=grid%sst(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) ENDIF CALL rsl_lite_to_child_info( msize*4 & ,cips,cipe,cjps,cjpe & ,iids,iide,ijds,ijde & ,nids,nide,njds,njde & ,pgr , sw & ,nest_task_offsets(ngrid%id) & ,nest_pes_x(grid%id) & ,nest_pes_y(grid%id) & ,nest_pes_x(intermediate_grid%id) & ,nest_pes_y(intermediate_grid%id) & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) ENDDO END IF IF ( intercomm_active( grid%id ) ) THEN local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) ioffset = nest_task_offsets(ngrid%id) ELSE IF ( intercomm_active( ngrid%id ) ) THEN local_comm = mpi_comm_to_mom( ngrid%id ) ioffset = nest_task_offsets(ngrid%id) END IF IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN CALL mpi_comm_rank(local_comm,myproc,ierr) CALL mpi_comm_size(local_comm,nproc,ierr) CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & ioffset, local_comm ) END IF RETURN END SUBROUTINE interp_domain_em_part1 SUBROUTINE interp_domain_em_part2 ( grid, ngrid, pgrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & mytask, get_dm_max_halo_width, which_kid USE module_comm_nesting_dm, ONLY : halo_interp_down_sub IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: ngrid TYPE(domain), POINTER :: pgrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER myproc INTEGER ierr INTEGER thisdomain_max_halo_width REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n CALL get_ijk_from_grid ( pgrid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) nlev = ckde - ckds + 1 CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) CALL rsl_lite_from_parent_info(pig,pjg,retval) DO while ( retval .eq. 1 ) IF ( SIZE(grid%xlat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lu_index) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lu_index(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%max_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%min_p(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%u_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%u_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%v_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%v_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%w_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%w_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ph_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%ph_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%phb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%phb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%t_2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_init) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%t_init(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%mu_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%mu_2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%mub) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%mub(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%alb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%alb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%pb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%q2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%th2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%th2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%psfc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%psfc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%u10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%u10(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%v10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%v10(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lpi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lpi(pig,pjg) = xv(1) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) dfi_moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%qvold) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qvold(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qnwfa2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qnwfa2d(pig,pjg) = xv(1) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) dfi_scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%toposlpx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%toposlpx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%toposlpy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%toposlpy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%slope) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%slope(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%slp_azi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%slp_azi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shdmax) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shdmax(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shdmin) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shdmin(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%landusef) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%landusef(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%soilctop) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_cat grid%soilctop(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%soilcbot) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_cat grid%soilcbot(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tslb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tslb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smois) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smois(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh2o) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%sh2o(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smcrel) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smcrel(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%xice) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xice(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%icedepth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%icedepth(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xicem) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xicem(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%albsi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%albsi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowsi) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowsi(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%smstav) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%smstav(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sfcrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sfcrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%udrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%udrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ivgtyp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ivgtyp(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%isltyp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%isltyp(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%vegfra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%vegfra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acgrdflx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acgrdflx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acsnow) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acsnow(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acgraup) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acgraup(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acrunoff) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acrunoff(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acsnom) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acsnom(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acfrain) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acfrain(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowh) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowh(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canwat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canwat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sstsk) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sstsk(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lake_depth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lake_depth(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%uoce) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%uoce(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%voce) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%voce(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%uc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%uc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xxxc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xxxc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cmcr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cmcr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%drelg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%drelg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumr_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumb_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%flxhumg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%flxhumg_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgrl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tgrl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smr_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%smr_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%trl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%trl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tbl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tbl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tgl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_soil_layers grid%tgl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sh_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lh_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%g_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%g_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rn_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rn_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ts_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ts_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%frc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%frc_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%utype_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%utype_urb2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%imperv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%imperv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canfra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canfra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%var2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%var2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oc12d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oc12d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa3(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa4(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol3(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol4(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%var2dss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%var2dss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oc12dss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oc12dss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa1ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa1ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa2ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa2ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa3ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa3ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%oa4ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%oa4ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol1ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol1ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol2ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol2ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol3ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol3ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ol4ss) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ol4ss(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ctopo) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ctopo(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ctopo2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ctopo2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%o3rad) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%o3rad(pig,k,pjg) = xv(k) ENDDO ENDIF DO itrace = PARAM_FIRST_SCALAR, num_aerod CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) aerod(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%f_ice_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_ice_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%f_rain_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_rain_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%f_rimef_phy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%f_rimef_phy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_tmp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_tmp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_s) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_s(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_depth) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_depth(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_u(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_v(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_lat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_lat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_lon) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_lon(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%om_ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%om_tini) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_tini(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%om_sini) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) DO k = 1,config_flags%ocean_levels grid%om_sini(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%h_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qv_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qv_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qc_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qc_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%msft) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msft(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfu) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfu(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msftx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msftx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfty) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfty(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfux) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfux(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfuy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfuy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvx_inv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvx_inv(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%msfvy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%msfvy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%f) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%f(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%e) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%e(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sina) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sina(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cosa) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cosa(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ht) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ht(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ht_shad) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ht_shad(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsk) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tsk(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainsh) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainsh(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rainnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rainnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%frain) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%frain(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_rainc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_rainc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_rainnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_rainnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snownc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snownc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%graupelnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%graupelnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hailnc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hailnc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%refl_10cm(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%composite_refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%composite_refl_10cm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm_1km) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%refl_10cm_1km(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%refl_10cm_4km) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%refl_10cm_4km(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%th_old) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%th_old(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qv_old) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qv_old(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%vmi3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vmi3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%di3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%di3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rhopo3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%rhopo3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%w_up) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%w_up(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rthraten) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%rthraten(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%swdown) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdown(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gsw) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gsw(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%glw) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%glw(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swnorm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swnorm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%diffuse_frac) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%diffuse_frac(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddir) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddir(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddni) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddni(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddif) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddif(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddnic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddnic(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddifc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddifc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gg(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%coszen_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%coszen_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdown_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdown_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swddir_ref) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swddir_ref(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%acswdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_acswdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%i_aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%i_aclwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%swdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%swdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwuptc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwuptc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdntc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdntc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwupbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwupbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lwdnbc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlat_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat_u(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong_u) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong_u(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlat_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlat_v(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xlong_v) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xlong_v(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%clat) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%clat(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%isnowxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%isnowxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canicexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canicexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%canliqxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%canliqxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%eahxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%eahxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tahxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tahxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%cmxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%cmxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fwetxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fwetxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sneqvoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sneqvoxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%alboldxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%alboldxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qsnowxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qsnowxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wslakexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wslakexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%zwtxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%zwtxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%waxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%waxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wtxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wtxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsnoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%tsnoxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%zsnsoxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snso_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snso_layers grid%zsnsoxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snicexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%snicexy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snliqxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) DO k = 1,config_flags%num_snow_layers grid%snliqxy(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lfmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lfmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rtmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rtmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%stmassxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%stmassxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%woodxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%woodxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%stblcpxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%stblcpxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fastcpxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fastcpxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%xsaixy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xsaixy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2mvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2mbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%q2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2mvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%q2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%q2mbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tradxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tradxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%neexy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%neexy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gppxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gppxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nppxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nppxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fvegxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fvegxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%qinxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%qinxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%runsfxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%runsfxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%runsbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%runsbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ecanxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ecanxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%edirxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%edirxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%etranxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%etranxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fsaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fsaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%firaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%firaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aparxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aparxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%psnxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%psnxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%savxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%savxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sagxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sagxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rssunxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rssunxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rsshaxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rsshaxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%bgapxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%bgapxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%wgapxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%wgapxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tgbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tgbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shcxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shcxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%shbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%shbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ghvxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ghvxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ghbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ghbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%irgxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%irgxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%ircxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ircxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%irbxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%irbxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%trxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%trxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%evcxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%evcxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chleafxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chleafxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chucxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chucxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chv2xy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chv2xy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chb2xy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chb2xy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%chstarxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%chstarxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%fdepthxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%fdepthxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%eqzwt) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%eqzwt(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rechclim) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rechclim(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%rivermask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%rivermask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%riverbedxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%riverbedxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nonriverxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nonriverxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%grainxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%grainxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%gddxy) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%gddxy(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%croptype) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((5)-(1)+1)*4,xv) DO k = 1,5 grid%croptype(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%planting) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%planting(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%harvest) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%harvest(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%season_gdd) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%season_gdd(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tsk_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tsk_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qsfc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%qsfc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tslb_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tslb_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%smois_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%smois_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sh2o_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%sh2o_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%canwat_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%canwat_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snow_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snow_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowh_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snowh_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%snowc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tr_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tr_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tb_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tb_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tg_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tg_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%tc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ts_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%ts_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ts_rul2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%ts_rul2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%qc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%uc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat grid%uc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%trl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%trl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tbl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tbl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tgl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) DO k = 1,config_flags%mosaic_cat_soil grid%tgl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%mosaic_cat_index) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%mosaic_cat_index(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%landusef2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) DO k = 1,config_flags%num_land_cat grid%landusef2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tmn) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tmn(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tyr) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tyr(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tyra) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tyra(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tdly) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tdly(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tlag) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%lagday)-(1)+1)*4,xv) DO k = 1,config_flags%lagday grid%tlag(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%xland) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%xland(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%achfx) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%achfx(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%aclhf) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%aclhf(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_c) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_c(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_c1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_c1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_nc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%prec_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%prec_acc_nc1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow_acc_nc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snow_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snow_acc_nc1(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t0ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t0ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%h0ml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%h0ml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%huml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%huml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%hvml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%hvml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%tmoml) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%tmoml(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%erod) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%erosion_dim)-(1)+1)*4,xv) DO k = 1,config_flags%erosion_dim grid%erod(pig,pjg,k) = xv(k) ENDDO ENDIF IF ( SIZE(grid%qlsink) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%qlsink(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precr) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precr(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%preci) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%preci(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precs) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precs(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%precg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%precg(pig,k,pjg) = xv(k) ENDDO ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) chem(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) tracer(pig,k,pjg,itrace) = xv(k) ENDDO ENDDO IF ( SIZE(grid%vertstrucc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vertstrucc(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%vertstrucs) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%vertstrucs(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_sf) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_sf(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_pbl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_pbl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_conv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_conv(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%ru_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%ru_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rv_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rv_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rt_tendf_stoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rt_tendf_stoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rand_pert) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rand_pert(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_conv) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_conv(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_pbl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_pbl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_mp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_mp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pattern_spp_lsm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%pattern_spp_lsm(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%rstoch) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%rstoch(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%numc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%numc(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%nump) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%nump(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snl) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snl(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowdp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowdp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%wtc) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%wtc(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%wtp) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%wtp(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osno) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osno(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_grnd) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_grnd(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_veg) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_veg(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2ocan) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2ocan(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2ocan_col) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2ocan_col(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t2m_max) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2m_max(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2m_min) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2m_min(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t2clm) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t2clm(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_ref2m) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_ref2m(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_liq10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_ice10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno_s5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno_s5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_soisno10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dzsnow5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%dzsnow5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%snowrds5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%snowrds5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_lake10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%t_lake10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol1) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol1(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol2(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol3) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol3(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol4) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol4(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol5) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol5(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol6) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol6(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol7) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol7(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol8) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol8(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol9) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol9(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol10) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%h2osoi_vol10(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%albedosubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%albedosubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lhsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%lhsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%hfxsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%hfxsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lwupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%lwupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%q2subgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%q2subgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sabvsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%sabvsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%sabgsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%sabgsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%nrasubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%nrasubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%swupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) DO k = 1,config_flags%maxpatch grid%swupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lakedepth2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lakedepth2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%savedtke12d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%savedtke12d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snowdp2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snowdp2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%h2osno2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%h2osno2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%snl2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%snl2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_grnd2d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_grnd2d(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%t_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%t_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%lake_icefrac3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%lake_icefrac3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%z_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%z_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dz_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%dz_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%t_soisno3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%t_soisno3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_ice3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_ice3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_liq3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_liq3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%h2osoi_vol3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%h2osoi_vol3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%z3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%z3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%dz3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((15)-(1)+1)*4,xv) DO k = 1,15 grid%dz3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%zi3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((16)-(1)+1)*4,xv) DO k = 1,16 grid%zi3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%watsat3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%watsat3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%csol3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%csol3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tkmg3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tkmg3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tkdry3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tkdry3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%tksatu3d) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((10)-(1)+1)*4,xv) DO k = 1,10 grid%tksatu3d(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_u_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_u_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_v_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_v_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%field_t_tend_perturb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((config_flags%num_stoch_levels)-(1)+1)*4,xv) DO k = 1,config_flags%num_stoch_levels grid%field_t_tend_perturb(pig,k,pjg) = xv(k) ENDDO ENDIF IF ( SIZE(grid%pcb) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%pcb(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%pc_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%pc_2(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%landmask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%landmask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%lakemask) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%lakemask(pig,pjg) = xv(1) ENDIF IF ( SIZE(grid%sst) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%sst(pig,pjg) = xv(1) ENDIF CALL rsl_lite_from_parent_info(pig,pjg,retval) ENDDO if (ngrid%vert_refine_method .NE. 0) then hsca_m = 6.7 p_top_m = ngrid%p_top p_surf_m = 1.e5 mu_m = p_surf_m - p_top_m do k = 1,ckde pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) enddo do k = 1,ckde-1 pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) enddo alt_u_c(1) = alt_w_c(1) alt_u_c(ckde+1) = alt_w_c(ckde) do k = 1,nkde pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) enddo do k = 1,nkde-1 pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) enddo alt_u_n(1) = alt_w_n(1) alt_u_n(nkde+1) = alt_w_n(nkde) endif CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) if (ngrid%vert_refine_method .NE. 0) then IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%u_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%v_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting_w( & grid%w_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & alt_w_c, alt_w_n ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting_w( & grid%ph_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & alt_w_c, alt_w_n ) ENDIF IF ( SIZE( grid%phb, 1 ) * SIZE( grid%phb, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting_w( & grid%phb, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & alt_w_c, alt_w_n ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%t_2, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%t_init, 1 ) * SIZE( grid%t_init, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%t_init, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%alb, 1 ) * SIZE( grid%alb, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%alb, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%pb, 1 ) * SIZE( grid%pb, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%pb, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO IF ( SIZE( grid%qvold, 1 ) * SIZE( grid%qvold, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%qvold, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO IF ( SIZE( grid%o3rad, 1 ) * SIZE( grid%o3rad, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%o3rad, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_aerod IF ( SIZE( aerod, 1 ) * SIZE( aerod, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & aerod(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO IF ( SIZE( grid%f_ice_phy, 1 ) * SIZE( grid%f_ice_phy, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%f_ice_phy, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%f_rain_phy, 1 ) * SIZE( grid%f_rain_phy, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%f_rain_phy, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%f_rimef_phy, 1 ) * SIZE( grid%f_rimef_phy, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%f_rimef_phy, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%h_diabatic, 1 ) * SIZE( grid%h_diabatic, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%h_diabatic, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%qv_diabatic, 1 ) * SIZE( grid%qv_diabatic, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%qv_diabatic, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%qc_diabatic, 1 ) * SIZE( grid%qc_diabatic, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%qc_diabatic, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%refl_10cm, 1 ) * SIZE( grid%refl_10cm, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%refl_10cm, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%th_old, 1 ) * SIZE( grid%th_old, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%th_old, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%qv_old, 1 ) * SIZE( grid%qv_old, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%qv_old, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%vmi3d, 1 ) * SIZE( grid%vmi3d, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%vmi3d, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%di3d, 1 ) * SIZE( grid%di3d, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%di3d, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%rhopo3d, 1 ) * SIZE( grid%rhopo3d, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%rhopo3d, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%w_up, 1 ) * SIZE( grid%w_up, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%w_up, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%rthraten, 1 ) * SIZE( grid%rthraten, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%rthraten, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%qlsink, 1 ) * SIZE( grid%qlsink, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%qlsink, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%precr, 1 ) * SIZE( grid%precr, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%precr, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%preci, 1 ) * SIZE( grid%preci, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%preci, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%precs, 1 ) * SIZE( grid%precs, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%precs, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%precg, 1 ) * SIZE( grid%precg, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%precg, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF ENDDO IF ( SIZE( grid%vertstrucc, 1 ) * SIZE( grid%vertstrucc, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%vertstrucc, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF IF ( SIZE( grid%vertstrucs, 1 ) * SIZE( grid%vertstrucs, 3 ) .GT. 1 ) THEN CALL vert_interp_vert_nesting( & grid%vertstrucs, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n ) ENDIF CALL vert_interp_vert_nesting_1d ( & ngrid%t_base, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n) CALL vert_interp_vert_nesting_1d ( & ngrid%u_base, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n) CALL vert_interp_vert_nesting_1d ( & ngrid%v_base, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n) CALL vert_interp_vert_nesting_1d ( & ngrid%qv_base, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n) CALL vert_interp_vert_nesting_1d ( & ngrid%z_base, & ids, ide, kds, kde, jds, jde, & ims, ime, kms, kme, jms, jme, & ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & pgrid%s_vert, pgrid%e_vert, & pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & alt_u_c, alt_u_n) endif CALL push_communicators_for_domain( grid%id ) CALL HALO_INTERP_DOWN_sub ( grid, & config_flags, & num_moist, & moist, & num_dfi_moist, & dfi_moist, & num_scalar, & scalar, & num_dfi_scalar, & dfi_scalar, & num_aerod, & aerod, & num_chem, & chem, & num_tracer, & tracer, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL pop_communicators_for_domain IF ( SIZE( grid%xlat, 1 ) * SIZE( grid%xlat, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%xlat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong, 1 ) * SIZE( grid%xlong, 2 ) .GT. 1 ) THEN CALL interp_fcn_blint_ll ( & grid%xlong, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%xlat,ngrid%xlat& ,grid%input_from_file,ngrid%input_from_file& ) ENDIF IF ( SIZE( grid%lu_index, 1 ) * SIZE( grid%lu_index, 2 ) .GT. 1 ) THEN CALL interp_fcnm_lu ( & grid%lu_index, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lu_index, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%xlat,ngrid%xlat& ,grid%xlong,ngrid%xlong& ,grid%dx,ngrid%dx& ,grid%grid_id,ngrid%grid_id& ) ENDIF IF ( SIZE( grid%t_max_p, 1 ) * SIZE( grid%t_max_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%t_max_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t_max_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ght_max_p, 1 ) * SIZE( grid%ght_max_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ght_max_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ght_max_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%max_p, 1 ) * SIZE( grid%max_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%max_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%max_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_min_p, 1 ) * SIZE( grid%t_min_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%t_min_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t_min_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ght_min_p, 1 ) * SIZE( grid%ght_min_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ght_min_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ght_min_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%min_p, 1 ) * SIZE( grid%min_p, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%min_p, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%min_p, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%u_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%u_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%v_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%v_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%w_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%w_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ph_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%ph_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%phb, 1 ) * SIZE( grid%phb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%phb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%phb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%t_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%t_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_init, 1 ) * SIZE( grid%t_init, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%t_init, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%t_init, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mu_2, 1 ) * SIZE( grid%mu_2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%mu_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%mu_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mub, 1 ) * SIZE( grid%mub, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%mub, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%mub, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%alb, 1 ) * SIZE( grid%alb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%alb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%alb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pb, 1 ) * SIZE( grid%pb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%pb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%q2, 1 ) * SIZE( grid%q2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%q2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2, 1 ) * SIZE( grid%t2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%t2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%th2, 1 ) * SIZE( grid%th2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%th2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%th2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%psfc, 1 ) * SIZE( grid%psfc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%psfc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%psfc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%u10, 1 ) * SIZE( grid%u10, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%u10, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%u10, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%v10, 1 ) * SIZE( grid%v10, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%v10, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%v10, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lpi, 1 ) * SIZE( grid%lpi, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lpi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lpi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%qvold, 1 ) * SIZE( grid%qvold, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qvold, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qvold, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qnwfa2d, 1 ) * SIZE( grid%qnwfa2d, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qnwfa2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qnwfa2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%toposlpx, 1 ) * SIZE( grid%toposlpx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%toposlpx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%toposlpx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%toposlpy, 1 ) * SIZE( grid%toposlpy, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%toposlpy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%toposlpy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%slope, 1 ) * SIZE( grid%slope, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%slope, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%slope, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%slp_azi, 1 ) * SIZE( grid%slp_azi, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%slp_azi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%slp_azi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%shdmax , 1 )*SIZE( grid%shdmax , 2 ) .GT. 1 ), & grid%shdmax, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shdmax, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%shdmin , 1 )*SIZE( grid%shdmin , 2 ) .GT. 1 ), & grid%shdmin, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shdmin, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%landusef, 1 ) * SIZE( grid%landusef, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%landusef, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%landusef, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%soilctop, 1 ) * SIZE( grid%soilctop, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%soilctop, & cids, cide, 1, config_flags%num_soil_cat, cjds, cjde, & cims, cime, 1, config_flags%num_soil_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_cat, cjps, cjpe, & ngrid%soilctop, & nids, nide, 1, config_flags%num_soil_cat, njds, njde, & nims, nime, 1, config_flags%num_soil_cat, njms, njme, & nips, nipe, 1, config_flags%num_soil_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%soilcbot, 1 ) * SIZE( grid%soilcbot, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%soilcbot, & cids, cide, 1, config_flags%num_soil_cat, cjds, cjde, & cims, cime, 1, config_flags%num_soil_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_cat, cjps, cjpe, & ngrid%soilcbot, & nids, nide, 1, config_flags%num_soil_cat, njds, njde, & nims, nime, 1, config_flags%num_soil_cat, njms, njme, & nips, nipe, 1, config_flags%num_soil_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tslb , 1 )*SIZE( grid%tslb , 3 ) .GT. 1 ), & grid%tslb, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tslb, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%smois , 1 )*SIZE( grid%smois , 3 ) .GT. 1 ), & grid%smois, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smois, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sh2o , 1 )*SIZE( grid%sh2o , 3 ) .GT. 1 ), & grid%sh2o, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%sh2o, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%smcrel , 1 )*SIZE( grid%smcrel , 3 ) .GT. 1 ), & grid%smcrel, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smcrel, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xice , 1 )*SIZE( grid%xice , 2 ) .GT. 1 ), & grid%xice, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xice, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%isice,ngrid%isice& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%icedepth , 1 )*SIZE( grid%icedepth , 2 ) .GT. 1 ), & grid%icedepth, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%icedepth, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%isice,ngrid%isice& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xicem , 1 )*SIZE( grid%xicem , 2 ) .GT. 1 ), & grid%xicem, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xicem, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%isice,ngrid%isice& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%albsi , 1 )*SIZE( grid%albsi , 2 ) .GT. 1 ), & grid%albsi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%albsi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%isice,ngrid%isice& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowsi , 1 )*SIZE( grid%snowsi , 2 ) .GT. 1 ), & grid%snowsi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowsi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%isice,ngrid%isice& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%smstav , 1 )*SIZE( grid%smstav , 2 ) .GT. 1 ), & grid%smstav, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%smstav, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sfcrunoff , 1 )*SIZE( grid%sfcrunoff , 2 ) .GT. 1 ), & grid%sfcrunoff, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sfcrunoff, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%udrunoff , 1 )*SIZE( grid%udrunoff , 2 ) .GT. 1 ), & grid%udrunoff, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%udrunoff, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%ivgtyp, 1 ) * SIZE( grid%ivgtyp, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%ivgtyp, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ivgtyp, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_soil ( & ( SIZE( grid%isltyp , 1 )*SIZE( grid%isltyp , 2 ) .GT. 1 ), & grid%isltyp, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%isltyp, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%vegfra , 1 )*SIZE( grid%vegfra , 2 ) .GT. 1 ), & grid%vegfra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%vegfra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%acgrdflx, 1 ) * SIZE( grid%acgrdflx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acgrdflx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acgrdflx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%acsnow , 1 )*SIZE( grid%acsnow , 2 ) .GT. 1 ), & grid%acsnow, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acsnow, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%acgraup , 1 )*SIZE( grid%acgraup , 2 ) .GT. 1 ), & grid%acgraup, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acgraup, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%acrunoff , 1 )*SIZE( grid%acrunoff , 2 ) .GT. 1 ), & grid%acrunoff, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acrunoff, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%acsnom , 1 )*SIZE( grid%acsnom , 2 ) .GT. 1 ), & grid%acsnom, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acsnom, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%acfrain , 1 )*SIZE( grid%acfrain , 2 ) .GT. 1 ), & grid%acfrain, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acfrain, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snow , 1 )*SIZE( grid%snow , 2 ) .GT. 1 ), & grid%snow, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowh , 1 )*SIZE( grid%snowh , 2 ) .GT. 1 ), & grid%snowh, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowh, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%canwat , 1 )*SIZE( grid%canwat , 2 ) .GT. 1 ), & grid%canwat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canwat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sstsk , 1 )*SIZE( grid%sstsk , 2 ) .GT. 1 ), & grid%sstsk, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sstsk, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%lake_depth , 1 )*SIZE( grid%lake_depth , 2 ) .GT. 1 ), & grid%lake_depth, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lake_depth, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%uoce , 1 )*SIZE( grid%uoce , 2 ) .GT. 1 ), & grid%uoce, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%uoce, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%voce , 1 )*SIZE( grid%voce , 2 ) .GT. 1 ), & grid%voce, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%voce, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tr_urb2d , 1 )*SIZE( grid%tr_urb2d , 2 ) .GT. 1 ), & grid%tr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tgr_urb2d , 1 )*SIZE( grid%tgr_urb2d , 2 ) .GT. 1 ), & grid%tgr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tb_urb2d , 1 )*SIZE( grid%tb_urb2d , 2 ) .GT. 1 ), & grid%tb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tg_urb2d , 1 )*SIZE( grid%tg_urb2d , 2 ) .GT. 1 ), & grid%tg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tc_urb2d , 1 )*SIZE( grid%tc_urb2d , 2 ) .GT. 1 ), & grid%tc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%qc_urb2d , 1 )*SIZE( grid%qc_urb2d , 2 ) .GT. 1 ), & grid%qc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%uc_urb2d , 1 )*SIZE( grid%uc_urb2d , 2 ) .GT. 1 ), & grid%uc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%uc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xxxr_urb2d , 1 )*SIZE( grid%xxxr_urb2d , 2 ) .GT. 1 ), & grid%xxxr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xxxb_urb2d , 1 )*SIZE( grid%xxxb_urb2d , 2 ) .GT. 1 ), & grid%xxxb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xxxg_urb2d , 1 )*SIZE( grid%xxxg_urb2d , 2 ) .GT. 1 ), & grid%xxxg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xxxc_urb2d , 1 )*SIZE( grid%xxxc_urb2d , 2 ) .GT. 1 ), & grid%xxxc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%cmcr_urb2d , 1 )*SIZE( grid%cmcr_urb2d , 2 ) .GT. 1 ), & grid%cmcr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cmcr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%drelr_urb2d , 1 )*SIZE( grid%drelr_urb2d , 2 ) .GT. 1 ), & grid%drelr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%drelb_urb2d , 1 )*SIZE( grid%drelb_urb2d , 2 ) .GT. 1 ), & grid%drelb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%drelg_urb2d , 1 )*SIZE( grid%drelg_urb2d , 2 ) .GT. 1 ), & grid%drelg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%flxhumr_urb2d , 1 )*SIZE( grid%flxhumr_urb2d , 2 ) .GT. 1 ), & grid%flxhumr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%flxhumb_urb2d , 1 )*SIZE( grid%flxhumb_urb2d , 2 ) .GT. 1 ), & grid%flxhumb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%flxhumg_urb2d , 1 )*SIZE( grid%flxhumg_urb2d , 2 ) .GT. 1 ), & grid%flxhumg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tgrl_urb3d , 1 )*SIZE( grid%tgrl_urb3d , 3 ) .GT. 1 ), & grid%tgrl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tgrl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%smr_urb3d , 1 )*SIZE( grid%smr_urb3d , 3 ) .GT. 1 ), & grid%smr_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smr_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%trl_urb3d , 1 )*SIZE( grid%trl_urb3d , 3 ) .GT. 1 ), & grid%trl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%trl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tbl_urb3d , 1 )*SIZE( grid%tbl_urb3d , 3 ) .GT. 1 ), & grid%tbl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tbl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tgl_urb3d , 1 )*SIZE( grid%tgl_urb3d , 3 ) .GT. 1 ), & grid%tgl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tgl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%sh_urb2d, 1 ) * SIZE( grid%sh_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%sh_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sh_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lh_urb2d, 1 ) * SIZE( grid%lh_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%lh_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lh_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%g_urb2d, 1 ) * SIZE( grid%g_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%g_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%g_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rn_urb2d, 1 ) * SIZE( grid%rn_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%rn_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rn_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ts_urb2d, 1 ) * SIZE( grid%ts_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%ts_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ts_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%frc_urb2d, 1 ) * SIZE( grid%frc_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%frc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%frc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%utype_urb2d, 1 ) * SIZE( grid%utype_urb2d, 2 ) .GT. 1 ) THEN CALL interp_fcnm ( & grid%utype_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%utype_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%imperv , 1 )*SIZE( grid%imperv , 2 ) .GT. 1 ), & grid%imperv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%imperv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%canfra , 1 )*SIZE( grid%canfra , 2 ) .GT. 1 ), & grid%canfra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canfra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%var2d, 1 ) * SIZE( grid%var2d, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%var2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%var2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12d, 1 ) * SIZE( grid%oc12d, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oc12d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oc12d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1, 1 ) * SIZE( grid%oa1, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2, 1 ) * SIZE( grid%oa2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3, 1 ) * SIZE( grid%oa3, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa3, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4, 1 ) * SIZE( grid%oa4, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa4, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1, 1 ) * SIZE( grid%ol1, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2, 1 ) * SIZE( grid%ol2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3, 1 ) * SIZE( grid%ol3, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol3, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4, 1 ) * SIZE( grid%ol4, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol4, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%var2dss, 1 ) * SIZE( grid%var2dss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%var2dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%var2dss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12dss, 1 ) * SIZE( grid%oc12dss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oc12dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oc12dss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1ss, 1 ) * SIZE( grid%oa1ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa1ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2ss, 1 ) * SIZE( grid%oa2ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa2ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3ss, 1 ) * SIZE( grid%oa3ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa3ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4ss, 1 ) * SIZE( grid%oa4ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%oa4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa4ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1ss, 1 ) * SIZE( grid%ol1ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol1ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2ss, 1 ) * SIZE( grid%ol2ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol2ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3ss, 1 ) * SIZE( grid%ol3ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol3ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4ss, 1 ) * SIZE( grid%ol4ss, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ol4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol4ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ctopo, 1 ) * SIZE( grid%ctopo, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ctopo, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ctopo, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ctopo2, 1 ) * SIZE( grid%ctopo2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ctopo2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ctopo2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%o3rad, 1 ) * SIZE( grid%o3rad, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%o3rad, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%o3rad, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_aerod IF ( SIZE( aerod, 1 ) * SIZE( aerod, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & aerod(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%aerod(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%f_ice_phy, 1 ) * SIZE( grid%f_ice_phy, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%f_ice_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_ice_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f_rain_phy, 1 ) * SIZE( grid%f_rain_phy, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%f_rain_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_rain_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f_rimef_phy, 1 ) * SIZE( grid%f_rimef_phy, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%f_rimef_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_rimef_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_tmp, 1 ) * SIZE( grid%om_tmp, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_tmp, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_tmp, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_s, 1 ) * SIZE( grid%om_s, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_s, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_s, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_depth, 1 ) * SIZE( grid%om_depth, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_depth, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_depth, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_u, 1 ) * SIZE( grid%om_u, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_u, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_u, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_v, 1 ) * SIZE( grid%om_v, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_v, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_v, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_lat, 1 ) * SIZE( grid%om_lat, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_lat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%om_lat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_lon, 1 ) * SIZE( grid%om_lon, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_lon, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%om_lon, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_ml, 1 ) * SIZE( grid%om_ml, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%om_ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_tini, 1 ) * SIZE( grid%om_tini, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_tini, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_tini, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_sini, 1 ) * SIZE( grid%om_sini, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%om_sini, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_sini, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h_diabatic, 1 ) * SIZE( grid%h_diabatic, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%h_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%h_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qv_diabatic, 1 ) * SIZE( grid%qv_diabatic, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qv_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qv_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qc_diabatic, 1 ) * SIZE( grid%qc_diabatic, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qc_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qc_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msft, 1 ) * SIZE( grid%msft, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msft, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msft, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfu, 1 ) * SIZE( grid%msfu, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfu, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfu, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfv, 1 ) * SIZE( grid%msfv, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msftx, 1 ) * SIZE( grid%msftx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msftx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msftx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfty, 1 ) * SIZE( grid%msfty, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfty, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfty, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfux, 1 ) * SIZE( grid%msfux, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfux, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfux, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfuy, 1 ) * SIZE( grid%msfuy, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfuy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfuy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvx, 1 ) * SIZE( grid%msfvx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfvx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvx_inv, 1 ) * SIZE( grid%msfvx_inv, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfvx_inv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvx_inv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvy, 1 ) * SIZE( grid%msfvy, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%msfvy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f, 1 ) * SIZE( grid%f, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%f, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%f, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%e, 1 ) * SIZE( grid%e, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%e, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%e, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sina, 1 ) * SIZE( grid%sina, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%sina, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sina, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%cosa, 1 ) * SIZE( grid%cosa, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%cosa, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cosa, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ht, 1 ) * SIZE( grid%ht, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ht, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ht, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ht_shad, 1 ) * SIZE( grid%ht_shad, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ht_shad, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ht_shad, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tsk , 1 )*SIZE( grid%tsk , 2 ) .GT. 1 ), & grid%tsk, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tsk, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%rainc, 1 ) * SIZE( grid%rainc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rainc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rainsh, 1 ) * SIZE( grid%rainsh, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rainsh, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainsh, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rainnc, 1 ) * SIZE( grid%rainnc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rainnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%frain, 1 ) * SIZE( grid%frain, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%frain, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%frain, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_rainc, 1 ) * SIZE( grid%i_rainc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_rainc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_rainc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_rainnc, 1 ) * SIZE( grid%i_rainnc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_rainnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_rainnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snownc, 1 ) * SIZE( grid%snownc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%snownc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snownc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%graupelnc, 1 ) * SIZE( grid%graupelnc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%graupelnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%graupelnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%hailnc, 1 ) * SIZE( grid%hailnc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%hailnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hailnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm, 1 ) * SIZE( grid%refl_10cm, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%refl_10cm, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%refl_10cm, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%composite_refl_10cm, 1 ) * SIZE( grid%composite_refl_10cm, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%composite_refl_10cm, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%composite_refl_10cm, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm_1km, 1 ) * SIZE( grid%refl_10cm_1km, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%refl_10cm_1km, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%refl_10cm_1km, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm_4km, 1 ) * SIZE( grid%refl_10cm_4km, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%refl_10cm_4km, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%refl_10cm_4km, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%th_old, 1 ) * SIZE( grid%th_old, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%th_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%th_old, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qv_old, 1 ) * SIZE( grid%qv_old, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qv_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qv_old, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%vmi3d, 1 ) * SIZE( grid%vmi3d, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%vmi3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%vmi3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%di3d, 1 ) * SIZE( grid%di3d, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%di3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%di3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rhopo3d, 1 ) * SIZE( grid%rhopo3d, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rhopo3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%rhopo3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%w_up, 1 ) * SIZE( grid%w_up, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%w_up, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%w_up, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rthraten, 1 ) * SIZE( grid%rthraten, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rthraten, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%rthraten, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdown, 1 ) * SIZE( grid%swdown, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdown, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdown, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%gsw, 1 ) * SIZE( grid%gsw, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%gsw, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gsw, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%glw, 1 ) * SIZE( grid%glw, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%glw, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%glw, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swnorm, 1 ) * SIZE( grid%swnorm, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swnorm, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swnorm, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%diffuse_frac, 1 ) * SIZE( grid%diffuse_frac, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%diffuse_frac, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%diffuse_frac, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddir, 1 ) * SIZE( grid%swddir, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddir, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddir, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddni, 1 ) * SIZE( grid%swddni, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddni, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddni, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddif, 1 ) * SIZE( grid%swddif, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddif, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddif, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddnic, 1 ) * SIZE( grid%swddnic, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddnic, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddnic, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddifc, 1 ) * SIZE( grid%swddifc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddifc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddifc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%gx, 1 ) * SIZE( grid%gx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%gx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%bx, 1 ) * SIZE( grid%bx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%bx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%bx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%gg, 1 ) * SIZE( grid%gg, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%gg, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gg, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%bb, 1 ) * SIZE( grid%bb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%bb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%bb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%coszen_ref, 1 ) * SIZE( grid%coszen_ref, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%coszen_ref, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%coszen_ref, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdown_ref, 1 ) * SIZE( grid%swdown_ref, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdown_ref, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdown_ref, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swddir_ref, 1 ) * SIZE( grid%swddir_ref, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swddir_ref, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swddir_ref, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupt, 1 ) * SIZE( grid%acswupt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswuptc, 1 ) * SIZE( grid%acswuptc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnt, 1 ) * SIZE( grid%acswdnt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdntc, 1 ) * SIZE( grid%acswdntc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupb, 1 ) * SIZE( grid%acswupb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupbc, 1 ) * SIZE( grid%acswupbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnb, 1 ) * SIZE( grid%acswdnb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnbc, 1 ) * SIZE( grid%acswdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%acswdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupt, 1 ) * SIZE( grid%aclwupt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwuptc, 1 ) * SIZE( grid%aclwuptc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnt, 1 ) * SIZE( grid%aclwdnt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdntc, 1 ) * SIZE( grid%aclwdntc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupb, 1 ) * SIZE( grid%aclwupb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupbc, 1 ) * SIZE( grid%aclwupbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnb, 1 ) * SIZE( grid%aclwdnb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnbc, 1 ) * SIZE( grid%aclwdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupt, 1 ) * SIZE( grid%i_acswupt, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswuptc, 1 ) * SIZE( grid%i_acswuptc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnt, 1 ) * SIZE( grid%i_acswdnt, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdntc, 1 ) * SIZE( grid%i_acswdntc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupb, 1 ) * SIZE( grid%i_acswupb, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupbc, 1 ) * SIZE( grid%i_acswupbc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnb, 1 ) * SIZE( grid%i_acswdnb, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnbc, 1 ) * SIZE( grid%i_acswdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_acswdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupt, 1 ) * SIZE( grid%i_aclwupt, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwuptc, 1 ) * SIZE( grid%i_aclwuptc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnt, 1 ) * SIZE( grid%i_aclwdnt, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdntc, 1 ) * SIZE( grid%i_aclwdntc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupb, 1 ) * SIZE( grid%i_aclwupb, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupbc, 1 ) * SIZE( grid%i_aclwupbc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnb, 1 ) * SIZE( grid%i_aclwdnb, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnbc, 1 ) * SIZE( grid%i_aclwdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcni ( & grid%i_aclwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupt, 1 ) * SIZE( grid%swupt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swuptc, 1 ) * SIZE( grid%swuptc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnt, 1 ) * SIZE( grid%swdnt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdntc, 1 ) * SIZE( grid%swdntc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupb, 1 ) * SIZE( grid%swupb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupbc, 1 ) * SIZE( grid%swupbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnb, 1 ) * SIZE( grid%swdnb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnbc, 1 ) * SIZE( grid%swdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%swdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupt, 1 ) * SIZE( grid%lwupt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwuptc, 1 ) * SIZE( grid%lwuptc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnt, 1 ) * SIZE( grid%lwdnt, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdntc, 1 ) * SIZE( grid%lwdntc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupb, 1 ) * SIZE( grid%lwupb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupbc, 1 ) * SIZE( grid%lwupbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnb, 1 ) * SIZE( grid%lwdnb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnbc, 1 ) * SIZE( grid%lwdnbc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%lwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlat_u, 1 ) * SIZE( grid%xlat_u, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%xlat_u, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat_u, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong_u, 1 ) * SIZE( grid%xlong_u, 2 ) .GT. 1 ) THEN CALL interp_fcn_blint_ll ( & grid%xlong_u, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong_u, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%xlat_u,ngrid%xlat_u& ,grid%input_from_file,ngrid%input_from_file& ) ENDIF IF ( SIZE( grid%xlat_v, 1 ) * SIZE( grid%xlat_v, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%xlat_v, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat_v, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong_v, 1 ) * SIZE( grid%xlong_v, 2 ) .GT. 1 ) THEN CALL interp_fcn_blint_ll ( & grid%xlong_v, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong_v, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%xlat_v,ngrid%xlat_v& ,grid%input_from_file,ngrid%input_from_file& ) ENDIF IF ( SIZE( grid%clat, 1 ) * SIZE( grid%clat, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%clat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%clat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%isnowxy , 1 )*SIZE( grid%isnowxy , 2 ) .GT. 1 ), & grid%isnowxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%isnowxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tvxy , 1 )*SIZE( grid%tvxy , 2 ) .GT. 1 ), & grid%tvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tgxy , 1 )*SIZE( grid%tgxy , 2 ) .GT. 1 ), & grid%tgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%canicexy , 1 )*SIZE( grid%canicexy , 2 ) .GT. 1 ), & grid%canicexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canicexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%canliqxy , 1 )*SIZE( grid%canliqxy , 2 ) .GT. 1 ), & grid%canliqxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canliqxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%eahxy , 1 )*SIZE( grid%eahxy , 2 ) .GT. 1 ), & grid%eahxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%eahxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tahxy , 1 )*SIZE( grid%tahxy , 2 ) .GT. 1 ), & grid%tahxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tahxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%cmxy , 1 )*SIZE( grid%cmxy , 2 ) .GT. 1 ), & grid%cmxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cmxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chxy , 1 )*SIZE( grid%chxy , 2 ) .GT. 1 ), & grid%chxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%fwetxy , 1 )*SIZE( grid%fwetxy , 2 ) .GT. 1 ), & grid%fwetxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fwetxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sneqvoxy , 1 )*SIZE( grid%sneqvoxy , 2 ) .GT. 1 ), & grid%sneqvoxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sneqvoxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%alboldxy , 1 )*SIZE( grid%alboldxy , 2 ) .GT. 1 ), & grid%alboldxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%alboldxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%qsnowxy , 1 )*SIZE( grid%qsnowxy , 2 ) .GT. 1 ), & grid%qsnowxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qsnowxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%wslakexy , 1 )*SIZE( grid%wslakexy , 2 ) .GT. 1 ), & grid%wslakexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wslakexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%zwtxy , 1 )*SIZE( grid%zwtxy , 2 ) .GT. 1 ), & grid%zwtxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%zwtxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%waxy , 1 )*SIZE( grid%waxy , 2 ) .GT. 1 ), & grid%waxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%waxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%wtxy , 1 )*SIZE( grid%wtxy , 2 ) .GT. 1 ), & grid%wtxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wtxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tsnoxy , 1 )*SIZE( grid%tsnoxy , 3 ) .GT. 1 ), & grid%tsnoxy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%tsnoxy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%zsnsoxy , 1 )*SIZE( grid%zsnsoxy , 3 ) .GT. 1 ), & grid%zsnsoxy, & cids, cide, 1, config_flags%num_snso_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snso_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snso_layers, cjps, cjpe, & ngrid%zsnsoxy, & nids, nide, 1, config_flags%num_snso_layers, njds, njde, & nims, nime, 1, config_flags%num_snso_layers, njms, njme, & nips, nipe, 1, config_flags%num_snso_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snicexy , 1 )*SIZE( grid%snicexy , 3 ) .GT. 1 ), & grid%snicexy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%snicexy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snliqxy , 1 )*SIZE( grid%snliqxy , 3 ) .GT. 1 ), & grid%snliqxy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%snliqxy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%lfmassxy , 1 )*SIZE( grid%lfmassxy , 2 ) .GT. 1 ), & grid%lfmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lfmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%rtmassxy , 1 )*SIZE( grid%rtmassxy , 2 ) .GT. 1 ), & grid%rtmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rtmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%stmassxy , 1 )*SIZE( grid%stmassxy , 2 ) .GT. 1 ), & grid%stmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%stmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%woodxy , 1 )*SIZE( grid%woodxy , 2 ) .GT. 1 ), & grid%woodxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%woodxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%stblcpxy , 1 )*SIZE( grid%stblcpxy , 2 ) .GT. 1 ), & grid%stblcpxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%stblcpxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%fastcpxy , 1 )*SIZE( grid%fastcpxy , 2 ) .GT. 1 ), & grid%fastcpxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fastcpxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%xsaixy , 1 )*SIZE( grid%xsaixy , 2 ) .GT. 1 ), & grid%xsaixy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xsaixy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t2mvxy , 1 )*SIZE( grid%t2mvxy , 2 ) .GT. 1 ), & grid%t2mvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2mvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t2mbxy , 1 )*SIZE( grid%t2mbxy , 2 ) .GT. 1 ), & grid%t2mbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2mbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%q2mvxy , 1 )*SIZE( grid%q2mvxy , 2 ) .GT. 1 ), & grid%q2mvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2mvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%q2mbxy , 1 )*SIZE( grid%q2mbxy , 2 ) .GT. 1 ), & grid%q2mbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2mbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tradxy , 1 )*SIZE( grid%tradxy , 2 ) .GT. 1 ), & grid%tradxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tradxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%neexy , 1 )*SIZE( grid%neexy , 2 ) .GT. 1 ), & grid%neexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%neexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%gppxy , 1 )*SIZE( grid%gppxy , 2 ) .GT. 1 ), & grid%gppxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gppxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%nppxy , 1 )*SIZE( grid%nppxy , 2 ) .GT. 1 ), & grid%nppxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nppxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%fvegxy , 1 )*SIZE( grid%fvegxy , 2 ) .GT. 1 ), & grid%fvegxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fvegxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%qinxy , 1 )*SIZE( grid%qinxy , 2 ) .GT. 1 ), & grid%qinxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qinxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%runsfxy , 1 )*SIZE( grid%runsfxy , 2 ) .GT. 1 ), & grid%runsfxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%runsfxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%runsbxy , 1 )*SIZE( grid%runsbxy , 2 ) .GT. 1 ), & grid%runsbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%runsbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%ecanxy , 1 )*SIZE( grid%ecanxy , 2 ) .GT. 1 ), & grid%ecanxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ecanxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%edirxy , 1 )*SIZE( grid%edirxy , 2 ) .GT. 1 ), & grid%edirxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%edirxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%etranxy , 1 )*SIZE( grid%etranxy , 2 ) .GT. 1 ), & grid%etranxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%etranxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%fsaxy , 1 )*SIZE( grid%fsaxy , 2 ) .GT. 1 ), & grid%fsaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fsaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%firaxy , 1 )*SIZE( grid%firaxy , 2 ) .GT. 1 ), & grid%firaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%firaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%aparxy , 1 )*SIZE( grid%aparxy , 2 ) .GT. 1 ), & grid%aparxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aparxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%psnxy , 1 )*SIZE( grid%psnxy , 2 ) .GT. 1 ), & grid%psnxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%psnxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%savxy , 1 )*SIZE( grid%savxy , 2 ) .GT. 1 ), & grid%savxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%savxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sagxy , 1 )*SIZE( grid%sagxy , 2 ) .GT. 1 ), & grid%sagxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sagxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%rssunxy , 1 )*SIZE( grid%rssunxy , 2 ) .GT. 1 ), & grid%rssunxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rssunxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%rsshaxy , 1 )*SIZE( grid%rsshaxy , 2 ) .GT. 1 ), & grid%rsshaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rsshaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%bgapxy , 1 )*SIZE( grid%bgapxy , 2 ) .GT. 1 ), & grid%bgapxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%bgapxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%wgapxy , 1 )*SIZE( grid%wgapxy , 2 ) .GT. 1 ), & grid%wgapxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wgapxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tgvxy , 1 )*SIZE( grid%tgvxy , 2 ) .GT. 1 ), & grid%tgvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tgbxy , 1 )*SIZE( grid%tgbxy , 2 ) .GT. 1 ), & grid%tgbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chvxy , 1 )*SIZE( grid%chvxy , 2 ) .GT. 1 ), & grid%chvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chbxy , 1 )*SIZE( grid%chbxy , 2 ) .GT. 1 ), & grid%chbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%shgxy , 1 )*SIZE( grid%shgxy , 2 ) .GT. 1 ), & grid%shgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%shcxy , 1 )*SIZE( grid%shcxy , 2 ) .GT. 1 ), & grid%shcxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shcxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%shbxy , 1 )*SIZE( grid%shbxy , 2 ) .GT. 1 ), & grid%shbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%evgxy , 1 )*SIZE( grid%evgxy , 2 ) .GT. 1 ), & grid%evgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%evbxy , 1 )*SIZE( grid%evbxy , 2 ) .GT. 1 ), & grid%evbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%ghvxy , 1 )*SIZE( grid%ghvxy , 2 ) .GT. 1 ), & grid%ghvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ghvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%ghbxy , 1 )*SIZE( grid%ghbxy , 2 ) .GT. 1 ), & grid%ghbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ghbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%irgxy , 1 )*SIZE( grid%irgxy , 2 ) .GT. 1 ), & grid%irgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%irgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%ircxy , 1 )*SIZE( grid%ircxy , 2 ) .GT. 1 ), & grid%ircxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ircxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%irbxy , 1 )*SIZE( grid%irbxy , 2 ) .GT. 1 ), & grid%irbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%irbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%trxy , 1 )*SIZE( grid%trxy , 2 ) .GT. 1 ), & grid%trxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%trxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%evcxy , 1 )*SIZE( grid%evcxy , 2 ) .GT. 1 ), & grid%evcxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evcxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chleafxy , 1 )*SIZE( grid%chleafxy , 2 ) .GT. 1 ), & grid%chleafxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chleafxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chucxy , 1 )*SIZE( grid%chucxy , 2 ) .GT. 1 ), & grid%chucxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chucxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chv2xy , 1 )*SIZE( grid%chv2xy , 2 ) .GT. 1 ), & grid%chv2xy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chv2xy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chb2xy , 1 )*SIZE( grid%chb2xy , 2 ) .GT. 1 ), & grid%chb2xy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chb2xy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%chstarxy , 1 )*SIZE( grid%chstarxy , 2 ) .GT. 1 ), & grid%chstarxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chstarxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%fdepthxy , 1 )*SIZE( grid%fdepthxy , 2 ) .GT. 1 ), & grid%fdepthxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fdepthxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%eqzwt , 1 )*SIZE( grid%eqzwt , 2 ) .GT. 1 ), & grid%eqzwt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%eqzwt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%rechclim , 1 )*SIZE( grid%rechclim , 2 ) .GT. 1 ), & grid%rechclim, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rechclim, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%rivermask , 1 )*SIZE( grid%rivermask , 2 ) .GT. 1 ), & grid%rivermask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rivermask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%riverbedxy , 1 )*SIZE( grid%riverbedxy , 2 ) .GT. 1 ), & grid%riverbedxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%riverbedxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%nonriverxy , 1 )*SIZE( grid%nonriverxy , 2 ) .GT. 1 ), & grid%nonriverxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nonriverxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%grainxy , 1 )*SIZE( grid%grainxy , 2 ) .GT. 1 ), & grid%grainxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%grainxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%gddxy , 1 )*SIZE( grid%gddxy , 2 ) .GT. 1 ), & grid%gddxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gddxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%croptype , 1 )*SIZE( grid%croptype , 3 ) .GT. 1 ), & grid%croptype, & cids, cide, 1, 5, cjds, cjde, & cims, cime, 1, 5, cjms, cjme, & cips, cipe, 1, 5, cjps, cjpe, & ngrid%croptype, & nids, nide, 1, 5, njds, njde, & nims, nime, 1, 5, njms, njme, & nips, nipe, 1, 5, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%planting , 1 )*SIZE( grid%planting , 2 ) .GT. 1 ), & grid%planting, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%planting, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%harvest , 1 )*SIZE( grid%harvest , 2 ) .GT. 1 ), & grid%harvest, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%harvest, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%season_gdd , 1 )*SIZE( grid%season_gdd , 2 ) .GT. 1 ), & grid%season_gdd, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%season_gdd, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tsk_mosaic , 1 )*SIZE( grid%tsk_mosaic , 3 ) .GT. 1 ), & grid%tsk_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tsk_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%qsfc_mosaic , 1 )*SIZE( grid%qsfc_mosaic , 3 ) .GT. 1 ), & grid%qsfc_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%qsfc_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tslb_mosaic , 1 )*SIZE( grid%tslb_mosaic , 3 ) .GT. 1 ), & grid%tslb_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tslb_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%smois_mosaic , 1 )*SIZE( grid%smois_mosaic , 3 ) .GT. 1 ), & grid%smois_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%smois_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%sh2o_mosaic , 1 )*SIZE( grid%sh2o_mosaic , 3 ) .GT. 1 ), & grid%sh2o_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%sh2o_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%canwat_mosaic , 1 )*SIZE( grid%canwat_mosaic , 3 ) .GT. 1 ), & grid%canwat_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%canwat_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%snow_mosaic , 1 )*SIZE( grid%snow_mosaic , 3 ) .GT. 1 ), & grid%snow_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snow_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%snowh_mosaic , 1 )*SIZE( grid%snowh_mosaic , 3 ) .GT. 1 ), & grid%snowh_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snowh_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%snowc_mosaic , 1 )*SIZE( grid%snowc_mosaic , 3 ) .GT. 1 ), & grid%snowc_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snowc_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tr_urb2d_mosaic , 1 )*SIZE( grid%tr_urb2d_mosaic , 3 ) .GT. 1 ), & grid%tr_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tr_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tb_urb2d_mosaic , 1 )*SIZE( grid%tb_urb2d_mosaic , 3 ) .GT. 1 ), & grid%tb_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tb_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tg_urb2d_mosaic , 1 )*SIZE( grid%tg_urb2d_mosaic , 3 ) .GT. 1 ), & grid%tg_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tg_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tc_urb2d_mosaic , 1 )*SIZE( grid%tc_urb2d_mosaic , 3 ) .GT. 1 ), & grid%tc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%ts_urb2d_mosaic , 1 )*SIZE( grid%ts_urb2d_mosaic , 3 ) .GT. 1 ), & grid%ts_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%ts_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%ts_rul2d_mosaic , 1 )*SIZE( grid%ts_rul2d_mosaic , 3 ) .GT. 1 ), & grid%ts_rul2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%ts_rul2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%qc_urb2d_mosaic , 1 )*SIZE( grid%qc_urb2d_mosaic , 3 ) .GT. 1 ), & grid%qc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%qc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%uc_urb2d_mosaic , 1 )*SIZE( grid%uc_urb2d_mosaic , 3 ) .GT. 1 ), & grid%uc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%uc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%trl_urb3d_mosaic , 1 )*SIZE( grid%trl_urb3d_mosaic , 3 ) .GT. 1 ), & grid%trl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%trl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tbl_urb3d_mosaic , 1 )*SIZE( grid%tbl_urb3d_mosaic , 3 ) .GT. 1 ), & grid%tbl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tbl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%tgl_urb3d_mosaic , 1 )*SIZE( grid%tgl_urb3d_mosaic , 3 ) .GT. 1 ), & grid%tgl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tgl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_land_field ( & ( SIZE( grid%mosaic_cat_index , 1 )*SIZE( grid%mosaic_cat_index , 3 ) .GT. 1 ), & grid%mosaic_cat_index, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%mosaic_cat_index, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ) ENDIF IF ( SIZE( grid%landusef2, 1 ) * SIZE( grid%landusef2, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%landusef2, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%landusef2, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tmn , 1 )*SIZE( grid%tmn , 2 ) .GT. 1 ), & grid%tmn, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tmn, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tyr , 1 )*SIZE( grid%tyr , 2 ) .GT. 1 ), & grid%tyr, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tyr, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tyra , 1 )*SIZE( grid%tyra , 2 ) .GT. 1 ), & grid%tyra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tyra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tdly , 1 )*SIZE( grid%tdly , 2 ) .GT. 1 ), & grid%tdly, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tdly, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tlag , 1 )*SIZE( grid%tlag , 3 ) .GT. 1 ), & grid%tlag, & cids, cide, 1, config_flags%lagday, cjds, cjde, & cims, cime, 1, config_flags%lagday, cjms, cjme, & cips, cipe, 1, config_flags%lagday, cjps, cjpe, & ngrid%tlag, & nids, nide, 1, config_flags%lagday, njds, njde, & nims, nime, 1, config_flags%lagday, njms, njme, & nips, nipe, 1, config_flags%lagday, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%xland, 1 ) * SIZE( grid%xland, 2 ) .GT. 1 ) THEN CALL interp_fcnm_imask ( & grid%xland, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xland, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%achfx, 1 ) * SIZE( grid%achfx, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%achfx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%achfx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclhf, 1 ) * SIZE( grid%aclhf, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%aclhf, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclhf, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowc , 1 )*SIZE( grid%snowc , 2 ) .GT. 1 ), & grid%snowc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%prec_acc_c, 1 ) * SIZE( grid%prec_acc_c, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%prec_acc_c, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_c, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_c1, 1 ) * SIZE( grid%prec_acc_c1, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%prec_acc_c1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_c1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_nc, 1 ) * SIZE( grid%prec_acc_nc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%prec_acc_nc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_nc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_nc1, 1 ) * SIZE( grid%prec_acc_nc1, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%prec_acc_nc1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_nc1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow_acc_nc, 1 ) * SIZE( grid%snow_acc_nc, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%snow_acc_nc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow_acc_nc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow_acc_nc1, 1 ) * SIZE( grid%snow_acc_nc1, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%snow_acc_nc1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow_acc_nc1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tml , 1 )*SIZE( grid%tml , 2 ) .GT. 1 ), & grid%tml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t0ml , 1 )*SIZE( grid%t0ml , 2 ) .GT. 1 ), & grid%t0ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t0ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%hml , 1 )*SIZE( grid%hml , 2 ) .GT. 1 ), & grid%hml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h0ml , 1 )*SIZE( grid%h0ml , 2 ) .GT. 1 ), & grid%h0ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%h0ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%huml , 1 )*SIZE( grid%huml , 2 ) .GT. 1 ), & grid%huml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%huml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%hvml , 1 )*SIZE( grid%hvml , 2 ) .GT. 1 ), & grid%hvml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hvml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%tmoml , 1 )*SIZE( grid%tmoml , 2 ) .GT. 1 ), & grid%tmoml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tmoml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( SIZE( grid%erod, 1 ) * SIZE( grid%erod, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%erod, & cids, cide, 1, config_flags%erosion_dim, cjds, cjde, & cims, cime, 1, config_flags%erosion_dim, cjms, cjme, & cips, cipe, 1, config_flags%erosion_dim, cjps, cjpe, & ngrid%erod, & nids, nide, 1, config_flags%erosion_dim, njds, njde, & nims, nime, 1, config_flags%erosion_dim, njms, njme, & nips, nipe, 1, config_flags%erosion_dim, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qlsink, 1 ) * SIZE( grid%qlsink, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%qlsink, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qlsink, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precr, 1 ) * SIZE( grid%precr, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%precr, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precr, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%preci, 1 ) * SIZE( grid%preci, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%preci, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%preci, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precs, 1 ) * SIZE( grid%precs, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%precs, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precs, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precg, 1 ) * SIZE( grid%precg, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%precg, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precg, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%chem(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%tracer(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%vertstrucc, 1 ) * SIZE( grid%vertstrucc, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%vertstrucc, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%vertstrucc, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%vertstrucs, 1 ) * SIZE( grid%vertstrucs, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%vertstrucs, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%vertstrucs, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%field_sf, 1 ) * SIZE( grid%field_sf, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_sf, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_sf, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%field_pbl, 1 ) * SIZE( grid%field_pbl, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_pbl, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_pbl, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%field_conv, 1 ) * SIZE( grid%field_conv, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_conv, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_conv, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ru_tendf_stoch, 1 ) * SIZE( grid%ru_tendf_stoch, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%ru_tendf_stoch, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%ru_tendf_stoch, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rv_tendf_stoch, 1 ) * SIZE( grid%rv_tendf_stoch, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rv_tendf_stoch, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%rv_tendf_stoch, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rt_tendf_stoch, 1 ) * SIZE( grid%rt_tendf_stoch, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rt_tendf_stoch, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%rt_tendf_stoch, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rand_pert, 1 ) * SIZE( grid%rand_pert, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rand_pert, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%rand_pert, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pattern_spp_conv, 1 ) * SIZE( grid%pattern_spp_conv, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pattern_spp_conv, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%pattern_spp_conv, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pattern_spp_pbl, 1 ) * SIZE( grid%pattern_spp_pbl, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pattern_spp_pbl, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%pattern_spp_pbl, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pattern_spp_mp, 1 ) * SIZE( grid%pattern_spp_mp, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pattern_spp_mp, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%pattern_spp_mp, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pattern_spp_lsm, 1 ) * SIZE( grid%pattern_spp_lsm, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pattern_spp_lsm, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%pattern_spp_lsm, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rstoch, 1 ) * SIZE( grid%rstoch, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%rstoch, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%rstoch, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%numc , 1 )*SIZE( grid%numc , 2 ) .GT. 1 ), & grid%numc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%numc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%nump , 1 )*SIZE( grid%nump , 2 ) .GT. 1 ), & grid%nump, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nump, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snl , 1 )*SIZE( grid%snl , 3 ) .GT. 1 ), & grid%snl, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snl, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowdp , 1 )*SIZE( grid%snowdp , 3 ) .GT. 1 ), & grid%snowdp, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowdp, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%wtc , 1 )*SIZE( grid%wtc , 3 ) .GT. 1 ), & grid%wtc, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%wtc, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%wtp , 1 )*SIZE( grid%wtp , 3 ) .GT. 1 ), & grid%wtp, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%wtp, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osno , 1 )*SIZE( grid%h2osno , 3 ) .GT. 1 ), & grid%h2osno, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osno, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_grnd , 1 )*SIZE( grid%t_grnd , 3 ) .GT. 1 ), & grid%t_grnd, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_grnd, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_veg , 1 )*SIZE( grid%t_veg , 3 ) .GT. 1 ), & grid%t_veg, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_veg, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2ocan , 1 )*SIZE( grid%h2ocan , 3 ) .GT. 1 ), & grid%h2ocan, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2ocan, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2ocan_col , 1 )*SIZE( grid%h2ocan_col , 3 ) .GT. 1 ), & grid%h2ocan_col, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2ocan_col, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t2m_max , 1 )*SIZE( grid%t2m_max , 2 ) .GT. 1 ), & grid%t2m_max, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2m_max, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t2m_min , 1 )*SIZE( grid%t2m_min , 2 ) .GT. 1 ), & grid%t2m_min, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2m_min, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t2clm , 1 )*SIZE( grid%t2clm , 2 ) .GT. 1 ), & grid%t2clm, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2clm, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_ref2m , 1 )*SIZE( grid%t_ref2m , 3 ) .GT. 1 ), & grid%t_ref2m, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_ref2m, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq_s1 , 1 )*SIZE( grid%h2osoi_liq_s1 , 3 ) .GT. 1 ), & grid%h2osoi_liq_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq_s2 , 1 )*SIZE( grid%h2osoi_liq_s2 , 3 ) .GT. 1 ), & grid%h2osoi_liq_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq_s3 , 1 )*SIZE( grid%h2osoi_liq_s3 , 3 ) .GT. 1 ), & grid%h2osoi_liq_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq_s4 , 1 )*SIZE( grid%h2osoi_liq_s4 , 3 ) .GT. 1 ), & grid%h2osoi_liq_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq_s5 , 1 )*SIZE( grid%h2osoi_liq_s5 , 3 ) .GT. 1 ), & grid%h2osoi_liq_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq1 , 1 )*SIZE( grid%h2osoi_liq1 , 3 ) .GT. 1 ), & grid%h2osoi_liq1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq2 , 1 )*SIZE( grid%h2osoi_liq2 , 3 ) .GT. 1 ), & grid%h2osoi_liq2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq3 , 1 )*SIZE( grid%h2osoi_liq3 , 3 ) .GT. 1 ), & grid%h2osoi_liq3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq4 , 1 )*SIZE( grid%h2osoi_liq4 , 3 ) .GT. 1 ), & grid%h2osoi_liq4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq5 , 1 )*SIZE( grid%h2osoi_liq5 , 3 ) .GT. 1 ), & grid%h2osoi_liq5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq6 , 1 )*SIZE( grid%h2osoi_liq6 , 3 ) .GT. 1 ), & grid%h2osoi_liq6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq7 , 1 )*SIZE( grid%h2osoi_liq7 , 3 ) .GT. 1 ), & grid%h2osoi_liq7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq8 , 1 )*SIZE( grid%h2osoi_liq8 , 3 ) .GT. 1 ), & grid%h2osoi_liq8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq9 , 1 )*SIZE( grid%h2osoi_liq9 , 3 ) .GT. 1 ), & grid%h2osoi_liq9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_liq10 , 1 )*SIZE( grid%h2osoi_liq10 , 3 ) .GT. 1 ), & grid%h2osoi_liq10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice_s1 , 1 )*SIZE( grid%h2osoi_ice_s1 , 3 ) .GT. 1 ), & grid%h2osoi_ice_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice_s2 , 1 )*SIZE( grid%h2osoi_ice_s2 , 3 ) .GT. 1 ), & grid%h2osoi_ice_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice_s3 , 1 )*SIZE( grid%h2osoi_ice_s3 , 3 ) .GT. 1 ), & grid%h2osoi_ice_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice_s4 , 1 )*SIZE( grid%h2osoi_ice_s4 , 3 ) .GT. 1 ), & grid%h2osoi_ice_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice_s5 , 1 )*SIZE( grid%h2osoi_ice_s5 , 3 ) .GT. 1 ), & grid%h2osoi_ice_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice1 , 1 )*SIZE( grid%h2osoi_ice1 , 3 ) .GT. 1 ), & grid%h2osoi_ice1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice2 , 1 )*SIZE( grid%h2osoi_ice2 , 3 ) .GT. 1 ), & grid%h2osoi_ice2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice3 , 1 )*SIZE( grid%h2osoi_ice3 , 3 ) .GT. 1 ), & grid%h2osoi_ice3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice4 , 1 )*SIZE( grid%h2osoi_ice4 , 3 ) .GT. 1 ), & grid%h2osoi_ice4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice5 , 1 )*SIZE( grid%h2osoi_ice5 , 3 ) .GT. 1 ), & grid%h2osoi_ice5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice6 , 1 )*SIZE( grid%h2osoi_ice6 , 3 ) .GT. 1 ), & grid%h2osoi_ice6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice7 , 1 )*SIZE( grid%h2osoi_ice7 , 3 ) .GT. 1 ), & grid%h2osoi_ice7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice8 , 1 )*SIZE( grid%h2osoi_ice8 , 3 ) .GT. 1 ), & grid%h2osoi_ice8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice9 , 1 )*SIZE( grid%h2osoi_ice9 , 3 ) .GT. 1 ), & grid%h2osoi_ice9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_ice10 , 1 )*SIZE( grid%h2osoi_ice10 , 3 ) .GT. 1 ), & grid%h2osoi_ice10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno_s1 , 1 )*SIZE( grid%t_soisno_s1 , 3 ) .GT. 1 ), & grid%t_soisno_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno_s2 , 1 )*SIZE( grid%t_soisno_s2 , 3 ) .GT. 1 ), & grid%t_soisno_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno_s3 , 1 )*SIZE( grid%t_soisno_s3 , 3 ) .GT. 1 ), & grid%t_soisno_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno_s4 , 1 )*SIZE( grid%t_soisno_s4 , 3 ) .GT. 1 ), & grid%t_soisno_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno_s5 , 1 )*SIZE( grid%t_soisno_s5 , 3 ) .GT. 1 ), & grid%t_soisno_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno1 , 1 )*SIZE( grid%t_soisno1 , 3 ) .GT. 1 ), & grid%t_soisno1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno2 , 1 )*SIZE( grid%t_soisno2 , 3 ) .GT. 1 ), & grid%t_soisno2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno3 , 1 )*SIZE( grid%t_soisno3 , 3 ) .GT. 1 ), & grid%t_soisno3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno4 , 1 )*SIZE( grid%t_soisno4 , 3 ) .GT. 1 ), & grid%t_soisno4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno5 , 1 )*SIZE( grid%t_soisno5 , 3 ) .GT. 1 ), & grid%t_soisno5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno6 , 1 )*SIZE( grid%t_soisno6 , 3 ) .GT. 1 ), & grid%t_soisno6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno7 , 1 )*SIZE( grid%t_soisno7 , 3 ) .GT. 1 ), & grid%t_soisno7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno8 , 1 )*SIZE( grid%t_soisno8 , 3 ) .GT. 1 ), & grid%t_soisno8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno9 , 1 )*SIZE( grid%t_soisno9 , 3 ) .GT. 1 ), & grid%t_soisno9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_soisno10 , 1 )*SIZE( grid%t_soisno10 , 3 ) .GT. 1 ), & grid%t_soisno10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%dzsnow1 , 1 )*SIZE( grid%dzsnow1 , 3 ) .GT. 1 ), & grid%dzsnow1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%dzsnow2 , 1 )*SIZE( grid%dzsnow2 , 3 ) .GT. 1 ), & grid%dzsnow2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%dzsnow3 , 1 )*SIZE( grid%dzsnow3 , 3 ) .GT. 1 ), & grid%dzsnow3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%dzsnow4 , 1 )*SIZE( grid%dzsnow4 , 3 ) .GT. 1 ), & grid%dzsnow4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%dzsnow5 , 1 )*SIZE( grid%dzsnow5 , 3 ) .GT. 1 ), & grid%dzsnow5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowrds1 , 1 )*SIZE( grid%snowrds1 , 3 ) .GT. 1 ), & grid%snowrds1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowrds2 , 1 )*SIZE( grid%snowrds2 , 3 ) .GT. 1 ), & grid%snowrds2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowrds3 , 1 )*SIZE( grid%snowrds3 , 3 ) .GT. 1 ), & grid%snowrds3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowrds4 , 1 )*SIZE( grid%snowrds4 , 3 ) .GT. 1 ), & grid%snowrds4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%snowrds5 , 1 )*SIZE( grid%snowrds5 , 3 ) .GT. 1 ), & grid%snowrds5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake1 , 1 )*SIZE( grid%t_lake1 , 3 ) .GT. 1 ), & grid%t_lake1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake2 , 1 )*SIZE( grid%t_lake2 , 3 ) .GT. 1 ), & grid%t_lake2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake3 , 1 )*SIZE( grid%t_lake3 , 3 ) .GT. 1 ), & grid%t_lake3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake4 , 1 )*SIZE( grid%t_lake4 , 3 ) .GT. 1 ), & grid%t_lake4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake5 , 1 )*SIZE( grid%t_lake5 , 3 ) .GT. 1 ), & grid%t_lake5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake6 , 1 )*SIZE( grid%t_lake6 , 3 ) .GT. 1 ), & grid%t_lake6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake7 , 1 )*SIZE( grid%t_lake7 , 3 ) .GT. 1 ), & grid%t_lake7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake8 , 1 )*SIZE( grid%t_lake8 , 3 ) .GT. 1 ), & grid%t_lake8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake9 , 1 )*SIZE( grid%t_lake9 , 3 ) .GT. 1 ), & grid%t_lake9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%t_lake10 , 1 )*SIZE( grid%t_lake10 , 3 ) .GT. 1 ), & grid%t_lake10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol1 , 1 )*SIZE( grid%h2osoi_vol1 , 3 ) .GT. 1 ), & grid%h2osoi_vol1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol2 , 1 )*SIZE( grid%h2osoi_vol2 , 3 ) .GT. 1 ), & grid%h2osoi_vol2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol3 , 1 )*SIZE( grid%h2osoi_vol3 , 3 ) .GT. 1 ), & grid%h2osoi_vol3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol4 , 1 )*SIZE( grid%h2osoi_vol4 , 3 ) .GT. 1 ), & grid%h2osoi_vol4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol5 , 1 )*SIZE( grid%h2osoi_vol5 , 3 ) .GT. 1 ), & grid%h2osoi_vol5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol6 , 1 )*SIZE( grid%h2osoi_vol6 , 3 ) .GT. 1 ), & grid%h2osoi_vol6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol7 , 1 )*SIZE( grid%h2osoi_vol7 , 3 ) .GT. 1 ), & grid%h2osoi_vol7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol8 , 1 )*SIZE( grid%h2osoi_vol8 , 3 ) .GT. 1 ), & grid%h2osoi_vol8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol9 , 1 )*SIZE( grid%h2osoi_vol9 , 3 ) .GT. 1 ), & grid%h2osoi_vol9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%h2osoi_vol10 , 1 )*SIZE( grid%h2osoi_vol10 , 3 ) .GT. 1 ), & grid%h2osoi_vol10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%albedosubgrid , 1 )*SIZE( grid%albedosubgrid , 3 ) .GT. 1 ), & grid%albedosubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%albedosubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%lhsubgrid , 1 )*SIZE( grid%lhsubgrid , 3 ) .GT. 1 ), & grid%lhsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%lhsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%hfxsubgrid , 1 )*SIZE( grid%hfxsubgrid , 3 ) .GT. 1 ), & grid%hfxsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%hfxsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%lwupsubgrid , 1 )*SIZE( grid%lwupsubgrid , 3 ) .GT. 1 ), & grid%lwupsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%lwupsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%q2subgrid , 1 )*SIZE( grid%q2subgrid , 3 ) .GT. 1 ), & grid%q2subgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%q2subgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sabvsubgrid , 1 )*SIZE( grid%sabvsubgrid , 3 ) .GT. 1 ), & grid%sabvsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%sabvsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sabgsubgrid , 1 )*SIZE( grid%sabgsubgrid , 3 ) .GT. 1 ), & grid%sabgsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%sabgsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%nrasubgrid , 1 )*SIZE( grid%nrasubgrid , 3 ) .GT. 1 ), & grid%nrasubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%nrasubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%swupsubgrid , 1 )*SIZE( grid%swupsubgrid , 3 ) .GT. 1 ), & grid%swupsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%swupsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%lakedepth2d , 1 )*SIZE( grid%lakedepth2d , 2 ) .GT. 1 ), & grid%lakedepth2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lakedepth2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%savedtke12d , 1 )*SIZE( grid%savedtke12d , 2 ) .GT. 1 ), & grid%savedtke12d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%savedtke12d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%snowdp2d , 1 )*SIZE( grid%snowdp2d , 2 ) .GT. 1 ), & grid%snowdp2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowdp2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%h2osno2d , 1 )*SIZE( grid%h2osno2d , 2 ) .GT. 1 ), & grid%h2osno2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%h2osno2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%snl2d , 1 )*SIZE( grid%snl2d , 2 ) .GT. 1 ), & grid%snl2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snl2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%t_grnd2d , 1 )*SIZE( grid%t_grnd2d , 2 ) .GT. 1 ), & grid%t_grnd2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t_grnd2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%t_lake3d , 1 )*SIZE( grid%t_lake3d , 3 ) .GT. 1 ), & grid%t_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%t_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%lake_icefrac3d , 1 )*SIZE( grid%lake_icefrac3d , 3 ) .GT. 1 ), & grid%lake_icefrac3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%lake_icefrac3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%z_lake3d , 1 )*SIZE( grid%z_lake3d , 3 ) .GT. 1 ), & grid%z_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%z_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%dz_lake3d , 1 )*SIZE( grid%dz_lake3d , 3 ) .GT. 1 ), & grid%dz_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%dz_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%t_soisno3d , 1 )*SIZE( grid%t_soisno3d , 3 ) .GT. 1 ), & grid%t_soisno3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%t_soisno3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%h2osoi_ice3d , 1 )*SIZE( grid%h2osoi_ice3d , 3 ) .GT. 1 ), & grid%h2osoi_ice3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_ice3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%h2osoi_liq3d , 1 )*SIZE( grid%h2osoi_liq3d , 3 ) .GT. 1 ), & grid%h2osoi_liq3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_liq3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%h2osoi_vol3d , 1 )*SIZE( grid%h2osoi_vol3d , 3 ) .GT. 1 ), & grid%h2osoi_vol3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_vol3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%z3d , 1 )*SIZE( grid%z3d , 3 ) .GT. 1 ), & grid%z3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%z3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%dz3d , 1 )*SIZE( grid%dz3d , 3 ) .GT. 1 ), & grid%dz3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%dz3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%zi3d , 1 )*SIZE( grid%zi3d , 3 ) .GT. 1 ), & grid%zi3d, & cids, cide, 1, 16, cjds, cjde, & cims, cime, 1, 16, cjms, cjme, & cips, cipe, 1, 16, cjps, cjpe, & ngrid%zi3d, & nids, nide, 1, 16, njds, njde, & nims, nime, 1, 16, njms, njme, & nips, nipe, 1, 16, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%watsat3d , 1 )*SIZE( grid%watsat3d , 3 ) .GT. 1 ), & grid%watsat3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%watsat3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%csol3d , 1 )*SIZE( grid%csol3d , 3 ) .GT. 1 ), & grid%csol3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%csol3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%tkmg3d , 1 )*SIZE( grid%tkmg3d , 3 ) .GT. 1 ), & grid%tkmg3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tkmg3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%tkdry3d , 1 )*SIZE( grid%tkdry3d , 3 ) .GT. 1 ), & grid%tkdry3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tkdry3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_water_field ( & ( SIZE( grid%tksatu3d , 1 )*SIZE( grid%tksatu3d , 3 ) .GT. 1 ), & grid%tksatu3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tksatu3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%islake,ngrid%islake& ) ENDIF IF ( SIZE( grid%field_u_tend_perturb, 1 ) * SIZE( grid%field_u_tend_perturb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_u_tend_perturb, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_u_tend_perturb, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%field_v_tend_perturb, 1 ) * SIZE( grid%field_v_tend_perturb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_v_tend_perturb, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_v_tend_perturb, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%field_t_tend_perturb, 1 ) * SIZE( grid%field_t_tend_perturb, 3 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%field_t_tend_perturb, & cids, cide, 1, config_flags%num_stoch_levels, cjds, cjde, & cims, cime, 1, config_flags%num_stoch_levels, cjms, cjme, & cips, cipe, 1, config_flags%num_stoch_levels, cjps, cjpe, & ngrid%field_t_tend_perturb, & nids, nide, 1, config_flags%num_stoch_levels, njds, njde, & nims, nime, 1, config_flags%num_stoch_levels, njms, njme, & nips, nipe, 1, config_flags%num_stoch_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pcb, 1 ) * SIZE( grid%pcb, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pcb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%pcb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pc_2, 1 ) * SIZE( grid%pc_2, 2 ) .GT. 1 ) THEN CALL interp_fcn ( & grid%pc_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%pc_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%landmask, 1 ) * SIZE( grid%landmask, 2 ) .GT. 1 ) THEN CALL interp_fcnm_imask ( & grid%landmask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%landmask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lakemask, 1 ) * SIZE( grid%lakemask, 2 ) .GT. 1 ) THEN CALL interp_fcnm_imask ( & grid%lakemask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lakemask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( .TRUE. ) THEN CALL interp_mask_field ( & ( SIZE( grid%sst , 1 )*SIZE( grid%sst , 2 ) .GT. 1 ), & grid%sst, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sst, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ,grid%lu_index,ngrid%lu_index& ,grid%iswater,ngrid%iswater& ) ENDIF RETURN END SUBROUTINE interp_domain_em_part2 SUBROUTINE interp_domain_em_small_part1 ( grid, intermediate_grid, ngrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_comm_dm, ONLY: halo_em_horiz_interp_sub USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & mytask, get_dm_max_halo_width, & nest_task_offsets, mpi_comm_to_kid, mpi_comm_to_mom, & which_kid, nest_pes_x, nest_pes_y, intercomm_active USE module_timing IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: intermediate_grid TYPE(domain), POINTER :: ngrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k INTEGER iparstrt,jparstrt,sw TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & iims, iime, ijms, ijme, ikms, ikme, & iips, iipe, ijps, ijpe, ikps, ikpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr INTEGER thisdomain_max_halo_width INTEGER local_comm, myproc, nproc INTEGER ioffset CALL wrf_get_dm_communicator ( local_comm ) CALL wrf_get_myproc( myproc ) CALL wrf_get_nproc( nproc ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL HALO_EM_HORIZ_INTERP_sub ( grid, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( intermediate_grid , & iids, iide, ijds, ijde, ikds, ikde, & iims, iime, ijms, ijme, ikms, ikme, & iips, iipe, ijps, ijpe, ikps, ikpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) CALL nl_get_shw ( intermediate_grid%id, sw ) icoord = iparstrt - sw jcoord = jparstrt - sw idim_cd = iide - iids + 1 jdim_cd = ijde - ijds + 1 nlev = ckde - ckds + 1 CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) msize = ( 2 )* nlev + 7 CALL rsl_lite_to_child_info( local_communicator, msize*4 & ,cips,cipe,cjps,cjpe & ,iids,iide,ijds,ijde & ,nids,nide,njds,njde & ,pgr , sw & ,ntasks_x,ntasks_y & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) DO while ( retval .eq. 1 ) IF ( SIZE(grid%ph_2) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= grid%ph_2(pig,k,pjg) END DO CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*4,xv) END IF IF ( SIZE(grid%t_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= grid%t_2(pig,k,pjg) END DO CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*4,xv) END IF IF ( SIZE(grid%ht) .GT. 1 ) THEN xv(1)= grid%ht(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN xv(1)= grid%t_max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN xv(1)= grid%ght_max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%max_p) .GT. 1 ) THEN xv(1)= grid%max_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN xv(1)= grid%t_min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN xv(1)= grid%ght_min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF IF ( SIZE(grid%min_p) .GT. 1 ) THEN xv(1)= grid%min_p(pig,pjg) CALL rsl_lite_to_child_msg(4,xv) END IF CALL rsl_lite_to_child_info( local_communicator, msize*4 & ,cips,cipe,cjps,cjpe & ,iids,iide,ijds,ijde & ,nids,nide,njds,njde & ,pgr , sw & ,ntasks_x,ntasks_y & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) END DO IF ( intercomm_active( grid%id ) ) THEN local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) ioffset = nest_task_offsets(ngrid%id) ELSE IF ( intercomm_active( ngrid%id ) ) THEN local_comm = mpi_comm_to_mom( ngrid%id ) ioffset = nest_task_offsets(ngrid%id) END IF CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & ioffset, local_comm ) RETURN END SUBROUTINE interp_domain_em_small_part1 SUBROUTINE interp_domain_em_small_part2 ( grid, ngrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & mytask, get_dm_max_halo_width USE module_comm_nesting_dm, ONLY : halo_interp_down_sub IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: ngrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER myproc INTEGER ierr INTEGER thisdomain_max_halo_width CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) nlev = ckde - ckds + 1 CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) CALL rsl_lite_from_parent_info(pig,pjg,retval) DO while ( retval .eq. 1 ) IF ( SIZE(grid%ph_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*4,xv) DO k = ckds,ckde grid%ph_2(pig,k,pjg) = xv(k) END DO END IF IF ( SIZE(grid%t_2) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*4,xv) DO k = ckds,(ckde-1) grid%t_2(pig,k,pjg) = xv(k) END DO END IF IF ( SIZE(grid%ht) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ht(pig,pjg) = xv(1) END IF IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_max_p(pig,pjg) = xv(1) END IF IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_max_p(pig,pjg) = xv(1) END IF IF ( SIZE(grid%max_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%max_p(pig,pjg) = xv(1) END IF IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%t_min_p(pig,pjg) = xv(1) END IF IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%ght_min_p(pig,pjg) = xv(1) END IF IF ( SIZE(grid%min_p) .GT. 1 ) THEN CALL rsl_lite_from_parent_msg(4,xv) grid%min_p(pig,pjg) = xv(1) END IF CALL rsl_lite_from_parent_info(pig,pjg,retval) END DO CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL HALO_INTERP_DOWN_sub ( grid, & config_flags, & num_moist, & moist, & num_dfi_moist, & dfi_moist, & num_scalar, & scalar, & num_dfi_scalar, & dfi_scalar, & num_aerod, & aerod, & num_chem, & chem, & num_tracer, & tracer, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL interp_fcn_bl ( grid%ph_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%ph_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & grid%ht, ngrid%ht, & grid%t_max_p, ngrid%t_max_p, & grid%ght_max_p, ngrid%ght_max_p, & grid%max_p, ngrid%max_p, & grid%t_min_p, ngrid%t_min_p, & grid%ght_min_p, ngrid%ght_min_p, & grid%min_p, ngrid%min_p, & ngrid%znw, ngrid%p_top ) CALL interp_fcn_bl ( grid%t_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%t_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & grid%ht, ngrid%ht, & grid%t_max_p, ngrid%t_max_p, & grid%ght_max_p, ngrid%ght_max_p, & grid%max_p, ngrid%max_p, & grid%t_min_p, ngrid%t_min_p, & grid%ght_min_p, ngrid%ght_min_p, & grid%min_p, ngrid%min_p, & ngrid%znu, ngrid%p_top ) RETURN END SUBROUTINE interp_domain_em_small_part2 SUBROUTINE feedback_nest_prep ( grid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask USE module_comm_nesting_dm, ONLY : halo_interp_up_sub IMPLICIT NONE TYPE(domain), TARGET :: grid TYPE (grid_config_rec_type) :: config_flags real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER :: idum1, idum2 CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) IF ( grid%active_this_task ) THEN CALL push_communicators_for_domain( grid%id ) CALL HALO_INTERP_UP_sub ( grid, & config_flags, & num_moist, & moist, & num_dfi_moist, & dfi_moist, & num_scalar, & scalar, & num_dfi_scalar, & dfi_scalar, & num_chem, & chem, & num_tracer, & tracer, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL pop_communicators_for_domain END IF END SUBROUTINE feedback_nest_prep SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & ipe_save, jpe_save, ips_save, jps_save, & nest_pes_x, nest_pes_y IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: ngrid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k TYPE(domain), POINTER :: xgrid TYPE (grid_config_rec_type) :: config_flags, nconfig_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER local_comm, myproc, nproc, idum1, idum2 INTEGER thisdomain_max_halo_width integer tjk INTERFACE SUBROUTINE feedback_nest_prep ( grid, config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain USE module_configure, ONLY : grid_config_rec_type TYPE (grid_config_rec_type) :: config_flags TYPE(domain), TARGET :: grid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij END SUBROUTINE feedback_nest_prep END INTERFACE CALL wrf_get_dm_communicator ( local_comm ) CALL wrf_get_myproc( myproc ) CALL wrf_get_nproc( nproc ) CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( ngrid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) nlev = ckde - ckds + 1 ips_save = ngrid%i_parent_start jps_save = ngrid%j_parent_start ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1 jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1 CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags ) CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 ) xgrid => grid grid => ngrid CALL feedback_nest_prep ( grid, nconfig_flags & ,grid%moist,grid%moist_bxs,grid%moist_bxe,grid%moist_bys,grid%moist_bye,grid%moist_btxs,grid%moist_btxe,grid%moist_btys, & grid%moist_btye,grid%dfi_moist,grid%dfi_moist_bxs,grid%dfi_moist_bxe,grid%dfi_moist_bys,grid%dfi_moist_bye,grid%dfi_moist_btxs, & grid%dfi_moist_btxe,grid%dfi_moist_btys,grid%dfi_moist_btye,grid%scalar,grid%scalar_bxs,grid%scalar_bxe,grid%scalar_bys, & grid%scalar_bye,grid%scalar_btxs,grid%scalar_btxe,grid%scalar_btys,grid%scalar_btye,grid%dfi_scalar,grid%dfi_scalar_bxs, & grid%dfi_scalar_bxe,grid%dfi_scalar_bys,grid%dfi_scalar_bye,grid%dfi_scalar_btxs,grid%dfi_scalar_btxe,grid%dfi_scalar_btys, & grid%dfi_scalar_btye,grid%aerod,grid%ozmixm,grid%aerosolc_1,grid%aerosolc_2,grid%fdda3d,grid%fdda2d,grid%advh_t,grid%advz_t, & grid%emis_ant,grid%emis_dust,grid%emis_seas,grid%emis_seas2,grid%emis_vol,grid%ebu,grid%ebu_in,grid%emis_aircraft,grid%ext_coef, & grid%bscat_coef,grid%asym_par,grid%conv_ct,grid%chem_ct,grid%vmix_ct,grid%advh_ct,grid%advz_ct,grid%dvel,grid%vprm_in, & grid%wet_in,grid%chem,grid%chem_bxs,grid%chem_bxe,grid%chem_bys,grid%chem_bye,grid%chem_btxs,grid%chem_btxe,grid%chem_btys, & grid%chem_btye,grid%tracer,grid%tracer_bxs,grid%tracer_bxe,grid%tracer_bys,grid%tracer_bye,grid%tracer_btxs,grid%tracer_btxe, & grid%tracer_btys,grid%tracer_btye,grid%nba_mij,grid%nba_rij & ) grid => xgrid CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 ) IF ( SIZE( grid%xlat, 1 ) * SIZE( grid%xlat, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong, 1 ) * SIZE( grid%xlong, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlong, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lu_index, 1 ) * SIZE( grid%lu_index, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lu_index, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lu_index, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%u_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%u_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%v_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%v_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%w_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%w_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ph_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%ph_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%phb, 1 ) * SIZE( grid%phb, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%phb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & ngrid%phb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%t_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%t_2, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mu_2, 1 ) * SIZE( grid%mu_2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%mu_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%mu_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mub, 1 ) * SIZE( grid%mub, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%mub, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%mub, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nest_pos, 1 ) * SIZE( grid%nest_pos, 2 ) .GT. 1 ) THEN CALL mark_domain ( & grid%nest_pos, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nest_pos, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nest_mask, 1 ) * SIZE( grid%nest_mask, 2 ) .GT. 1 ) THEN CALL mark_domain ( & grid%nest_mask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nest_mask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%alb, 1 ) * SIZE( grid%alb, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%alb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%alb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pb, 1 ) * SIZE( grid%pb, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%pb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%pb, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%q2, 1 ) * SIZE( grid%q2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%q2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2, 1 ) * SIZE( grid%t2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%t2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%th2, 1 ) * SIZE( grid%th2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%th2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%th2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%psfc, 1 ) * SIZE( grid%psfc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%psfc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%psfc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%u10, 1 ) * SIZE( grid%u10, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%u10, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%u10, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%v10, 1 ) * SIZE( grid%v10, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%v10, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%v10, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lpi, 1 ) * SIZE( grid%lpi, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lpi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lpi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_moist(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%qvold, 1 ) * SIZE( grid%qvold, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qvold, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qvold, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qnwfa2d, 1 ) * SIZE( grid%qnwfa2d, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qnwfa2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qnwfa2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%dfi_scalar(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%toposlpx, 1 ) * SIZE( grid%toposlpx, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%toposlpx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%toposlpx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%toposlpy, 1 ) * SIZE( grid%toposlpy, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%toposlpy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%toposlpy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%slope, 1 ) * SIZE( grid%slope, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%slope, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%slope, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%slp_azi, 1 ) * SIZE( grid%slp_azi, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%slp_azi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%slp_azi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%shdmax, 1 ) * SIZE( grid%shdmax, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%shdmax, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shdmax, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%shdmin, 1 ) * SIZE( grid%shdmin, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%shdmin, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shdmin, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%landusef, 1 ) * SIZE( grid%landusef, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%landusef, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%landusef, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%soilctop, 1 ) * SIZE( grid%soilctop, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%soilctop, & cids, cide, 1, config_flags%num_soil_cat, cjds, cjde, & cims, cime, 1, config_flags%num_soil_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_cat, cjps, cjpe, & ngrid%soilctop, & nids, nide, 1, config_flags%num_soil_cat, njds, njde, & nims, nime, 1, config_flags%num_soil_cat, njms, njme, & nips, nipe, 1, config_flags%num_soil_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%soilcbot, 1 ) * SIZE( grid%soilcbot, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%soilcbot, & cids, cide, 1, config_flags%num_soil_cat, cjds, cjde, & cims, cime, 1, config_flags%num_soil_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_cat, cjps, cjpe, & ngrid%soilcbot, & nids, nide, 1, config_flags%num_soil_cat, njds, njde, & nims, nime, 1, config_flags%num_soil_cat, njms, njme, & nips, nipe, 1, config_flags%num_soil_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tslb, 1 ) * SIZE( grid%tslb, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tslb, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tslb, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%smois, 1 ) * SIZE( grid%smois, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%smois, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smois, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sh2o, 1 ) * SIZE( grid%sh2o, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sh2o, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%sh2o, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%smcrel, 1 ) * SIZE( grid%smcrel, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%smcrel, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smcrel, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xice, 1 ) * SIZE( grid%xice, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xice, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xice, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%icedepth, 1 ) * SIZE( grid%icedepth, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%icedepth, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%icedepth, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xicem, 1 ) * SIZE( grid%xicem, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xicem, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xicem, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%albsi, 1 ) * SIZE( grid%albsi, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%albsi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%albsi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowsi, 1 ) * SIZE( grid%snowsi, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowsi, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowsi, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ivgtyp, 1 ) * SIZE( grid%ivgtyp, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%ivgtyp, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ivgtyp, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%isltyp, 1 ) * SIZE( grid%isltyp, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%isltyp, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%isltyp, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%vegfra, 1 ) * SIZE( grid%vegfra, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%vegfra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%vegfra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acgrdflx, 1 ) * SIZE( grid%acgrdflx, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acgrdflx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acgrdflx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acsnow, 1 ) * SIZE( grid%acsnow, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%acsnow, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acsnow, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acgraup, 1 ) * SIZE( grid%acgraup, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%acgraup, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acgraup, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acrunoff, 1 ) * SIZE( grid%acrunoff, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%acrunoff, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acrunoff, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acsnom, 1 ) * SIZE( grid%acsnom, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%acsnom, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acsnom, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acfrain, 1 ) * SIZE( grid%acfrain, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%acfrain, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acfrain, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow, 1 ) * SIZE( grid%snow, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snow, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowh, 1 ) * SIZE( grid%snowh, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowh, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowh, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%canwat, 1 ) * SIZE( grid%canwat, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%canwat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canwat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tr_urb2d, 1 ) * SIZE( grid%tr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgr_urb2d, 1 ) * SIZE( grid%tgr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tb_urb2d, 1 ) * SIZE( grid%tb_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tg_urb2d, 1 ) * SIZE( grid%tg_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tc_urb2d, 1 ) * SIZE( grid%tc_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qc_urb2d, 1 ) * SIZE( grid%qc_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%qc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%uc_urb2d, 1 ) * SIZE( grid%uc_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%uc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%uc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xxxr_urb2d, 1 ) * SIZE( grid%xxxr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xxxr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xxxb_urb2d, 1 ) * SIZE( grid%xxxb_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xxxb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xxxg_urb2d, 1 ) * SIZE( grid%xxxg_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xxxg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xxxc_urb2d, 1 ) * SIZE( grid%xxxc_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xxxc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xxxc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%cmcr_urb2d, 1 ) * SIZE( grid%cmcr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%cmcr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cmcr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%drelr_urb2d, 1 ) * SIZE( grid%drelr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%drelr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%drelb_urb2d, 1 ) * SIZE( grid%drelb_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%drelb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%drelg_urb2d, 1 ) * SIZE( grid%drelg_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%drelg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%drelg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%flxhumr_urb2d, 1 ) * SIZE( grid%flxhumr_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%flxhumr_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumr_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%flxhumb_urb2d, 1 ) * SIZE( grid%flxhumb_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%flxhumb_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumb_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%flxhumg_urb2d, 1 ) * SIZE( grid%flxhumg_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%flxhumg_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%flxhumg_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgrl_urb3d, 1 ) * SIZE( grid%tgrl_urb3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgrl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tgrl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%smr_urb3d, 1 ) * SIZE( grid%smr_urb3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%smr_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%smr_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%trl_urb3d, 1 ) * SIZE( grid%trl_urb3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%trl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%trl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tbl_urb3d, 1 ) * SIZE( grid%tbl_urb3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tbl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tbl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgl_urb3d, 1 ) * SIZE( grid%tgl_urb3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgl_urb3d, & cids, cide, 1, config_flags%num_soil_layers, cjds, cjde, & cims, cime, 1, config_flags%num_soil_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_soil_layers, cjps, cjpe, & ngrid%tgl_urb3d, & nids, nide, 1, config_flags%num_soil_layers, njds, njde, & nims, nime, 1, config_flags%num_soil_layers, njms, njme, & nips, nipe, 1, config_flags%num_soil_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sh_urb2d, 1 ) * SIZE( grid%sh_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sh_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sh_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lh_urb2d, 1 ) * SIZE( grid%lh_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lh_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lh_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%g_urb2d, 1 ) * SIZE( grid%g_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%g_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%g_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rn_urb2d, 1 ) * SIZE( grid%rn_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rn_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rn_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ts_urb2d, 1 ) * SIZE( grid%ts_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ts_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ts_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%frc_urb2d, 1 ) * SIZE( grid%frc_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%frc_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%frc_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%utype_urb2d, 1 ) * SIZE( grid%utype_urb2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%utype_urb2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%utype_urb2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%imperv, 1 ) * SIZE( grid%imperv, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%imperv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%imperv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%canfra, 1 ) * SIZE( grid%canfra, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%canfra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canfra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%var2d, 1 ) * SIZE( grid%var2d, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%var2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%var2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12d, 1 ) * SIZE( grid%oc12d, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oc12d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oc12d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1, 1 ) * SIZE( grid%oa1, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2, 1 ) * SIZE( grid%oa2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3, 1 ) * SIZE( grid%oa3, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa3, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4, 1 ) * SIZE( grid%oa4, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa4, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1, 1 ) * SIZE( grid%ol1, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2, 1 ) * SIZE( grid%ol2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3, 1 ) * SIZE( grid%ol3, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol3, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4, 1 ) * SIZE( grid%ol4, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol4, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%var2dss, 1 ) * SIZE( grid%var2dss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%var2dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%var2dss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12dss, 1 ) * SIZE( grid%oc12dss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oc12dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oc12dss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1ss, 1 ) * SIZE( grid%oa1ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa1ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2ss, 1 ) * SIZE( grid%oa2ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa2ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3ss, 1 ) * SIZE( grid%oa3ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa3ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4ss, 1 ) * SIZE( grid%oa4ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%oa4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%oa4ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1ss, 1 ) * SIZE( grid%ol1ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol1ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2ss, 1 ) * SIZE( grid%ol2ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol2ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3ss, 1 ) * SIZE( grid%ol3ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol3ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4ss, 1 ) * SIZE( grid%ol4ss, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ol4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ol4ss, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ctopo, 1 ) * SIZE( grid%ctopo, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ctopo, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ctopo, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ctopo2, 1 ) * SIZE( grid%ctopo2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ctopo2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ctopo2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f_ice_phy, 1 ) * SIZE( grid%f_ice_phy, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%f_ice_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_ice_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f_rain_phy, 1 ) * SIZE( grid%f_rain_phy, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%f_rain_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_rain_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f_rimef_phy, 1 ) * SIZE( grid%f_rimef_phy, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%f_rimef_phy, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%f_rimef_phy, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_tmp, 1 ) * SIZE( grid%om_tmp, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%om_tmp, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_tmp, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_s, 1 ) * SIZE( grid%om_s, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%om_s, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_s, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_u, 1 ) * SIZE( grid%om_u, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%om_u, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_u, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_v, 1 ) * SIZE( grid%om_v, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%om_v, & cids, cide, 1, config_flags%ocean_levels, cjds, cjde, & cims, cime, 1, config_flags%ocean_levels, cjms, cjme, & cips, cipe, 1, config_flags%ocean_levels, cjps, cjpe, & ngrid%om_v, & nids, nide, 1, config_flags%ocean_levels, njds, njde, & nims, nime, 1, config_flags%ocean_levels, njms, njme, & nips, nipe, 1, config_flags%ocean_levels, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%om_ml, 1 ) * SIZE( grid%om_ml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%om_ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%om_ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h_diabatic, 1 ) * SIZE( grid%h_diabatic, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%h_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%h_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qv_diabatic, 1 ) * SIZE( grid%qv_diabatic, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qv_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qv_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qc_diabatic, 1 ) * SIZE( grid%qc_diabatic, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qc_diabatic, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qc_diabatic, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msft, 1 ) * SIZE( grid%msft, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msft, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msft, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfu, 1 ) * SIZE( grid%msfu, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfu, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfu, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfv, 1 ) * SIZE( grid%msfv, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msftx, 1 ) * SIZE( grid%msftx, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msftx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msftx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfty, 1 ) * SIZE( grid%msfty, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfty, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfty, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfux, 1 ) * SIZE( grid%msfux, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfux, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfux, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfuy, 1 ) * SIZE( grid%msfuy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfuy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfuy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvx, 1 ) * SIZE( grid%msfvx, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfvx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvx_inv, 1 ) * SIZE( grid%msfvx_inv, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfvx_inv, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvx_inv, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%msfvy, 1 ) * SIZE( grid%msfvy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%msfvy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%msfvy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%f, 1 ) * SIZE( grid%f, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%f, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%f, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%e, 1 ) * SIZE( grid%e, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%e, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%e, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sina, 1 ) * SIZE( grid%sina, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sina, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sina, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%cosa, 1 ) * SIZE( grid%cosa, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%cosa, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cosa, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ht, 1 ) * SIZE( grid%ht, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%ht, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ht, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tsk, 1 ) * SIZE( grid%tsk, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tsk, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tsk, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rainc, 1 ) * SIZE( grid%rainc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%rainc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rainsh, 1 ) * SIZE( grid%rainsh, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%rainsh, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainsh, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rainnc, 1 ) * SIZE( grid%rainnc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%rainnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rainnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%frain, 1 ) * SIZE( grid%frain, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%frain, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%frain, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_rainc, 1 ) * SIZE( grid%i_rainc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_rainc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_rainc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_rainnc, 1 ) * SIZE( grid%i_rainnc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_rainnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_rainnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snownc, 1 ) * SIZE( grid%snownc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%snownc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snownc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%graupelnc, 1 ) * SIZE( grid%graupelnc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%graupelnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%graupelnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%hailnc, 1 ) * SIZE( grid%hailnc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%hailnc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hailnc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm, 1 ) * SIZE( grid%refl_10cm, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%refl_10cm, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%refl_10cm, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%composite_refl_10cm, 1 ) * SIZE( grid%composite_refl_10cm, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%composite_refl_10cm, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%composite_refl_10cm, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm_1km, 1 ) * SIZE( grid%refl_10cm_1km, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%refl_10cm_1km, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%refl_10cm_1km, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%refl_10cm_4km, 1 ) * SIZE( grid%refl_10cm_4km, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%refl_10cm_4km, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%refl_10cm_4km, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%th_old, 1 ) * SIZE( grid%th_old, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%th_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%th_old, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qv_old, 1 ) * SIZE( grid%qv_old, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qv_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qv_old, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%vmi3d, 1 ) * SIZE( grid%vmi3d, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%vmi3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%vmi3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%di3d, 1 ) * SIZE( grid%di3d, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%di3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%di3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rhopo3d, 1 ) * SIZE( grid%rhopo3d, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%rhopo3d, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%rhopo3d, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%w_up, 1 ) * SIZE( grid%w_up, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%w_up, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%w_up, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupt, 1 ) * SIZE( grid%acswupt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswuptc, 1 ) * SIZE( grid%acswuptc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnt, 1 ) * SIZE( grid%acswdnt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdntc, 1 ) * SIZE( grid%acswdntc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupb, 1 ) * SIZE( grid%acswupb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswupbc, 1 ) * SIZE( grid%acswupbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnb, 1 ) * SIZE( grid%acswdnb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%acswdnbc, 1 ) * SIZE( grid%acswdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%acswdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%acswdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupt, 1 ) * SIZE( grid%aclwupt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwuptc, 1 ) * SIZE( grid%aclwuptc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnt, 1 ) * SIZE( grid%aclwdnt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdntc, 1 ) * SIZE( grid%aclwdntc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupb, 1 ) * SIZE( grid%aclwupb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwupbc, 1 ) * SIZE( grid%aclwupbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnb, 1 ) * SIZE( grid%aclwdnb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclwdnbc, 1 ) * SIZE( grid%aclwdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupt, 1 ) * SIZE( grid%i_acswupt, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswuptc, 1 ) * SIZE( grid%i_acswuptc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnt, 1 ) * SIZE( grid%i_acswdnt, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdntc, 1 ) * SIZE( grid%i_acswdntc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupb, 1 ) * SIZE( grid%i_acswupb, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswupbc, 1 ) * SIZE( grid%i_acswupbc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnb, 1 ) * SIZE( grid%i_acswdnb, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_acswdnbc, 1 ) * SIZE( grid%i_acswdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_acswdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_acswdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupt, 1 ) * SIZE( grid%i_aclwupt, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwuptc, 1 ) * SIZE( grid%i_aclwuptc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnt, 1 ) * SIZE( grid%i_aclwdnt, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdntc, 1 ) * SIZE( grid%i_aclwdntc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupb, 1 ) * SIZE( grid%i_aclwupb, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwupbc, 1 ) * SIZE( grid%i_aclwupbc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnb, 1 ) * SIZE( grid%i_aclwdnb, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%i_aclwdnbc, 1 ) * SIZE( grid%i_aclwdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcni ( & grid%i_aclwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%i_aclwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupt, 1 ) * SIZE( grid%swupt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swuptc, 1 ) * SIZE( grid%swuptc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnt, 1 ) * SIZE( grid%swdnt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdntc, 1 ) * SIZE( grid%swdntc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupb, 1 ) * SIZE( grid%swupb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupbc, 1 ) * SIZE( grid%swupbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnb, 1 ) * SIZE( grid%swdnb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swdnbc, 1 ) * SIZE( grid%swdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%swdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%swdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupt, 1 ) * SIZE( grid%lwupt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwupt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwuptc, 1 ) * SIZE( grid%lwuptc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwuptc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwuptc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnt, 1 ) * SIZE( grid%lwdnt, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwdnt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdntc, 1 ) * SIZE( grid%lwdntc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwdntc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdntc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupb, 1 ) * SIZE( grid%lwupb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwupb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupbc, 1 ) * SIZE( grid%lwupbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwupbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwupbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnb, 1 ) * SIZE( grid%lwdnb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwdnb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwdnbc, 1 ) * SIZE( grid%lwdnbc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%lwdnbc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lwdnbc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlat_u, 1 ) * SIZE( grid%xlat_u, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlat_u, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat_u, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong_u, 1 ) * SIZE( grid%xlong_u, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlong_u, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong_u, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_xstag, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlat_v, 1 ) * SIZE( grid%xlat_v, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlat_v, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlat_v, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xlong_v, 1 ) * SIZE( grid%xlong_v, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xlong_v, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xlong_v, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_ystag, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%clat, 1 ) * SIZE( grid%clat, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%clat, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%clat, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%isnowxy, 1 ) * SIZE( grid%isnowxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%isnowxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%isnowxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tvxy, 1 ) * SIZE( grid%tvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgxy, 1 ) * SIZE( grid%tgxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%canicexy, 1 ) * SIZE( grid%canicexy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%canicexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canicexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%canliqxy, 1 ) * SIZE( grid%canliqxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%canliqxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%canliqxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%eahxy, 1 ) * SIZE( grid%eahxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%eahxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%eahxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tahxy, 1 ) * SIZE( grid%tahxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tahxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tahxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%cmxy, 1 ) * SIZE( grid%cmxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%cmxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%cmxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chxy, 1 ) * SIZE( grid%chxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%fwetxy, 1 ) * SIZE( grid%fwetxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%fwetxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fwetxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sneqvoxy, 1 ) * SIZE( grid%sneqvoxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sneqvoxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sneqvoxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%alboldxy, 1 ) * SIZE( grid%alboldxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%alboldxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%alboldxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qsnowxy, 1 ) * SIZE( grid%qsnowxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%qsnowxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qsnowxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%wslakexy, 1 ) * SIZE( grid%wslakexy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%wslakexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wslakexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%zwtxy, 1 ) * SIZE( grid%zwtxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%zwtxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%zwtxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%waxy, 1 ) * SIZE( grid%waxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%waxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%waxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%wtxy, 1 ) * SIZE( grid%wtxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%wtxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wtxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tsnoxy, 1 ) * SIZE( grid%tsnoxy, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tsnoxy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%tsnoxy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%zsnsoxy, 1 ) * SIZE( grid%zsnsoxy, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%zsnsoxy, & cids, cide, 1, config_flags%num_snso_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snso_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snso_layers, cjps, cjpe, & ngrid%zsnsoxy, & nids, nide, 1, config_flags%num_snso_layers, njds, njde, & nims, nime, 1, config_flags%num_snso_layers, njms, njme, & nips, nipe, 1, config_flags%num_snso_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snicexy, 1 ) * SIZE( grid%snicexy, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snicexy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%snicexy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snliqxy, 1 ) * SIZE( grid%snliqxy, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snliqxy, & cids, cide, 1, config_flags%num_snow_layers, cjds, cjde, & cims, cime, 1, config_flags%num_snow_layers, cjms, cjme, & cips, cipe, 1, config_flags%num_snow_layers, cjps, cjpe, & ngrid%snliqxy, & nids, nide, 1, config_flags%num_snow_layers, njds, njde, & nims, nime, 1, config_flags%num_snow_layers, njms, njme, & nips, nipe, 1, config_flags%num_snow_layers, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lfmassxy, 1 ) * SIZE( grid%lfmassxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lfmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lfmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rtmassxy, 1 ) * SIZE( grid%rtmassxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rtmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rtmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%stmassxy, 1 ) * SIZE( grid%stmassxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%stmassxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%stmassxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%woodxy, 1 ) * SIZE( grid%woodxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%woodxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%woodxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%stblcpxy, 1 ) * SIZE( grid%stblcpxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%stblcpxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%stblcpxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%fastcpxy, 1 ) * SIZE( grid%fastcpxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%fastcpxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fastcpxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xsaixy, 1 ) * SIZE( grid%xsaixy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xsaixy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xsaixy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2mvxy, 1 ) * SIZE( grid%t2mvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t2mvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2mvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2mbxy, 1 ) * SIZE( grid%t2mbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t2mbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2mbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%q2mvxy, 1 ) * SIZE( grid%q2mvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%q2mvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2mvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%q2mbxy, 1 ) * SIZE( grid%q2mbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%q2mbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%q2mbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tradxy, 1 ) * SIZE( grid%tradxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tradxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tradxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%neexy, 1 ) * SIZE( grid%neexy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%neexy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%neexy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%gppxy, 1 ) * SIZE( grid%gppxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%gppxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gppxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nppxy, 1 ) * SIZE( grid%nppxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%nppxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nppxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%fvegxy, 1 ) * SIZE( grid%fvegxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%fvegxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fvegxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qinxy, 1 ) * SIZE( grid%qinxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%qinxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%qinxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%runsfxy, 1 ) * SIZE( grid%runsfxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%runsfxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%runsfxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%runsbxy, 1 ) * SIZE( grid%runsbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%runsbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%runsbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ecanxy, 1 ) * SIZE( grid%ecanxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ecanxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ecanxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%edirxy, 1 ) * SIZE( grid%edirxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%edirxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%edirxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%etranxy, 1 ) * SIZE( grid%etranxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%etranxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%etranxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%fsaxy, 1 ) * SIZE( grid%fsaxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%fsaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fsaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%firaxy, 1 ) * SIZE( grid%firaxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%firaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%firaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aparxy, 1 ) * SIZE( grid%aparxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%aparxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aparxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%psnxy, 1 ) * SIZE( grid%psnxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%psnxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%psnxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%savxy, 1 ) * SIZE( grid%savxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%savxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%savxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sagxy, 1 ) * SIZE( grid%sagxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sagxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%sagxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rssunxy, 1 ) * SIZE( grid%rssunxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rssunxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rssunxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rsshaxy, 1 ) * SIZE( grid%rsshaxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rsshaxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rsshaxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%bgapxy, 1 ) * SIZE( grid%bgapxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%bgapxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%bgapxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%wgapxy, 1 ) * SIZE( grid%wgapxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%wgapxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%wgapxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgvxy, 1 ) * SIZE( grid%tgvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgbxy, 1 ) * SIZE( grid%tgbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tgbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chvxy, 1 ) * SIZE( grid%chvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chbxy, 1 ) * SIZE( grid%chbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%shgxy, 1 ) * SIZE( grid%shgxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%shgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%shcxy, 1 ) * SIZE( grid%shcxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%shcxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shcxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%shbxy, 1 ) * SIZE( grid%shbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%shbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%shbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%evgxy, 1 ) * SIZE( grid%evgxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%evgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%evbxy, 1 ) * SIZE( grid%evbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%evbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ghvxy, 1 ) * SIZE( grid%ghvxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ghvxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ghvxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ghbxy, 1 ) * SIZE( grid%ghbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ghbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ghbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%irgxy, 1 ) * SIZE( grid%irgxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%irgxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%irgxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ircxy, 1 ) * SIZE( grid%ircxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ircxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%ircxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%irbxy, 1 ) * SIZE( grid%irbxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%irbxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%irbxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%trxy, 1 ) * SIZE( grid%trxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%trxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%trxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%evcxy, 1 ) * SIZE( grid%evcxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%evcxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%evcxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chleafxy, 1 ) * SIZE( grid%chleafxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chleafxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chleafxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chucxy, 1 ) * SIZE( grid%chucxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chucxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chucxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chv2xy, 1 ) * SIZE( grid%chv2xy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chv2xy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chv2xy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chb2xy, 1 ) * SIZE( grid%chb2xy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chb2xy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chb2xy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%chstarxy, 1 ) * SIZE( grid%chstarxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%chstarxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%chstarxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%fdepthxy, 1 ) * SIZE( grid%fdepthxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%fdepthxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%fdepthxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%eqzwt, 1 ) * SIZE( grid%eqzwt, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%eqzwt, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%eqzwt, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rechclim, 1 ) * SIZE( grid%rechclim, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rechclim, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rechclim, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%rivermask, 1 ) * SIZE( grid%rivermask, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%rivermask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%rivermask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%riverbedxy, 1 ) * SIZE( grid%riverbedxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%riverbedxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%riverbedxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nonriverxy, 1 ) * SIZE( grid%nonriverxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%nonriverxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nonriverxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%grainxy, 1 ) * SIZE( grid%grainxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%grainxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%grainxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%gddxy, 1 ) * SIZE( grid%gddxy, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%gddxy, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%gddxy, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%croptype, 1 ) * SIZE( grid%croptype, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%croptype, & cids, cide, 1, 5, cjds, cjde, & cims, cime, 1, 5, cjms, cjme, & cips, cipe, 1, 5, cjps, cjpe, & ngrid%croptype, & nids, nide, 1, 5, njds, njde, & nims, nime, 1, 5, njms, njme, & nips, nipe, 1, 5, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%planting, 1 ) * SIZE( grid%planting, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%planting, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%planting, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%harvest, 1 ) * SIZE( grid%harvest, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%harvest, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%harvest, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%season_gdd, 1 ) * SIZE( grid%season_gdd, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%season_gdd, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%season_gdd, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tsk_mosaic, 1 ) * SIZE( grid%tsk_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tsk_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tsk_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qsfc_mosaic, 1 ) * SIZE( grid%qsfc_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%qsfc_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%qsfc_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tslb_mosaic, 1 ) * SIZE( grid%tslb_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tslb_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tslb_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%smois_mosaic, 1 ) * SIZE( grid%smois_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%smois_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%smois_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sh2o_mosaic, 1 ) * SIZE( grid%sh2o_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sh2o_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%sh2o_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%canwat_mosaic, 1 ) * SIZE( grid%canwat_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%canwat_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%canwat_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow_mosaic, 1 ) * SIZE( grid%snow_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snow_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snow_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowh_mosaic, 1 ) * SIZE( grid%snowh_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowh_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snowh_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowc_mosaic, 1 ) * SIZE( grid%snowc_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowc_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%snowc_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tr_urb2d_mosaic, 1 ) * SIZE( grid%tr_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tr_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tr_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tb_urb2d_mosaic, 1 ) * SIZE( grid%tb_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tb_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tb_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tg_urb2d_mosaic, 1 ) * SIZE( grid%tg_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tg_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tg_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tc_urb2d_mosaic, 1 ) * SIZE( grid%tc_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%tc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ts_urb2d_mosaic, 1 ) * SIZE( grid%ts_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ts_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%ts_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ts_rul2d_mosaic, 1 ) * SIZE( grid%ts_rul2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%ts_rul2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%ts_rul2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qc_urb2d_mosaic, 1 ) * SIZE( grid%qc_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%qc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%qc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%uc_urb2d_mosaic, 1 ) * SIZE( grid%uc_urb2d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%uc_urb2d_mosaic, & cids, cide, 1, config_flags%mosaic_cat, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat, cjps, cjpe, & ngrid%uc_urb2d_mosaic, & nids, nide, 1, config_flags%mosaic_cat, njds, njde, & nims, nime, 1, config_flags%mosaic_cat, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%trl_urb3d_mosaic, 1 ) * SIZE( grid%trl_urb3d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%trl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%trl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tbl_urb3d_mosaic, 1 ) * SIZE( grid%tbl_urb3d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tbl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tbl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tgl_urb3d_mosaic, 1 ) * SIZE( grid%tgl_urb3d_mosaic, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tgl_urb3d_mosaic, & cids, cide, 1, config_flags%mosaic_cat_soil, cjds, cjde, & cims, cime, 1, config_flags%mosaic_cat_soil, cjms, cjme, & cips, cipe, 1, config_flags%mosaic_cat_soil, cjps, cjpe, & ngrid%tgl_urb3d_mosaic, & nids, nide, 1, config_flags%mosaic_cat_soil, njds, njde, & nims, nime, 1, config_flags%mosaic_cat_soil, njms, njme, & nips, nipe, 1, config_flags%mosaic_cat_soil, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mosaic_cat_index, 1 ) * SIZE( grid%mosaic_cat_index, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%mosaic_cat_index, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%mosaic_cat_index, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%landusef2, 1 ) * SIZE( grid%landusef2, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%landusef2, & cids, cide, 1, config_flags%num_land_cat, cjds, cjde, & cims, cime, 1, config_flags%num_land_cat, cjms, cjme, & cips, cipe, 1, config_flags%num_land_cat, cjps, cjpe, & ngrid%landusef2, & nids, nide, 1, config_flags%num_land_cat, njds, njde, & nims, nime, 1, config_flags%num_land_cat, njms, njme, & nips, nipe, 1, config_flags%num_land_cat, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tmn, 1 ) * SIZE( grid%tmn, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tmn, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tmn, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tyr, 1 ) * SIZE( grid%tyr, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tyr, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tyr, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tyra, 1 ) * SIZE( grid%tyra, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tyra, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tyra, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tdly, 1 ) * SIZE( grid%tdly, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tdly, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tdly, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tlag, 1 ) * SIZE( grid%tlag, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tlag, & cids, cide, 1, config_flags%lagday, cjds, cjde, & cims, cime, 1, config_flags%lagday, cjms, cjme, & cips, cipe, 1, config_flags%lagday, cjps, cjpe, & ngrid%tlag, & nids, nide, 1, config_flags%lagday, njds, njde, & nims, nime, 1, config_flags%lagday, njms, njme, & nips, nipe, 1, config_flags%lagday, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%xland, 1 ) * SIZE( grid%xland, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%xland, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%xland, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%achfx, 1 ) * SIZE( grid%achfx, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%achfx, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%achfx, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%aclhf, 1 ) * SIZE( grid%aclhf, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%aclhf, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%aclhf, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowc, 1 ) * SIZE( grid%snowc, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_c, 1 ) * SIZE( grid%prec_acc_c, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%prec_acc_c, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_c, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_c1, 1 ) * SIZE( grid%prec_acc_c1, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%prec_acc_c1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_c1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_nc, 1 ) * SIZE( grid%prec_acc_nc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%prec_acc_nc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_nc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%prec_acc_nc1, 1 ) * SIZE( grid%prec_acc_nc1, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%prec_acc_nc1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%prec_acc_nc1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow_acc_nc, 1 ) * SIZE( grid%snow_acc_nc, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%snow_acc_nc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow_acc_nc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snow_acc_nc1, 1 ) * SIZE( grid%snow_acc_nc1, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%snow_acc_nc1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snow_acc_nc1, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tml, 1 ) * SIZE( grid%tml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t0ml, 1 ) * SIZE( grid%t0ml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t0ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t0ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%hml, 1 ) * SIZE( grid%hml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%hml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h0ml, 1 ) * SIZE( grid%h0ml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h0ml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%h0ml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%huml, 1 ) * SIZE( grid%huml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%huml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%huml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%hvml, 1 ) * SIZE( grid%hvml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%hvml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%hvml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tmoml, 1 ) * SIZE( grid%tmoml, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tmoml, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%tmoml, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%erod, 1 ) * SIZE( grid%erod, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%erod, & cids, cide, 1, config_flags%erosion_dim, cjds, cjde, & cims, cime, 1, config_flags%erosion_dim, cjms, cjme, & cips, cipe, 1, config_flags%erosion_dim, cjps, cjpe, & ngrid%erod, & nids, nide, 1, config_flags%erosion_dim, njds, njde, & nims, nime, 1, config_flags%erosion_dim, njms, njme, & nips, nipe, 1, config_flags%erosion_dim, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qlsink, 1 ) * SIZE( grid%qlsink, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%qlsink, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%qlsink, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precr, 1 ) * SIZE( grid%precr, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%precr, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precr, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%preci, 1 ) * SIZE( grid%preci, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%preci, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%preci, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precs, 1 ) * SIZE( grid%precs, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%precs, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precs, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%precg, 1 ) * SIZE( grid%precg, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%precg, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%precg, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%chem(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL copy_fcn ( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & ngrid%tracer(ngrid%sm31,ngrid%sm32,ngrid%sm33,itrace), & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%numc, 1 ) * SIZE( grid%numc, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%numc, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%numc, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nump, 1 ) * SIZE( grid%nump, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%nump, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%nump, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snl, 1 ) * SIZE( grid%snl, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snl, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snl, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowdp, 1 ) * SIZE( grid%snowdp, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowdp, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowdp, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%wtc, 1 ) * SIZE( grid%wtc, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%wtc, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%wtc, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%wtp, 1 ) * SIZE( grid%wtp, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%wtp, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%wtp, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osno, 1 ) * SIZE( grid%h2osno, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osno, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osno, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_grnd, 1 ) * SIZE( grid%t_grnd, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_grnd, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_grnd, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_veg, 1 ) * SIZE( grid%t_veg, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_veg, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_veg, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2ocan, 1 ) * SIZE( grid%h2ocan, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2ocan, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2ocan, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2ocan_col, 1 ) * SIZE( grid%h2ocan_col, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2ocan_col, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2ocan_col, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2m_max, 1 ) * SIZE( grid%t2m_max, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t2m_max, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2m_max, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2m_min, 1 ) * SIZE( grid%t2m_min, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t2m_min, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2m_min, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t2clm, 1 ) * SIZE( grid%t2clm, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t2clm, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t2clm, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_ref2m, 1 ) * SIZE( grid%t_ref2m, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_ref2m, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_ref2m, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq_s1, 1 ) * SIZE( grid%h2osoi_liq_s1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq_s2, 1 ) * SIZE( grid%h2osoi_liq_s2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq_s3, 1 ) * SIZE( grid%h2osoi_liq_s3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq_s4, 1 ) * SIZE( grid%h2osoi_liq_s4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq_s5, 1 ) * SIZE( grid%h2osoi_liq_s5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq1, 1 ) * SIZE( grid%h2osoi_liq1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq2, 1 ) * SIZE( grid%h2osoi_liq2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq3, 1 ) * SIZE( grid%h2osoi_liq3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq4, 1 ) * SIZE( grid%h2osoi_liq4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq5, 1 ) * SIZE( grid%h2osoi_liq5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq6, 1 ) * SIZE( grid%h2osoi_liq6, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq7, 1 ) * SIZE( grid%h2osoi_liq7, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq8, 1 ) * SIZE( grid%h2osoi_liq8, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq9, 1 ) * SIZE( grid%h2osoi_liq9, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq10, 1 ) * SIZE( grid%h2osoi_liq10, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_liq10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice_s1, 1 ) * SIZE( grid%h2osoi_ice_s1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice_s2, 1 ) * SIZE( grid%h2osoi_ice_s2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice_s3, 1 ) * SIZE( grid%h2osoi_ice_s3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice_s4, 1 ) * SIZE( grid%h2osoi_ice_s4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice_s5, 1 ) * SIZE( grid%h2osoi_ice_s5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice1, 1 ) * SIZE( grid%h2osoi_ice1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice2, 1 ) * SIZE( grid%h2osoi_ice2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice3, 1 ) * SIZE( grid%h2osoi_ice3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice4, 1 ) * SIZE( grid%h2osoi_ice4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice5, 1 ) * SIZE( grid%h2osoi_ice5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice6, 1 ) * SIZE( grid%h2osoi_ice6, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice7, 1 ) * SIZE( grid%h2osoi_ice7, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice8, 1 ) * SIZE( grid%h2osoi_ice8, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice9, 1 ) * SIZE( grid%h2osoi_ice9, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice10, 1 ) * SIZE( grid%h2osoi_ice10, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_ice10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno_s1, 1 ) * SIZE( grid%t_soisno_s1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno_s1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno_s2, 1 ) * SIZE( grid%t_soisno_s2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno_s2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno_s3, 1 ) * SIZE( grid%t_soisno_s3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno_s3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno_s4, 1 ) * SIZE( grid%t_soisno_s4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno_s4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno_s5, 1 ) * SIZE( grid%t_soisno_s5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno_s5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno_s5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno1, 1 ) * SIZE( grid%t_soisno1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno2, 1 ) * SIZE( grid%t_soisno2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno3, 1 ) * SIZE( grid%t_soisno3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno4, 1 ) * SIZE( grid%t_soisno4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno5, 1 ) * SIZE( grid%t_soisno5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno6, 1 ) * SIZE( grid%t_soisno6, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno7, 1 ) * SIZE( grid%t_soisno7, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno8, 1 ) * SIZE( grid%t_soisno8, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno9, 1 ) * SIZE( grid%t_soisno9, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno10, 1 ) * SIZE( grid%t_soisno10, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_soisno10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dzsnow1, 1 ) * SIZE( grid%dzsnow1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dzsnow1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dzsnow2, 1 ) * SIZE( grid%dzsnow2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dzsnow2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dzsnow3, 1 ) * SIZE( grid%dzsnow3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dzsnow3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dzsnow4, 1 ) * SIZE( grid%dzsnow4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dzsnow4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dzsnow5, 1 ) * SIZE( grid%dzsnow5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dzsnow5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%dzsnow5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowrds1, 1 ) * SIZE( grid%snowrds1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowrds1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowrds2, 1 ) * SIZE( grid%snowrds2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowrds2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowrds3, 1 ) * SIZE( grid%snowrds3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowrds3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowrds4, 1 ) * SIZE( grid%snowrds4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowrds4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowrds5, 1 ) * SIZE( grid%snowrds5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowrds5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%snowrds5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake1, 1 ) * SIZE( grid%t_lake1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake2, 1 ) * SIZE( grid%t_lake2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake3, 1 ) * SIZE( grid%t_lake3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake4, 1 ) * SIZE( grid%t_lake4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake5, 1 ) * SIZE( grid%t_lake5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake6, 1 ) * SIZE( grid%t_lake6, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake7, 1 ) * SIZE( grid%t_lake7, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake8, 1 ) * SIZE( grid%t_lake8, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake9, 1 ) * SIZE( grid%t_lake9, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake10, 1 ) * SIZE( grid%t_lake10, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%t_lake10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol1, 1 ) * SIZE( grid%h2osoi_vol1, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol1, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol1, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol2, 1 ) * SIZE( grid%h2osoi_vol2, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol2, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol2, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol3, 1 ) * SIZE( grid%h2osoi_vol3, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol3, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol3, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol4, 1 ) * SIZE( grid%h2osoi_vol4, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol4, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol4, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol5, 1 ) * SIZE( grid%h2osoi_vol5, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol5, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol5, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol6, 1 ) * SIZE( grid%h2osoi_vol6, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol6, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol6, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol7, 1 ) * SIZE( grid%h2osoi_vol7, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol7, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol7, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol8, 1 ) * SIZE( grid%h2osoi_vol8, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol8, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol8, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol9, 1 ) * SIZE( grid%h2osoi_vol9, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol9, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol9, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol10, 1 ) * SIZE( grid%h2osoi_vol10, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol10, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%h2osoi_vol10, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%albedosubgrid, 1 ) * SIZE( grid%albedosubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%albedosubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%albedosubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lhsubgrid, 1 ) * SIZE( grid%lhsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lhsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%lhsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%hfxsubgrid, 1 ) * SIZE( grid%hfxsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%hfxsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%hfxsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lwupsubgrid, 1 ) * SIZE( grid%lwupsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lwupsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%lwupsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%q2subgrid, 1 ) * SIZE( grid%q2subgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%q2subgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%q2subgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sabvsubgrid, 1 ) * SIZE( grid%sabvsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sabvsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%sabvsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%sabgsubgrid, 1 ) * SIZE( grid%sabgsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%sabgsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%sabgsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%nrasubgrid, 1 ) * SIZE( grid%nrasubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%nrasubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%nrasubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%swupsubgrid, 1 ) * SIZE( grid%swupsubgrid, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%swupsubgrid, & cids, cide, 1, config_flags%maxpatch, cjds, cjde, & cims, cime, 1, config_flags%maxpatch, cjms, cjme, & cips, cipe, 1, config_flags%maxpatch, cjps, cjpe, & ngrid%swupsubgrid, & nids, nide, 1, config_flags%maxpatch, njds, njde, & nims, nime, 1, config_flags%maxpatch, njms, njme, & nips, nipe, 1, config_flags%maxpatch, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lakedepth2d, 1 ) * SIZE( grid%lakedepth2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lakedepth2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lakedepth2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%savedtke12d, 1 ) * SIZE( grid%savedtke12d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%savedtke12d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%savedtke12d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snowdp2d, 1 ) * SIZE( grid%snowdp2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snowdp2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snowdp2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osno2d, 1 ) * SIZE( grid%h2osno2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osno2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%h2osno2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%snl2d, 1 ) * SIZE( grid%snl2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%snl2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%snl2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_grnd2d, 1 ) * SIZE( grid%t_grnd2d, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_grnd2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%t_grnd2d, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_lake3d, 1 ) * SIZE( grid%t_lake3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%t_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lake_icefrac3d, 1 ) * SIZE( grid%lake_icefrac3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lake_icefrac3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%lake_icefrac3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%z_lake3d, 1 ) * SIZE( grid%z_lake3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%z_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%z_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dz_lake3d, 1 ) * SIZE( grid%dz_lake3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dz_lake3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%dz_lake3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_soisno3d, 1 ) * SIZE( grid%t_soisno3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%t_soisno3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%t_soisno3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_ice3d, 1 ) * SIZE( grid%h2osoi_ice3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_ice3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_ice3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_liq3d, 1 ) * SIZE( grid%h2osoi_liq3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_liq3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_liq3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%h2osoi_vol3d, 1 ) * SIZE( grid%h2osoi_vol3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%h2osoi_vol3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%h2osoi_vol3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%z3d, 1 ) * SIZE( grid%z3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%z3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%z3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%dz3d, 1 ) * SIZE( grid%dz3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%dz3d, & cids, cide, 1, 15, cjds, cjde, & cims, cime, 1, 15, cjms, cjme, & cips, cipe, 1, 15, cjps, cjpe, & ngrid%dz3d, & nids, nide, 1, 15, njds, njde, & nims, nime, 1, 15, njms, njme, & nips, nipe, 1, 15, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%zi3d, 1 ) * SIZE( grid%zi3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%zi3d, & cids, cide, 1, 16, cjds, cjde, & cims, cime, 1, 16, cjms, cjme, & cips, cipe, 1, 16, cjps, cjpe, & ngrid%zi3d, & nids, nide, 1, 16, njds, njde, & nims, nime, 1, 16, njms, njme, & nips, nipe, 1, 16, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%watsat3d, 1 ) * SIZE( grid%watsat3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%watsat3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%watsat3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%csol3d, 1 ) * SIZE( grid%csol3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%csol3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%csol3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tkmg3d, 1 ) * SIZE( grid%tkmg3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tkmg3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tkmg3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tkdry3d, 1 ) * SIZE( grid%tkdry3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tkdry3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tkdry3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%tksatu3d, 1 ) * SIZE( grid%tksatu3d, 3 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%tksatu3d, & cids, cide, 1, 10, cjds, cjde, & cims, cime, 1, 10, cjms, cjme, & cips, cipe, 1, 10, cjps, cjpe, & ngrid%tksatu3d, & nids, nide, 1, 10, njds, njde, & nims, nime, 1, 10, njms, njme, & nips, nipe, 1, 10, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pcb, 1 ) * SIZE( grid%pcb, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%pcb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%pcb, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pc_2, 1 ) * SIZE( grid%pc_2, 2 ) .GT. 1 ) THEN CALL copy_fcn ( & grid%pc_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%pc_2, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%landmask, 1 ) * SIZE( grid%landmask, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%landmask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%landmask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%lakemask, 1 ) * SIZE( grid%lakemask, 2 ) .GT. 1 ) THEN CALL copy_fcnm ( & grid%lakemask, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & ngrid%lakemask, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & config_flags%shw, ngrid%imask_nostag, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF RETURN END SUBROUTINE feedback_domain_em_part1 SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags & ,moist,moist_bxs,moist_bxe,moist_bys,moist_bye,moist_btxs,moist_btxe,moist_btys,moist_btye,dfi_moist,dfi_moist_bxs,dfi_moist_bxe, & dfi_moist_bys,dfi_moist_bye,dfi_moist_btxs,dfi_moist_btxe,dfi_moist_btys,dfi_moist_btye,scalar,scalar_bxs,scalar_bxe,scalar_bys, & scalar_bye,scalar_btxs,scalar_btxe,scalar_btys,scalar_btye,dfi_scalar,dfi_scalar_bxs,dfi_scalar_bxe,dfi_scalar_bys, & dfi_scalar_bye,dfi_scalar_btxs,dfi_scalar_btxe,dfi_scalar_btys,dfi_scalar_btye,aerod,ozmixm,aerosolc_1,aerosolc_2,fdda3d,fdda2d, & advh_t,advz_t,emis_ant,emis_dust,emis_seas,emis_seas2,emis_vol,ebu,ebu_in,emis_aircraft,ext_coef,bscat_coef,asym_par,conv_ct, & chem_ct,vmix_ct,advh_ct,advz_ct,dvel,vprm_in,wet_in,chem,chem_bxs,chem_bxe,chem_bys,chem_bye,chem_btxs,chem_btxe,chem_btys, & chem_btye,tracer,tracer_bxs,tracer_bxe,tracer_bys,tracer_bye,tracer_btxs,tracer_btxe,tracer_btys,tracer_btye,nba_mij,nba_rij & ) USE module_state_description USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid USE module_configure, ONLY : grid_config_rec_type, model_config_rec USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & ipe_save, jpe_save, ips_save, jps_save, get_dm_max_halo_width, & nest_pes_x, nest_pes_y, & intercomm_active, nest_task_offsets, & mpi_comm_to_mom, mpi_comm_to_kid, which_kid USE module_comm_nesting_dm, ONLY : halo_interp_up_sub USE module_utility IMPLICIT NONE TYPE(domain), POINTER :: grid TYPE(domain), POINTER :: intermediate_grid TYPE(domain), POINTER :: ngrid TYPE(domain), POINTER :: parent_grid real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_moist) :: moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_moist) :: dfi_moist real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_moist) :: dfi_moist_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_scalar) :: scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_scalar) :: scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_dfi_scalar) :: dfi_scalar real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_dfi_scalar) :: dfi_scalar_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_aerod) :: aerod real ,DIMENSION(grid%sm31:grid%em31,1:grid%levsiz,grid%sm33:grid%em33,num_ozmixm) :: ozmixm real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_1 real ,DIMENSION(grid%sm31:grid%em31,1:grid%paerlev,grid%sm33:grid%em33,num_aerosolc) :: aerosolc_2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_fdda3d) :: fdda3d real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_fdda2d) :: fdda2d real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_t) :: advh_t real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_t) :: advz_t real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit,grid%sm33:grid%em33,num_emis_ant) :: emis_ant real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_dust) :: emis_dust real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas) :: emis_seas real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfuture,grid%sm33:grid%em33,num_emis_seas2) :: emis_seas2 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_emis_vol) :: emis_vol real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ebu) :: ebu real ,DIMENSION(grid%sm31:grid%em31,1:grid%kfire,grid%sm33:grid%em33,num_ebu_in) :: ebu_in real ,DIMENSION(grid%sm31:grid%em31,1:grid%kemit_aircraft,grid%sm33:grid%em33,num_emis_aircraft) :: emis_aircraft real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_ext_coef) :: ext_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_bscat_coef) :: bscat_coef real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_asym_par) :: asym_par real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_conv_ct) :: conv_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem_ct) :: chem_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_vmix_ct) :: vmix_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advh_ct) :: advh_ct real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_advz_ct) :: advz_ct real ,DIMENSION(grid%sm31:grid%em31,1:grid%kdvel,grid%sm33:grid%em33,num_dvel) :: dvel real ,DIMENSION(grid%sm31:grid%em31,1:8,grid%sm33:grid%em33,num_vprm_in) :: vprm_in real ,DIMENSION(grid%sm31:grid%em31,1:1,grid%sm33:grid%em33,num_wet_in) :: wet_in real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_chem) :: chem real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_chem) :: chem_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_tracer) :: tracer real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_bye real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxs real ,DIMENSION(grid%sm33:grid%em33,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btxe real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btys real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%spec_bdy_width,num_tracer) :: tracer_btye real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_mij) :: nba_mij real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_nba_rij) :: nba_rij INTEGER nlev, msize INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe INTEGER :: nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe INTEGER :: xids, xide, xjds, xjde, xkds, xkde, & xims, xime, xjms, xjme, xkms, xkme, & xips, xipe, xjps, xjpe, xkps, xkpe INTEGER :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 INTEGER icoord, jcoord, idim_cd, jdim_cd INTEGER local_comm, myproc, nproc, ioffset INTEGER iparstrt, jparstrt, sw, thisdomain_max_halo_width REAL nest_influence character*256 :: timestr integer ierr LOGICAL, EXTERNAL :: cd_feedback_mask integer tjk nest_influence = 1. CALL domain_clock_get( grid, current_timestr=timestr ) CALL get_ijk_from_grid ( intermediate_grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) CALL get_ijk_from_grid ( grid , & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) CALL get_ijk_from_grid ( ngrid , & xids, xide, xjds, xjde, xkds, xkde, & xims, xime, xjms, xjme, xkms, xkme, & xips, xipe, xjps, xjpe, xkps, xkpe ) ips_save = ngrid%i_parent_start jps_save = ngrid%j_parent_start ipe_save = ngrid%i_parent_start + (xide-xids+1) / ngrid%parent_grid_ratio - 1 jpe_save = ngrid%j_parent_start + (xjde-xjds+1) / ngrid%parent_grid_ratio - 1 IF ( ngrid%active_this_task ) THEN CALL push_communicators_for_domain( ngrid%id ) do tjk = 1,config_flags%num_traj if (ngrid%traj_long(tjk) .eq. -9999.0) then ngrid%traj_long(tjk)=grid%traj_long(tjk) ngrid%traj_k(tjk)=grid%traj_k(tjk) else grid%traj_long(tjk)=ngrid%traj_long(tjk) grid%traj_k(tjk)=ngrid%traj_k(tjk) endif if (ngrid%traj_lat(tjk) .eq. -9999.0) then ngrid%traj_lat(tjk)=grid%traj_lat(tjk) ngrid%traj_k(tjk)=grid%traj_k(tjk) else grid%traj_lat(tjk)=ngrid%traj_lat(tjk) grid%traj_k(tjk)=ngrid%traj_k(tjk) endif enddo CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) CALL nl_get_shw ( intermediate_grid%id, sw ) icoord = iparstrt - sw jcoord = jparstrt - sw idim_cd = cide - cids + 1 jdim_cd = cjde - cjds + 1 nlev = ckde - ckds + 1 CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) parent_grid => grid grid => ngrid msize = (182 + ((num_moist - PARAM_FIRST_SCALAR + 1)) & + ((num_dfi_moist - PARAM_FIRST_SCALAR + 1)) & + ((num_scalar - PARAM_FIRST_SCALAR + 1)) & + ((num_dfi_scalar - PARAM_FIRST_SCALAR + 1)) & + ((num_aerod - PARAM_FIRST_SCALAR + 1)) & + ((num_ozmixm - PARAM_FIRST_SCALAR + 1)) & + ((num_aerosolc - PARAM_FIRST_SCALAR + 1)) & + ((num_fdda3d - PARAM_FIRST_SCALAR + 1)) & + ((num_fdda2d - PARAM_FIRST_SCALAR + 1)) & + ((num_advh_t - PARAM_FIRST_SCALAR + 1)) & + ((num_advz_t - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_ant - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_dust - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_seas - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_seas2 - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_vol - PARAM_FIRST_SCALAR + 1)) & + ((num_ebu - PARAM_FIRST_SCALAR + 1)) & + ((num_ebu_in - PARAM_FIRST_SCALAR + 1)) & + ((num_emis_aircraft - PARAM_FIRST_SCALAR + 1)) & + ((num_ext_coef - PARAM_FIRST_SCALAR + 1)) & + ((num_bscat_coef - PARAM_FIRST_SCALAR + 1)) & + ((num_asym_par - PARAM_FIRST_SCALAR + 1)) & + ((num_conv_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_chem_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_vmix_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_advh_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_advz_ct - PARAM_FIRST_SCALAR + 1)) & + ((num_dvel - PARAM_FIRST_SCALAR + 1)) & + ((num_vprm_in - PARAM_FIRST_SCALAR + 1)) & + ((num_wet_in - PARAM_FIRST_SCALAR + 1)) & + ((num_chem - PARAM_FIRST_SCALAR + 1)) & + ((num_tracer - PARAM_FIRST_SCALAR + 1)) & + ((num_nba_mij - PARAM_FIRST_SCALAR + 1)) & + ((num_nba_rij - PARAM_FIRST_SCALAR + 1)) )* nlev + 286 CALL rsl_lite_to_parent_info( msize*4 & ,cips,cipe,cjps,cjpe & ,nids,nide,njds,njde & ,nest_task_offsets(ngrid%id) & ,nest_pes_x(parent_grid%id) & ,nest_pes_y(parent_grid%id) & ,nest_pes_x(intermediate_grid%id) & ,nest_pes_y(intermediate_grid%id) & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) DO while ( retval .eq. 1 ) IF ( SIZE(grid%xlat) .GT. 1 ) THEN xv(1)= intermediate_grid%xlat(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xlong) .GT. 1 ) THEN xv(1)= intermediate_grid%xlong(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lu_index) .GT. 1 ) THEN xv(1)= intermediate_grid%lu_index(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%u_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%u_2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%v_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%v_2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%w_2) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= intermediate_grid%w_2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%ph_2) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= intermediate_grid%ph_2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%phb) .GT. 1 ) THEN DO k = ckds,ckde xv(k)= intermediate_grid%phb(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((ckde)-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%t_2) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%t_2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%mu_2) .GT. 1 ) THEN xv(1)= intermediate_grid%mu_2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%mub) .GT. 1 ) THEN xv(1)= intermediate_grid%mub(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%nest_pos) .GT. 1 ) THEN xv(1)= intermediate_grid%nest_pos(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%nest_mask) .GT. 1 ) THEN xv(1)= intermediate_grid%nest_mask(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%alb) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%alb(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%pb) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%pb(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%q2) .GT. 1 ) THEN xv(1)= intermediate_grid%q2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t2) .GT. 1 ) THEN xv(1)= intermediate_grid%t2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%th2) .GT. 1 ) THEN xv(1)= intermediate_grid%th2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%psfc) .GT. 1 ) THEN xv(1)= intermediate_grid%psfc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%u10) .GT. 1 ) THEN xv(1)= intermediate_grid%u10(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%v10) .GT. 1 ) THEN xv(1)= intermediate_grid%v10(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lpi) .GT. 1 ) THEN xv(1)= intermediate_grid%lpi(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist DO k = ckds,(ckde-1) xv(k)= intermediate_grid%moist(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist DO k = ckds,(ckde-1) xv(k)= intermediate_grid%dfi_moist(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%qvold) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%qvold(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qnwfa2d) .GT. 1 ) THEN xv(1)= intermediate_grid%qnwfa2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar DO k = ckds,(ckde-1) xv(k)= intermediate_grid%scalar(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar DO k = ckds,(ckde-1) xv(k)= intermediate_grid%dfi_scalar(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%toposlpx) .GT. 1 ) THEN xv(1)= intermediate_grid%toposlpx(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%toposlpy) .GT. 1 ) THEN xv(1)= intermediate_grid%toposlpy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%slope) .GT. 1 ) THEN xv(1)= intermediate_grid%slope(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%slp_azi) .GT. 1 ) THEN xv(1)= intermediate_grid%slp_azi(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%shdmax) .GT. 1 ) THEN xv(1)= intermediate_grid%shdmax(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%shdmin) .GT. 1 ) THEN xv(1)= intermediate_grid%shdmin(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%landusef) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= intermediate_grid%landusef(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%soilctop) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_cat xv(k)= intermediate_grid%soilctop(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%soilcbot) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_cat xv(k)= intermediate_grid%soilcbot(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tslb) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%tslb(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smois) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%smois(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh2o) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%sh2o(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smcrel) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%smcrel(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%xice) .GT. 1 ) THEN xv(1)= intermediate_grid%xice(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%icedepth) .GT. 1 ) THEN xv(1)= intermediate_grid%icedepth(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xicem) .GT. 1 ) THEN xv(1)= intermediate_grid%xicem(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%albsi) .GT. 1 ) THEN xv(1)= intermediate_grid%albsi(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snowsi) .GT. 1 ) THEN xv(1)= intermediate_grid%snowsi(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ivgtyp) .GT. 1 ) THEN xv(1)= intermediate_grid%ivgtyp(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%isltyp) .GT. 1 ) THEN xv(1)= intermediate_grid%isltyp(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%vegfra) .GT. 1 ) THEN xv(1)= intermediate_grid%vegfra(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acgrdflx) .GT. 1 ) THEN xv(1)= intermediate_grid%acgrdflx(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acsnow) .GT. 1 ) THEN xv(1)= intermediate_grid%acsnow(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acgraup) .GT. 1 ) THEN xv(1)= intermediate_grid%acgraup(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acrunoff) .GT. 1 ) THEN xv(1)= intermediate_grid%acrunoff(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acsnom) .GT. 1 ) THEN xv(1)= intermediate_grid%acsnom(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acfrain) .GT. 1 ) THEN xv(1)= intermediate_grid%acfrain(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snow) .GT. 1 ) THEN xv(1)= intermediate_grid%snow(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snowh) .GT. 1 ) THEN xv(1)= intermediate_grid%snowh(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%canwat) .GT. 1 ) THEN xv(1)= intermediate_grid%canwat(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%tr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tgr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%tgr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tb_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%tb_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tg_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%tg_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tc_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%tc_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%qc_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%qc_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%uc_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%uc_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xxxr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%xxxr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xxxb_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%xxxb_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xxxg_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%xxxg_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xxxc_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%xxxc_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%cmcr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%cmcr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%drelr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%drelr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%drelb_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%drelb_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%drelg_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%drelg_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumr_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%flxhumr_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumb_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%flxhumb_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%flxhumg_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%flxhumg_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tgrl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%tgrl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smr_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%smr_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%trl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%trl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tbl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%tbl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tgl_urb3d) .GT. 1 ) THEN DO k = 1,config_flags%num_soil_layers xv(k)= intermediate_grid%tgl_urb3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%sh_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lh_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%lh_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%g_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%g_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rn_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%rn_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ts_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%ts_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%frc_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%frc_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%utype_urb2d) .GT. 1 ) THEN xv(1)= intermediate_grid%utype_urb2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%imperv) .GT. 1 ) THEN xv(1)= intermediate_grid%imperv(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%canfra) .GT. 1 ) THEN xv(1)= intermediate_grid%canfra(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%var2d) .GT. 1 ) THEN xv(1)= intermediate_grid%var2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oc12d) .GT. 1 ) THEN xv(1)= intermediate_grid%oc12d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa1) .GT. 1 ) THEN xv(1)= intermediate_grid%oa1(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa2) .GT. 1 ) THEN xv(1)= intermediate_grid%oa2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa3) .GT. 1 ) THEN xv(1)= intermediate_grid%oa3(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa4) .GT. 1 ) THEN xv(1)= intermediate_grid%oa4(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol1) .GT. 1 ) THEN xv(1)= intermediate_grid%ol1(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol2) .GT. 1 ) THEN xv(1)= intermediate_grid%ol2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol3) .GT. 1 ) THEN xv(1)= intermediate_grid%ol3(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol4) .GT. 1 ) THEN xv(1)= intermediate_grid%ol4(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%var2dss) .GT. 1 ) THEN xv(1)= intermediate_grid%var2dss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oc12dss) .GT. 1 ) THEN xv(1)= intermediate_grid%oc12dss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa1ss) .GT. 1 ) THEN xv(1)= intermediate_grid%oa1ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa2ss) .GT. 1 ) THEN xv(1)= intermediate_grid%oa2ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa3ss) .GT. 1 ) THEN xv(1)= intermediate_grid%oa3ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%oa4ss) .GT. 1 ) THEN xv(1)= intermediate_grid%oa4ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol1ss) .GT. 1 ) THEN xv(1)= intermediate_grid%ol1ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol2ss) .GT. 1 ) THEN xv(1)= intermediate_grid%ol2ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol3ss) .GT. 1 ) THEN xv(1)= intermediate_grid%ol3ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ol4ss) .GT. 1 ) THEN xv(1)= intermediate_grid%ol4ss(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ctopo) .GT. 1 ) THEN xv(1)= intermediate_grid%ctopo(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ctopo2) .GT. 1 ) THEN xv(1)= intermediate_grid%ctopo2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%f_ice_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%f_ice_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%f_rain_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%f_rain_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%f_rimef_phy) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%f_rimef_phy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%om_tmp) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= intermediate_grid%om_tmp(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_s) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= intermediate_grid%om_s(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_u) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= intermediate_grid%om_u(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_v) .GT. 1 ) THEN DO k = 1,config_flags%ocean_levels xv(k)= intermediate_grid%om_v(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%om_ml) .GT. 1 ) THEN xv(1)= intermediate_grid%om_ml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%h_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%h_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qv_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%qv_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qc_diabatic) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%qc_diabatic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%msft) .GT. 1 ) THEN xv(1)= intermediate_grid%msft(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfu) .GT. 1 ) THEN xv(1)= intermediate_grid%msfu(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfv) .GT. 1 ) THEN xv(1)= intermediate_grid%msfv(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msftx) .GT. 1 ) THEN xv(1)= intermediate_grid%msftx(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfty) .GT. 1 ) THEN xv(1)= intermediate_grid%msfty(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfux) .GT. 1 ) THEN xv(1)= intermediate_grid%msfux(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfuy) .GT. 1 ) THEN xv(1)= intermediate_grid%msfuy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfvx) .GT. 1 ) THEN xv(1)= intermediate_grid%msfvx(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfvx_inv) .GT. 1 ) THEN xv(1)= intermediate_grid%msfvx_inv(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%msfvy) .GT. 1 ) THEN xv(1)= intermediate_grid%msfvy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%f) .GT. 1 ) THEN xv(1)= intermediate_grid%f(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%e) .GT. 1 ) THEN xv(1)= intermediate_grid%e(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%sina) .GT. 1 ) THEN xv(1)= intermediate_grid%sina(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%cosa) .GT. 1 ) THEN xv(1)= intermediate_grid%cosa(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ht) .GT. 1 ) THEN xv(1)= intermediate_grid%ht(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tsk) .GT. 1 ) THEN xv(1)= intermediate_grid%tsk(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rainc) .GT. 1 ) THEN xv(1)= intermediate_grid%rainc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rainsh) .GT. 1 ) THEN xv(1)= intermediate_grid%rainsh(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rainnc) .GT. 1 ) THEN xv(1)= intermediate_grid%rainnc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%frain) .GT. 1 ) THEN xv(1)= intermediate_grid%frain(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_rainc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_rainc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_rainnc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_rainnc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snownc) .GT. 1 ) THEN xv(1)= intermediate_grid%snownc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%graupelnc) .GT. 1 ) THEN xv(1)= intermediate_grid%graupelnc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%hailnc) .GT. 1 ) THEN xv(1)= intermediate_grid%hailnc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%refl_10cm(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%composite_refl_10cm) .GT. 1 ) THEN xv(1)= intermediate_grid%composite_refl_10cm(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm_1km) .GT. 1 ) THEN xv(1)= intermediate_grid%refl_10cm_1km(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%refl_10cm_4km) .GT. 1 ) THEN xv(1)= intermediate_grid%refl_10cm_4km(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%th_old) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%th_old(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%qv_old) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%qv_old(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%vmi3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%vmi3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%di3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%di3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%rhopo3d) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%rhopo3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%w_up) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%w_up(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%acswupt) .GT. 1 ) THEN xv(1)= intermediate_grid%acswupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%acswuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%acswdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%acswdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswupb) .GT. 1 ) THEN xv(1)= intermediate_grid%acswupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%acswupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%acswdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%acswdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%acswdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupt) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupb) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclwdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%aclwdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupt) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupb) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_acswdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_acswdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupt) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupb) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%i_aclwdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%i_aclwdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swupt) .GT. 1 ) THEN xv(1)= intermediate_grid%swupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%swuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%swdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%swdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swupb) .GT. 1 ) THEN xv(1)= intermediate_grid%swupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%swupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%swdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%swdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%swdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwupt) .GT. 1 ) THEN xv(1)= intermediate_grid%lwupt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwuptc) .GT. 1 ) THEN xv(1)= intermediate_grid%lwuptc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnt) .GT. 1 ) THEN xv(1)= intermediate_grid%lwdnt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwdntc) .GT. 1 ) THEN xv(1)= intermediate_grid%lwdntc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwupb) .GT. 1 ) THEN xv(1)= intermediate_grid%lwupb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwupbc) .GT. 1 ) THEN xv(1)= intermediate_grid%lwupbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnb) .GT. 1 ) THEN xv(1)= intermediate_grid%lwdnb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lwdnbc) .GT. 1 ) THEN xv(1)= intermediate_grid%lwdnbc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xlat_u) .GT. 1 ) THEN xv(1)= intermediate_grid%xlat_u(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xlong_u) .GT. 1 ) THEN xv(1)= intermediate_grid%xlong_u(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xlat_v) .GT. 1 ) THEN xv(1)= intermediate_grid%xlat_v(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xlong_v) .GT. 1 ) THEN xv(1)= intermediate_grid%xlong_v(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%clat) .GT. 1 ) THEN xv(1)= intermediate_grid%clat(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%isnowxy) .GT. 1 ) THEN xv(1)= intermediate_grid%isnowxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tgxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tgxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%canicexy) .GT. 1 ) THEN xv(1)= intermediate_grid%canicexy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%canliqxy) .GT. 1 ) THEN xv(1)= intermediate_grid%canliqxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%eahxy) .GT. 1 ) THEN xv(1)= intermediate_grid%eahxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tahxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tahxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%cmxy) .GT. 1 ) THEN xv(1)= intermediate_grid%cmxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%fwetxy) .GT. 1 ) THEN xv(1)= intermediate_grid%fwetxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%sneqvoxy) .GT. 1 ) THEN xv(1)= intermediate_grid%sneqvoxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%alboldxy) .GT. 1 ) THEN xv(1)= intermediate_grid%alboldxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%qsnowxy) .GT. 1 ) THEN xv(1)= intermediate_grid%qsnowxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%wslakexy) .GT. 1 ) THEN xv(1)= intermediate_grid%wslakexy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%zwtxy) .GT. 1 ) THEN xv(1)= intermediate_grid%zwtxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%waxy) .GT. 1 ) THEN xv(1)= intermediate_grid%waxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%wtxy) .GT. 1 ) THEN xv(1)= intermediate_grid%wtxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tsnoxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= intermediate_grid%tsnoxy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%zsnsoxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snso_layers xv(k)= intermediate_grid%zsnsoxy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_snso_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snicexy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= intermediate_grid%snicexy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snliqxy) .GT. 1 ) THEN DO k = 1,config_flags%num_snow_layers xv(k)= intermediate_grid%snliqxy(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lfmassxy) .GT. 1 ) THEN xv(1)= intermediate_grid%lfmassxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rtmassxy) .GT. 1 ) THEN xv(1)= intermediate_grid%rtmassxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%stmassxy) .GT. 1 ) THEN xv(1)= intermediate_grid%stmassxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%woodxy) .GT. 1 ) THEN xv(1)= intermediate_grid%woodxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%stblcpxy) .GT. 1 ) THEN xv(1)= intermediate_grid%stblcpxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%fastcpxy) .GT. 1 ) THEN xv(1)= intermediate_grid%fastcpxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%xsaixy) .GT. 1 ) THEN xv(1)= intermediate_grid%xsaixy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t2mvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%t2mvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t2mbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%t2mbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%q2mvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%q2mvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%q2mbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%q2mbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tradxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tradxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%neexy) .GT. 1 ) THEN xv(1)= intermediate_grid%neexy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%gppxy) .GT. 1 ) THEN xv(1)= intermediate_grid%gppxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%nppxy) .GT. 1 ) THEN xv(1)= intermediate_grid%nppxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%fvegxy) .GT. 1 ) THEN xv(1)= intermediate_grid%fvegxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%qinxy) .GT. 1 ) THEN xv(1)= intermediate_grid%qinxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%runsfxy) .GT. 1 ) THEN xv(1)= intermediate_grid%runsfxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%runsbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%runsbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ecanxy) .GT. 1 ) THEN xv(1)= intermediate_grid%ecanxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%edirxy) .GT. 1 ) THEN xv(1)= intermediate_grid%edirxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%etranxy) .GT. 1 ) THEN xv(1)= intermediate_grid%etranxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%fsaxy) .GT. 1 ) THEN xv(1)= intermediate_grid%fsaxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%firaxy) .GT. 1 ) THEN xv(1)= intermediate_grid%firaxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aparxy) .GT. 1 ) THEN xv(1)= intermediate_grid%aparxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%psnxy) .GT. 1 ) THEN xv(1)= intermediate_grid%psnxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%savxy) .GT. 1 ) THEN xv(1)= intermediate_grid%savxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%sagxy) .GT. 1 ) THEN xv(1)= intermediate_grid%sagxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rssunxy) .GT. 1 ) THEN xv(1)= intermediate_grid%rssunxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rsshaxy) .GT. 1 ) THEN xv(1)= intermediate_grid%rsshaxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%bgapxy) .GT. 1 ) THEN xv(1)= intermediate_grid%bgapxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%wgapxy) .GT. 1 ) THEN xv(1)= intermediate_grid%wgapxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tgvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tgvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tgbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%tgbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%shgxy) .GT. 1 ) THEN xv(1)= intermediate_grid%shgxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%shcxy) .GT. 1 ) THEN xv(1)= intermediate_grid%shcxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%shbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%shbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%evgxy) .GT. 1 ) THEN xv(1)= intermediate_grid%evgxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%evbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%evbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ghvxy) .GT. 1 ) THEN xv(1)= intermediate_grid%ghvxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ghbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%ghbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%irgxy) .GT. 1 ) THEN xv(1)= intermediate_grid%irgxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%ircxy) .GT. 1 ) THEN xv(1)= intermediate_grid%ircxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%irbxy) .GT. 1 ) THEN xv(1)= intermediate_grid%irbxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%trxy) .GT. 1 ) THEN xv(1)= intermediate_grid%trxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%evcxy) .GT. 1 ) THEN xv(1)= intermediate_grid%evcxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chleafxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chleafxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chucxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chucxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chv2xy) .GT. 1 ) THEN xv(1)= intermediate_grid%chv2xy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chb2xy) .GT. 1 ) THEN xv(1)= intermediate_grid%chb2xy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%chstarxy) .GT. 1 ) THEN xv(1)= intermediate_grid%chstarxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%fdepthxy) .GT. 1 ) THEN xv(1)= intermediate_grid%fdepthxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%eqzwt) .GT. 1 ) THEN xv(1)= intermediate_grid%eqzwt(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rechclim) .GT. 1 ) THEN xv(1)= intermediate_grid%rechclim(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%rivermask) .GT. 1 ) THEN xv(1)= intermediate_grid%rivermask(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%riverbedxy) .GT. 1 ) THEN xv(1)= intermediate_grid%riverbedxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%nonriverxy) .GT. 1 ) THEN xv(1)= intermediate_grid%nonriverxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%grainxy) .GT. 1 ) THEN xv(1)= intermediate_grid%grainxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%gddxy) .GT. 1 ) THEN xv(1)= intermediate_grid%gddxy(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%croptype) .GT. 1 ) THEN DO k = 1,5 xv(k)= intermediate_grid%croptype(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((5)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%planting) .GT. 1 ) THEN xv(1)= intermediate_grid%planting(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%harvest) .GT. 1 ) THEN xv(1)= intermediate_grid%harvest(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%season_gdd) .GT. 1 ) THEN xv(1)= intermediate_grid%season_gdd(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tsk_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%tsk_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qsfc_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%qsfc_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tslb_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%tslb_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%smois_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%smois_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sh2o_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%sh2o_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%canwat_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%canwat_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snow_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%snow_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowh_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%snowh_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowc_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%snowc_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tr_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%tr_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tb_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%tb_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tg_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%tg_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%tc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%ts_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%ts_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%ts_rul2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%ts_rul2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%qc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%uc_urb2d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat xv(k)= intermediate_grid%uc_urb2d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%trl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%trl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tbl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%tbl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tgl_urb3d_mosaic) .GT. 1 ) THEN DO k = 1,config_flags%mosaic_cat_soil xv(k)= intermediate_grid%tgl_urb3d_mosaic(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%mosaic_cat_index) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= intermediate_grid%mosaic_cat_index(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%landusef2) .GT. 1 ) THEN DO k = 1,config_flags%num_land_cat xv(k)= intermediate_grid%landusef2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tmn) .GT. 1 ) THEN xv(1)= intermediate_grid%tmn(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tyr) .GT. 1 ) THEN xv(1)= intermediate_grid%tyr(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tyra) .GT. 1 ) THEN xv(1)= intermediate_grid%tyra(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tdly) .GT. 1 ) THEN xv(1)= intermediate_grid%tdly(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tlag) .GT. 1 ) THEN DO k = 1,config_flags%lagday xv(k)= intermediate_grid%tlag(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%lagday)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%xland) .GT. 1 ) THEN xv(1)= intermediate_grid%xland(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%achfx) .GT. 1 ) THEN xv(1)= intermediate_grid%achfx(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%aclhf) .GT. 1 ) THEN xv(1)= intermediate_grid%aclhf(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snowc) .GT. 1 ) THEN xv(1)= intermediate_grid%snowc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_c) .GT. 1 ) THEN xv(1)= intermediate_grid%prec_acc_c(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_c1) .GT. 1 ) THEN xv(1)= intermediate_grid%prec_acc_c1(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_nc) .GT. 1 ) THEN xv(1)= intermediate_grid%prec_acc_nc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%prec_acc_nc1) .GT. 1 ) THEN xv(1)= intermediate_grid%prec_acc_nc1(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snow_acc_nc) .GT. 1 ) THEN xv(1)= intermediate_grid%snow_acc_nc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snow_acc_nc1) .GT. 1 ) THEN xv(1)= intermediate_grid%snow_acc_nc1(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tml) .GT. 1 ) THEN xv(1)= intermediate_grid%tml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t0ml) .GT. 1 ) THEN xv(1)= intermediate_grid%t0ml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%hml) .GT. 1 ) THEN xv(1)= intermediate_grid%hml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%h0ml) .GT. 1 ) THEN xv(1)= intermediate_grid%h0ml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%huml) .GT. 1 ) THEN xv(1)= intermediate_grid%huml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%hvml) .GT. 1 ) THEN xv(1)= intermediate_grid%hvml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%tmoml) .GT. 1 ) THEN xv(1)= intermediate_grid%tmoml(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%erod) .GT. 1 ) THEN DO k = 1,config_flags%erosion_dim xv(k)= intermediate_grid%erod(pig,pjg,k) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%erosion_dim)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%qlsink) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%qlsink(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precr) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%precr(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%preci) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%preci(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precs) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%precs(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF IF ( SIZE(grid%precg) .GT. 1 ) THEN DO k = ckds,(ckde-1) xv(k)= intermediate_grid%precg(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem DO k = ckds,(ckde-1) xv(k)= intermediate_grid%chem(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer DO k = ckds,(ckde-1) xv(k)= intermediate_grid%tracer(pig,k,pjg,itrace) ENDDO CALL rsl_lite_to_parent_msg((((ckde-1))-(ckds)+1)*4,xv) ENDDO IF ( SIZE(grid%numc) .GT. 1 ) THEN xv(1)= intermediate_grid%numc(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%nump) .GT. 1 ) THEN xv(1)= intermediate_grid%nump(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snl) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snl(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowdp) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowdp(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%wtc) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%wtc(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%wtp) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%wtp(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osno) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osno(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_grnd) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_grnd(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_veg) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_veg(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2ocan) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2ocan(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2ocan_col) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2ocan_col(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t2m_max) .GT. 1 ) THEN xv(1)= intermediate_grid%t2m_max(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t2m_min) .GT. 1 ) THEN xv(1)= intermediate_grid%t2m_min(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t2clm) .GT. 1 ) THEN xv(1)= intermediate_grid%t2clm(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t_ref2m) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_ref2m(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq6(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq7(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq8(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq9(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_liq10(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice6(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice7(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice8(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice9(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_ice10(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno_s1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno_s2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno_s3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno_s4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno_s5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno_s5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno6(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno7(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno8(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno9(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_soisno10(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%dzsnow1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%dzsnow2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%dzsnow3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%dzsnow4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dzsnow5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%dzsnow5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowrds1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowrds2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowrds3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowrds4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%snowrds5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%snowrds5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake6(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake7(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake8(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake9(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_lake10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%t_lake10(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol1) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol1(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol2) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol2(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol3) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol3(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol4) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol4(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol5) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol5(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol6) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol6(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol7) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol7(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol8) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol8(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol9) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol9(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol10) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%h2osoi_vol10(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%albedosubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%albedosubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lhsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%lhsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%hfxsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%hfxsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lwupsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%lwupsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%q2subgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%q2subgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sabvsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%sabvsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%sabgsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%sabgsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%nrasubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%nrasubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%swupsubgrid) .GT. 1 ) THEN DO k = 1,config_flags%maxpatch xv(k)= intermediate_grid%swupsubgrid(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lakedepth2d) .GT. 1 ) THEN xv(1)= intermediate_grid%lakedepth2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%savedtke12d) .GT. 1 ) THEN xv(1)= intermediate_grid%savedtke12d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snowdp2d) .GT. 1 ) THEN xv(1)= intermediate_grid%snowdp2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%h2osno2d) .GT. 1 ) THEN xv(1)= intermediate_grid%h2osno2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%snl2d) .GT. 1 ) THEN xv(1)= intermediate_grid%snl2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t_grnd2d) .GT. 1 ) THEN xv(1)= intermediate_grid%t_grnd2d(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%t_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%t_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%lake_icefrac3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%lake_icefrac3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%z_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%z_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dz_lake3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%dz_lake3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%t_soisno3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%t_soisno3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_ice3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%h2osoi_ice3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_liq3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%h2osoi_liq3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%h2osoi_vol3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%h2osoi_vol3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%z3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%z3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%dz3d) .GT. 1 ) THEN DO k = 1,15 xv(k)= intermediate_grid%dz3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((15)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%zi3d) .GT. 1 ) THEN DO k = 1,16 xv(k)= intermediate_grid%zi3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((16)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%watsat3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%watsat3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%csol3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%csol3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tkmg3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%tkmg3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tkdry3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%tkdry3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%tksatu3d) .GT. 1 ) THEN DO k = 1,10 xv(k)= intermediate_grid%tksatu3d(pig,k,pjg) ENDDO CALL rsl_lite_to_parent_msg(((10)-(1)+1)*4,xv) ENDIF IF ( SIZE(grid%pcb) .GT. 1 ) THEN xv(1)= intermediate_grid%pcb(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%pc_2) .GT. 1 ) THEN xv(1)= intermediate_grid%pc_2(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%landmask) .GT. 1 ) THEN xv(1)= intermediate_grid%landmask(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF IF ( SIZE(grid%lakemask) .GT. 1 ) THEN xv(1)= intermediate_grid%lakemask(pig,pjg) CALL rsl_lite_to_parent_msg(4,xv) ENDIF CALL rsl_lite_to_parent_info( msize*4 & ,cips,cipe,cjps,cjpe & ,nids,nide,njds,njde & ,nest_task_offsets(ngrid%id) & ,nest_pes_x(parent_grid%id) & ,nest_pes_y(parent_grid%id) & ,nest_pes_x(intermediate_grid%id) & ,nest_pes_y(intermediate_grid%id) & ,thisdomain_max_halo_width & ,icoord,jcoord & ,idim_cd,jdim_cd & ,pig,pjg,retval ) ENDDO grid => parent_grid CALL pop_communicators_for_domain END IF IF ( intercomm_active( grid%id ) ) THEN local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) ioffset = nest_task_offsets(ngrid%id) ELSE IF ( intercomm_active( ngrid%id ) ) THEN local_comm = mpi_comm_to_mom( ngrid%id ) ioffset = nest_task_offsets(ngrid%id) END IF IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN CALL mpi_comm_rank(local_comm,myproc,ierr) CALL mpi_comm_size(local_comm,nproc,ierr) CALL rsl_lite_merge_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & ioffset, local_comm ) END IF IF ( grid%active_this_task ) THEN CALL push_communicators_for_domain( grid%id ) CALL rsl_lite_from_child_info(pig,pjg,retval) DO while ( retval .eq. 1 ) IF ( SIZE(grid%xlat) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xlat(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xlong) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xlong(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lu_index) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lu_index(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%u_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%u_2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%v_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN DO k = ckds,(ckde-1) grid%v_2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%w_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((ckde)-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,ckde grid%w_2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%ph_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((ckde)-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,ckde grid%ph_2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%phb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((ckde)-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,ckde grid%phb(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%t_2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%mu_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%mu_2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%mub) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%mub(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%nest_pos) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%nest_pos(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%nest_mask) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%nest_mask(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%alb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%alb(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%pb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%pb(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%q2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%q2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%th2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%th2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%psfc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%psfc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%u10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%u10(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%v10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%v10(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lpi) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lpi(pig,pjg) = xv(1) ENDIF ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) dfi_moist(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO IF ( SIZE(grid%qvold) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%qvold(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qnwfa2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%qnwfa2d(pig,pjg) = xv(1) ENDIF ENDIF DO itrace = PARAM_FIRST_SCALAR, num_scalar CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) dfi_scalar(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO IF ( SIZE(grid%toposlpx) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%toposlpx(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%toposlpy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%toposlpy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%slope) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%slope(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%slp_azi) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%slp_azi(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%shdmax) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%shdmax(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%shdmin) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%shdmin(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%landusef) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_land_cat grid%landusef(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%soilctop) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_cat grid%soilctop(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%soilcbot) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_cat grid%soilcbot(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tslb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%tslb(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%smois) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%smois(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%sh2o) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%sh2o(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%smcrel) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%smcrel(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%xice) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xice(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%icedepth) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%icedepth(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xicem) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xicem(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%albsi) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%albsi(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snowsi) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snowsi(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ivgtyp) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ivgtyp(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%isltyp) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%isltyp(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%vegfra) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%vegfra(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acgrdflx) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acgrdflx(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acsnow) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acsnow(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acgraup) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acgraup(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acrunoff) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acrunoff(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acsnom) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acsnom(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acfrain) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acfrain(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snow) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snow(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snowh) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snowh(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%canwat) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%canwat(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tgr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tgr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tb_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tg_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tc_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%qc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%qc_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%uc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%uc_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xxxr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xxxr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xxxb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xxxb_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xxxg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xxxg_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xxxc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xxxc_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%cmcr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%cmcr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%drelr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%drelr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%drelb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%drelb_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%drelg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%drelg_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%flxhumr_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%flxhumr_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%flxhumb_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%flxhumb_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%flxhumg_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%flxhumg_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tgrl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%tgrl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%smr_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%smr_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%trl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%trl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tbl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%tbl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tgl_urb3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_soil_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_soil_layers grid%tgl_urb3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%sh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%sh_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lh_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lh_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%g_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%g_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rn_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rn_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ts_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ts_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%frc_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%frc_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%utype_urb2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%utype_urb2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%imperv) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%imperv(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%canfra) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%canfra(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%var2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%var2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oc12d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oc12d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa1(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa3(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa4(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol1(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol3(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol4(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%var2dss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%var2dss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oc12dss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oc12dss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa1ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa1ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa2ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa2ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa3ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa3ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%oa4ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%oa4ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol1ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol1ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol2ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol2ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol3ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol3ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ol4ss) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ol4ss(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ctopo) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ctopo(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ctopo2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ctopo2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%f_ice_phy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%f_ice_phy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%f_rain_phy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%f_rain_phy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%f_rimef_phy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%f_rimef_phy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%om_tmp) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%ocean_levels grid%om_tmp(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%om_s) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%ocean_levels grid%om_s(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%om_u) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%ocean_levels grid%om_u(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%om_v) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%ocean_levels)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%ocean_levels grid%om_v(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%om_ml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%om_ml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%h_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%h_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qv_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%qv_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qc_diabatic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%qc_diabatic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%msft) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%msft(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfu) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN grid%msfu(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfv) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%msfv(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msftx) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%msftx(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfty) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%msfty(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfux) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN grid%msfux(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfuy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN grid%msfuy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfvx) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%msfvx(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfvx_inv) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%msfvx_inv(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%msfvy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%msfvy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%f) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%f(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%e) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%e(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%sina) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%sina(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%cosa) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%cosa(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ht) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ht(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tsk) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tsk(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rainc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rainc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rainsh) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rainsh(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rainnc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rainnc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%frain) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%frain(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_rainc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_rainc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_rainnc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_rainnc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snownc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snownc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%graupelnc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%graupelnc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%hailnc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%hailnc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%refl_10cm(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%composite_refl_10cm) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%composite_refl_10cm(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%refl_10cm_1km) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%refl_10cm_1km(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%refl_10cm_4km) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%refl_10cm_4km(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%th_old) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%th_old(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qv_old) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%qv_old(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%vmi3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%vmi3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%di3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%di3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%rhopo3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%rhopo3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%w_up) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%w_up(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%acswupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%acswdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclwdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_acswdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_acswdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%i_aclwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%i_aclwdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%swdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%swdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwupt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwupt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwuptc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwuptc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwdnt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwdnt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwdntc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwdntc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwupb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwupb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwupbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwupbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwdnb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwdnb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lwdnbc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lwdnbc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xlat_u) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN grid%xlat_u(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xlong_u) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .TRUE., .FALSE. ) ) THEN grid%xlong_u(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xlat_v) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%xlat_v(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xlong_v) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .TRUE. ) ) THEN grid%xlong_v(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%clat) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%clat(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%isnowxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%isnowxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tgxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tgxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%canicexy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%canicexy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%canliqxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%canliqxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%eahxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%eahxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tahxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tahxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%cmxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%cmxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%fwetxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%fwetxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%sneqvoxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%sneqvoxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%alboldxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%alboldxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%qsnowxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%qsnowxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%wslakexy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%wslakexy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%zwtxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%zwtxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%waxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%waxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%wtxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%wtxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tsnoxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_snow_layers grid%tsnoxy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%zsnsoxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_snso_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_snso_layers grid%zsnsoxy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snicexy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_snow_layers grid%snicexy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snliqxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_snow_layers)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_snow_layers grid%snliqxy(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%lfmassxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lfmassxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rtmassxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rtmassxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%stmassxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%stmassxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%woodxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%woodxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%stblcpxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%stblcpxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%fastcpxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%fastcpxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%xsaixy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xsaixy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2mvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2mbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%q2mvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%q2mvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%q2mbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%q2mbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tradxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tradxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%neexy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%neexy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%gppxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%gppxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%nppxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%nppxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%fvegxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%fvegxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%qinxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%qinxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%runsfxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%runsfxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%runsbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%runsbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ecanxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ecanxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%edirxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%edirxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%etranxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%etranxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%fsaxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%fsaxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%firaxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%firaxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aparxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aparxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%psnxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%psnxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%savxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%savxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%sagxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%sagxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rssunxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rssunxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rsshaxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rsshaxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%bgapxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%bgapxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%wgapxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%wgapxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tgvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tgvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tgbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tgbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%shgxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%shgxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%shcxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%shcxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%shbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%shbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%evgxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%evgxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%evbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%evbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ghvxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ghvxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ghbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ghbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%irgxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%irgxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%ircxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%ircxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%irbxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%irbxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%trxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%trxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%evcxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%evcxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chleafxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chleafxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chucxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chucxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chv2xy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chv2xy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chb2xy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chb2xy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%chstarxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%chstarxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%fdepthxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%fdepthxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%eqzwt) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%eqzwt(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rechclim) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rechclim(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%rivermask) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%rivermask(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%riverbedxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%riverbedxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%nonriverxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%nonriverxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%grainxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%grainxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%gddxy) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%gddxy(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%croptype) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((5)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,5 grid%croptype(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%planting) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%planting(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%harvest) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%harvest(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%season_gdd) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%season_gdd(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tsk_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%tsk_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qsfc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%qsfc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tslb_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%tslb_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%smois_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%smois_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%sh2o_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%sh2o_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%canwat_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%canwat_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snow_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%snow_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowh_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%snowh_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowc_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%snowc_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tr_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%tr_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tb_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%tb_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tg_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%tg_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%tc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%ts_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%ts_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%ts_rul2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%ts_rul2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%qc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%uc_urb2d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat grid%uc_urb2d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%trl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%trl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tbl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%tbl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tgl_urb3d_mosaic) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%mosaic_cat_soil)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%mosaic_cat_soil grid%tgl_urb3d_mosaic(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%mosaic_cat_index) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_land_cat grid%mosaic_cat_index(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%landusef2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%num_land_cat)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%num_land_cat grid%landusef2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tmn) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tmn(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tyr) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tyr(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tyra) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tyra(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tdly) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tdly(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tlag) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%lagday)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%lagday grid%tlag(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%xland) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%xland(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%achfx) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%achfx(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%aclhf) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%aclhf(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snowc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snowc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%prec_acc_c) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%prec_acc_c(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%prec_acc_c1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%prec_acc_c1(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%prec_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%prec_acc_nc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%prec_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%prec_acc_nc1(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snow_acc_nc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snow_acc_nc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snow_acc_nc1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snow_acc_nc1(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t0ml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t0ml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%hml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%hml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%h0ml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%h0ml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%huml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%huml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%hvml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%hvml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%tmoml) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%tmoml(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%erod) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%erosion_dim)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%erosion_dim grid%erod(pig,pjg,k) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%qlsink) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%qlsink(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%precr) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%precr(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%preci) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%preci(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%precs) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%precs(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%precg) .GT. 1 ) THEN CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) grid%precg(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) chem(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer CALL rsl_lite_from_child_msg((((ckde-1))-(ckds)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = ckds,(ckde-1) tracer(pig,k,pjg,itrace) = xv(k) ENDDO ENDIF ENDDO IF ( SIZE(grid%numc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%numc(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%nump) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%nump(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snl) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snl(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowdp) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowdp(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%wtc) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%wtc(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%wtp) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%wtp(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osno) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osno(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_grnd) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_grnd(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_veg) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_veg(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2ocan) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2ocan(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2ocan_col) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2ocan_col(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t2m_max) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2m_max(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t2m_min) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2m_min(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t2clm) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t2clm(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t_ref2m) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_ref2m(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq_s1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq_s2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq_s3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq_s4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq_s5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq_s5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq6) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq6(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq7) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq7(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq8) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq8(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq9) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq9(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_liq10(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice_s1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice_s2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice_s3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice_s4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice_s5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice_s5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice6) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice6(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice7) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice7(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice8) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice8(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice9) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice9(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_ice10(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno_s1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno_s1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno_s2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno_s2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno_s3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno_s3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno_s4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno_s4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno_s5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno_s5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno6) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno6(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno7) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno7(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno8) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno8(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno9) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno9(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_soisno10(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dzsnow1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%dzsnow1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dzsnow2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%dzsnow2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dzsnow3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%dzsnow3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dzsnow4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%dzsnow4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dzsnow5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%dzsnow5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowrds1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowrds1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowrds2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowrds2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowrds3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowrds3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowrds4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowrds4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%snowrds5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%snowrds5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake6) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake6(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake7) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake7(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake8) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake8(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake9) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake9(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_lake10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%t_lake10(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol1) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol1(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol2(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol3) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol3(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol4) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol4(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol5) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol5(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol6) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol6(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol7) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol7(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol8) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol8(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol9) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol9(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol10) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%h2osoi_vol10(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%albedosubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%albedosubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%lhsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%lhsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%hfxsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%hfxsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%lwupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%lwupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%q2subgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%q2subgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%sabvsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%sabvsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%sabgsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%sabgsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%nrasubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%nrasubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%swupsubgrid) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((config_flags%maxpatch)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,config_flags%maxpatch grid%swupsubgrid(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%lakedepth2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lakedepth2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%savedtke12d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%savedtke12d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snowdp2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snowdp2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%h2osno2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%h2osno2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%snl2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%snl2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t_grnd2d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%t_grnd2d(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%t_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%t_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%lake_icefrac3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%lake_icefrac3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%z_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%z_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dz_lake3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%dz_lake3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%t_soisno3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%t_soisno3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_ice3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%h2osoi_ice3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_liq3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%h2osoi_liq3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%h2osoi_vol3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%h2osoi_vol3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%z3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%z3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%dz3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((15)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,15 grid%dz3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%zi3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((16)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,16 grid%zi3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%watsat3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%watsat3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%csol3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%csol3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tkmg3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%tkmg3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tkdry3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%tkdry3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%tksatu3d) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(((10)-(1)+1)*4,xv) ; IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN DO k = 1,10 grid%tksatu3d(pig,k,pjg) = xv(k) ENDDO ENDIF ENDIF IF ( SIZE(grid%pcb) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%pcb(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%pc_2) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%pc_2(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%landmask) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%landmask(pig,pjg) = xv(1) ENDIF ENDIF IF ( SIZE(grid%lakemask) .GT. 1 ) THEN CALL rsl_lite_from_child_msg(4,xv) IF ( cd_feedback_mask( pig, ips_save, ipe_save , pjg, jps_save, jpe_save, .FALSE., .FALSE. ) ) THEN grid%lakemask(pig,pjg) = xv(1) ENDIF ENDIF CALL rsl_lite_from_child_info(pig,pjg,retval) ENDDO CALL get_ijk_from_grid ( ngrid, & nids, nide, njds, njde, nkds, nkde, & nims, nime, njms, njme, nkms, nkme, & nips, nipe, njps, njpe, nkps, nkpe ) CALL get_ijk_from_grid ( grid , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL HALO_INTERP_UP_sub ( grid, & config_flags, & num_moist, & moist, & num_dfi_moist, & dfi_moist, & num_scalar, & scalar, & num_dfi_scalar, & dfi_scalar, & num_chem, & chem, & num_tracer, & tracer, & local_communicator, & mytask, ntasks, ntasks_x, ntasks_y, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe ) CALL get_ijk_from_grid ( grid , & cids, cide, cjds, cjde, ckds, ckde, & cims, cime, cjms, cjme, ckms, ckme, & cips, cipe, cjps, cjpe, ckps, ckpe ) IF ( SIZE( grid%u_2, 1 ) * SIZE( grid%u_2, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%u_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .TRUE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%v_2, 1 ) * SIZE( grid%v_2, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%v_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .TRUE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%w_2, 1 ) * SIZE( grid%w_2, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%w_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ph_2, 1 ) * SIZE( grid%ph_2, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%ph_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%phb, 1 ) * SIZE( grid%phb, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%phb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%t_2, 1 ) * SIZE( grid%t_2, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%t_2, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mu_2, 1 ) * SIZE( grid%mu_2, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%mu_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%mub, 1 ) * SIZE( grid%mub, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%mub, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%alb, 1 ) * SIZE( grid%alb, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%alb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pb, 1 ) * SIZE( grid%pb, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%pb, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_moist IF ( SIZE( moist, 1 ) * SIZE( moist, 3 ) .GT. 1 ) THEN CALL smoother ( & moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_moist IF ( SIZE( dfi_moist, 1 ) * SIZE( dfi_moist, 3 ) .GT. 1 ) THEN CALL smoother ( & dfi_moist(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_scalar IF ( SIZE( scalar, 1 ) * SIZE( scalar, 3 ) .GT. 1 ) THEN CALL smoother ( & scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_dfi_scalar IF ( SIZE( dfi_scalar, 1 ) * SIZE( dfi_scalar, 3 ) .GT. 1 ) THEN CALL smoother ( & dfi_scalar(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%var2d, 1 ) * SIZE( grid%var2d, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%var2d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12d, 1 ) * SIZE( grid%oc12d, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oc12d, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1, 1 ) * SIZE( grid%oa1, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2, 1 ) * SIZE( grid%oa2, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3, 1 ) * SIZE( grid%oa3, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4, 1 ) * SIZE( grid%oa4, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1, 1 ) * SIZE( grid%ol1, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol1, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2, 1 ) * SIZE( grid%ol2, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3, 1 ) * SIZE( grid%ol3, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol3, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4, 1 ) * SIZE( grid%ol4, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol4, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%var2dss, 1 ) * SIZE( grid%var2dss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%var2dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oc12dss, 1 ) * SIZE( grid%oc12dss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oc12dss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa1ss, 1 ) * SIZE( grid%oa1ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa2ss, 1 ) * SIZE( grid%oa2ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa3ss, 1 ) * SIZE( grid%oa3ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%oa4ss, 1 ) * SIZE( grid%oa4ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%oa4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol1ss, 1 ) * SIZE( grid%ol1ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol1ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol2ss, 1 ) * SIZE( grid%ol2ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol2ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol3ss, 1 ) * SIZE( grid%ol3ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol3ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ol4ss, 1 ) * SIZE( grid%ol4ss, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ol4ss, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%ht, 1 ) * SIZE( grid%ht, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%ht, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%th_old, 1 ) * SIZE( grid%th_old, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%th_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%qv_old, 1 ) * SIZE( grid%qv_old, 3 ) .GT. 1 ) THEN CALL smoother ( & grid%qv_old, & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF DO itrace = PARAM_FIRST_SCALAR, num_chem IF ( SIZE( chem, 1 ) * SIZE( chem, 3 ) .GT. 1 ) THEN CALL smoother ( & chem(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO DO itrace = PARAM_FIRST_SCALAR, num_tracer IF ( SIZE( tracer, 1 ) * SIZE( tracer, 3 ) .GT. 1 ) THEN CALL smoother ( & tracer(grid%sm31,grid%sm32,grid%sm33,itrace), & cids, cide, ckds, ckde, cjds, cjde, & cims, cime, ckms, ckme, cjms, cjme, & cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & nids, nide, nkds, nkde, njds, njde, & nims, nime, nkms, nkme, njms, njme, & nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF ENDDO IF ( SIZE( grid%pcb, 1 ) * SIZE( grid%pcb, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%pcb, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF IF ( SIZE( grid%pc_2, 1 ) * SIZE( grid%pc_2, 2 ) .GT. 1 ) THEN CALL smoother ( & grid%pc_2, & cids, cide, 1, 1, cjds, cjde, & cims, cime, 1, 1, cjms, cjme, & cips, cipe, 1, 1, cjps, cjpe, & nids, nide, 1, 1, njds, njde, & nims, nime, 1, 1, njms, njme, & nips, nipe, 1, 1, njps, njpe, & .FALSE., .FALSE., & ngrid%i_parent_start, ngrid%j_parent_start, & ngrid%parent_grid_ratio, ngrid%parent_grid_ratio & ) ENDIF CALL pop_communicators_for_domain END IF RETURN END SUBROUTINE feedback_domain_em_part2 SUBROUTINE wrf_gatherv_real (Field, field_ofst, & my_count , & globbuf, glob_ofst , & counts , & displs , & root , & communicator , & ierr ) USE module_dm, ONLY : getrealmpitype IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs REAL, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_gatherv( Field( field_ofst ), & my_count , & getrealmpitype() , & globbuf( glob_ofst ) , & counts , & displs , & getrealmpitype() , & root , & communicator , & ierr ) END SUBROUTINE wrf_gatherv_real SUBROUTINE wrf_gatherv_double (Field, field_ofst, & my_count , & globbuf, glob_ofst , & counts , & displs , & root , & communicator , & ierr ) IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs REAL, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_gatherv( Field( field_ofst ), & my_count , & MPI_DOUBLE_PRECISION , & globbuf( glob_ofst ) , & counts , & displs , & MPI_DOUBLE_PRECISION , & root , & communicator , & ierr ) END SUBROUTINE wrf_gatherv_double SUBROUTINE wrf_gatherv_integer (Field, field_ofst, & my_count , & globbuf, glob_ofst , & counts , & displs , & root , & communicator , & ierr ) IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs INTEGER, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_gatherv( Field( field_ofst ), & my_count , & MPI_INTEGER , & globbuf( glob_ofst ) , & counts , & displs , & MPI_INTEGER , & root , & communicator , & ierr ) END SUBROUTINE wrf_gatherv_integer SUBROUTINE wrf_scatterv_real ( & globbuf, glob_ofst , & counts , & Field, field_ofst, & my_count , & displs , & root , & communicator , & ierr ) USE module_dm, ONLY : getrealmpitype IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs REAL, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_scatterv( & globbuf( glob_ofst ) , & counts , & displs , & getrealmpitype() , & Field( field_ofst ), & my_count , & getrealmpitype() , & root , & communicator , & ierr ) END SUBROUTINE wrf_scatterv_real SUBROUTINE wrf_scatterv_double ( & globbuf, glob_ofst , & counts , & Field, field_ofst, & my_count , & displs , & root , & communicator , & ierr ) IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs REAL, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_scatterv( & globbuf( glob_ofst ) , & counts , & displs , & MPI_DOUBLE_PRECISION , & Field( field_ofst ), & my_count , & MPI_DOUBLE_PRECISION , & root , & communicator , & ierr ) END SUBROUTINE wrf_scatterv_double SUBROUTINE wrf_scatterv_integer ( & globbuf, glob_ofst , & counts , & Field, field_ofst, & my_count , & displs , & root , & communicator , & ierr ) IMPLICIT NONE INTEGER field_ofst, glob_ofst INTEGER my_count, communicator, root, ierr INTEGER , DIMENSION(*) :: counts, displs INTEGER, DIMENSION(*) :: Field, globbuf INCLUDE 'mpif.h' CALL mpi_scatterv( & globbuf( glob_ofst ) , & counts , & displs , & MPI_INTEGER , & Field( field_ofst ), & my_count , & MPI_INTEGER , & root , & communicator , & ierr ) END SUBROUTINE wrf_scatterv_integer SUBROUTINE wrf_dm_gatherv ( v, elemsize , km_s, km_e, wordsz ) IMPLICIT NONE INTEGER elemsize, km_s, km_e, wordsz REAL v(*) IF ( wordsz .EQ. 8 ) THEN CALL wrf_dm_gatherv_double(v, elemsize , km_s, km_e) ELSE CALL wrf_dm_gatherv_single(v, elemsize , km_s, km_e) END IF END SUBROUTINE wrf_dm_gatherv SUBROUTINE wrf_dm_gatherv_double ( v, elemsize , km_s, km_e ) IMPLICIT NONE INTEGER elemsize, km_s, km_e REAL*8 v(0:*) REAL*8 v_local((km_e-km_s+1)*elemsize) INTEGER, DIMENSION(:), ALLOCATABLE :: recvcounts, displs INTEGER send_type, myproc, nproc, local_comm, ierr, i INCLUDE 'mpif.h' send_type = MPI_DOUBLE_PRECISION CALL wrf_get_dm_communicator ( local_comm ) CALL wrf_get_nproc( nproc ) CALL wrf_get_myproc( myproc ) ALLOCATE( recvcounts(nproc), displs(nproc) ) i = (km_e-km_s+1)*elemsize CALL mpi_allgather( i,1,MPI_INTEGER,recvcounts,1,MPI_INTEGER,local_comm,ierr) ; i = (km_s)*elemsize CALL mpi_allgather( i,1,MPI_INTEGER,displs,1,MPI_INTEGER,local_comm,ierr) ; DO i = 1,elemsize*(km_e-km_s+1) v_local(i) = v(i+elemsize*km_s-1) END DO CALL mpi_allgatherv( v_local, & (km_e-km_s+1)*elemsize, & send_type, & v, & recvcounts, & displs, & send_type, & local_comm, & ierr ) DEALLOCATE(recvcounts) DEALLOCATE(displs) return END SUBROUTINE wrf_dm_gatherv_double SUBROUTINE wrf_dm_gatherv_single ( v, elemsize , km_s, km_e ) IMPLICIT NONE INTEGER elemsize, km_s, km_e REAL*4 v(0:*) REAL*4 v_local((km_e-km_s+1)*elemsize) INTEGER, DIMENSION(:), ALLOCATABLE :: recvcounts, displs INTEGER send_type, myproc, nproc, local_comm, ierr, i INCLUDE 'mpif.h' send_type = MPI_REAL CALL wrf_get_dm_communicator ( local_comm ) CALL wrf_get_nproc( nproc ) CALL wrf_get_myproc( myproc ) ALLOCATE( recvcounts(nproc), displs(nproc) ) i = (km_e-km_s+1)*elemsize CALL mpi_allgather( i,1,MPI_INTEGER,recvcounts,1,MPI_INTEGER,local_comm,ierr) ; i = (km_s)*elemsize CALL mpi_allgather( i,1,MPI_INTEGER,displs,1,MPI_INTEGER,local_comm,ierr) ; DO i = 1,elemsize*(km_e-km_s+1) v_local(i) = v(i+elemsize*km_s-1) END DO CALL mpi_allgatherv( v_local, & (km_e-km_s+1)*elemsize, & send_type, & v, & recvcounts, & displs, & send_type, & local_comm, & ierr ) DEALLOCATE(recvcounts) DEALLOCATE(displs) return END SUBROUTINE wrf_dm_gatherv_single SUBROUTINE wrf_dm_decomp1d( nt, km_s, km_e ) IMPLICIT NONE INTEGER, INTENT(IN) :: nt INTEGER, INTENT(OUT) :: km_s, km_e INTEGER nn, nnp, na, nb INTEGER myproc, nproc CALL wrf_get_myproc(myproc) CALL wrf_get_nproc(nproc) nn = nt / nproc nnp = nn if ( myproc .lt. mod( nt, nproc ) ) nnp = nnp + 1 na = min( myproc, mod(nt,nproc) ) nb = max( 0, myproc - na ) km_s = na * ( nn+1) + nb * nn km_e = km_s + nnp - 1 END SUBROUTINE wrf_dm_decomp1d SUBROUTINE wrf_dm_define_comms ( grid ) USE module_domain, ONLY : domain IMPLICIT NONE TYPE(domain) , INTENT (INOUT) :: grid RETURN END SUBROUTINE wrf_dm_define_comms SUBROUTINE tfp_message( fname, lno ) CHARACTER*(*) fname INTEGER lno CHARACTER*1024 mess WRITE(mess,*)'tfp_message: ',trim(fname),lno CALL wrf_message(mess) CALL wrf_error_fatal3("",41649,& mess) END SUBROUTINE tfp_message SUBROUTINE set_dm_debug USE module_dm, ONLY : dm_debug_flag IMPLICIT NONE dm_debug_flag = .TRUE. END SUBROUTINE set_dm_debug SUBROUTINE reset_dm_debug USE module_dm, ONLY : dm_debug_flag IMPLICIT NONE dm_debug_flag = .FALSE. END SUBROUTINE reset_dm_debug SUBROUTINE get_dm_debug ( arg ) USE module_dm, ONLY : dm_debug_flag IMPLICIT NONE LOGICAL arg arg = dm_debug_flag END SUBROUTINE get_dm_debug