!
!WRF:MEDIATION_LAYER:IO
!
MODULE mediation_pertmod_io 6,3
USE module_domain
, ONLY : domain, head_grid, get_ijk_from_grid
USE module_state_description, ONLY : PARAM_FIRST_SCALAR, num_moist, num_tracer, num_scalar
#ifdef DM_PARALLEL
USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y
USE module_comm_dm, ONLY : halo_em_e_ad_sub
#endif
TYPE pertmod_io
CHARACTER*256 :: time ! time stamp
REAL, ALLOCATABLE, DIMENSION(:) :: data ! data
TYPE (pertmod_io), POINTER :: next ! pointer to the next node
TYPE (pertmod_io), POINTER :: prev ! pointer to the previous node
END TYPE pertmod_io
TYPE (pertmod_io), POINTER :: xtraj_head, xtraj_tail
TYPE (pertmod_io), POINTER :: xtraj_pointer
TYPE ad_forcing_list
CHARACTER*256 :: time ! time stamp
REAL, ALLOCATABLE, DIMENSION(:) :: data ! data
TYPE (ad_forcing_list), POINTER :: next ! pointer to the next node
TYPE (ad_forcing_list), POINTER :: prev ! pointer to the previous node
END TYPE ad_forcing_list
TYPE (ad_forcing_list), POINTER :: ad_forcing_head, ad_forcing_tail, tl_pert_head
INTEGER :: bytes_ad_forcing , bytes_xtraj, n3d, n2d, n1d, nsd, nbd
INTEGER :: ids , ide , jds , jde , kds , kde , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe
CONTAINS
SUBROUTINE adtl_initialize 3,2
IMPLICIT NONE
TYPE (ad_forcing_list), POINTER :: adtl_current
INTEGER :: i
! 3D variables: a_u, a_v, a_w, a_t, a_ph, a_p
bytes_ad_forcing = n3d*6
! 2D variables: a_mu, a_rainnc, a_rainncv, a_rainc, a_raincv
bytes_ad_forcing = bytes_ad_forcing + 5*n2d
! Moist variables
DO i = PARAM_FIRST_SCALAR, num_moist
bytes_ad_forcing = bytes_ad_forcing + n3d
ENDDO
! Tracer variables
DO i = PARAM_FIRST_SCALAR, num_tracer
bytes_ad_forcing = bytes_ad_forcing + n3d
ENDDO
adtl_current => ad_forcing_head
DO WHILE ( ASSOCIATED (adtl_current) )
ad_forcing_head => adtl_current%next
DEALLOCATE ( adtl_current%data )
DEALLOCATE ( adtl_current )
adtl_current => ad_forcing_head
ENDDO
NULLIFY (ad_forcing_head)
CALL wrf_debug ( -500 , 'ad_forcing linked list is initialized' )
adtl_current => tl_pert_head
DO WHILE ( ASSOCIATED (adtl_current) )
tl_pert_head => adtl_current%next
DEALLOCATE ( adtl_current%data )
DEALLOCATE ( adtl_current )
adtl_current => tl_pert_head
ENDDO
NULLIFY (tl_pert_head)
CALL wrf_debug ( -500 , 'tl_pert linked list is initialized' )
END SUBROUTINE adtl_initialize
SUBROUTINE save_tl_pert ( time ) 2,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
TYPE (ad_forcing_list), POINTER :: tl_pert_current
CHARACTER*256 mess
IF ( .NOT. ASSOCIATED(tl_pert_head) ) THEN
NULLIFY (tl_pert_head)
ALLOCATE (tl_pert_head)
ALLOCATE (tl_pert_head%data(bytes_ad_forcing))
NULLIFY (tl_pert_head%next)
tl_pert_head%time = TRIM(time)
call packup_ad_forcing (tl_pert_head%data)
ELSE
ALLOCATE (tl_pert_current)
ALLOCATE (tl_pert_current%data(bytes_ad_forcing))
NULLIFY (tl_pert_current%next)
tl_pert_current%time = TRIM(time)
call packup_ad_forcing ( tl_pert_current%data)
tl_pert_current%next => tl_pert_head
tl_pert_head => tl_pert_current
ENDIF
WRITE(mess, FMT='(A,A)') 'Push tl. perturbation time_stamp:', TRIM(tl_pert_head%time)
CALL wrf_debug ( 1 , mess )
END SUBROUTINE save_tl_pert
SUBROUTINE save_ad_forcing ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
TYPE (ad_forcing_list), POINTER :: ad_forcing_current
CHARACTER*256 mess
IF ( .NOT. ASSOCIATED(ad_forcing_head) ) THEN
NULLIFY (ad_forcing_head)
ALLOCATE (ad_forcing_head)
ALLOCATE (ad_forcing_head%data(bytes_ad_forcing))
NULLIFY (ad_forcing_head%next)
ad_forcing_head%time = TRIM(time)
call packup_ad_forcing (ad_forcing_head%data)
ad_forcing_tail => ad_forcing_head
ELSE
ALLOCATE (ad_forcing_current)
ALLOCATE (ad_forcing_current%data(bytes_ad_forcing))
NULLIFY (ad_forcing_current%next)
NULLIFY (ad_forcing_current%prev)
ad_forcing_current%time = TRIM(time)
call packup_ad_forcing ( ad_forcing_current%data)
ad_forcing_current%next => ad_forcing_head
ad_forcing_head%prev => ad_forcing_current
ad_forcing_head => ad_forcing_current
ENDIF
WRITE(mess, FMT='(A,A)') 'Push ad. forcing time_stamp:', TRIM(ad_forcing_head%time)
CALL wrf_debug ( 1 , mess )
END SUBROUTINE save_ad_forcing
SUBROUTINE swap_ad_forcing (numberOfRun) 1,1
IMPLICIT NONE
INTEGER, INTENT(IN) :: numberOfRun
CHARACTER*256 time, mess
REAL, ALLOCATABLE, DIMENSION(:) :: data
TYPE (ad_forcing_list), POINTER :: firstNode, secondNode
INTEGER :: n
ALLOCATE(data(bytes_ad_forcing))
firstNode => ad_forcing_head
secondNode => ad_forcing_tail
DO n = 1, numberOfRun
WRITE(mess, FMT='(6a)') "Swap time: <", TRIM(firstNode%time), ">", "and: <", TRIM(secondNode%time), ">"
CALL wrf_message ( mess )
time = firstNode%time
data = firstNode%data
firstNode%time = secondNode%time
firstNode%data = secondNode%data
secondNode%time = time
secondNode%data = data
IF ( n .LT. numberOfRun ) THEN
firstNode => firstNode%next
secondNode => secondNode%prev
ENDIF
ENDDO
DEALLOCATE(data)
NULLIFY(firstNode)
NULLIFY(secondNode)
END SUBROUTINE swap_ad_forcing
SUBROUTINE read_tl_pert ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
TYPE (ad_forcing_list), POINTER :: tl_pert_current
CHARACTER*256 :: mess
tl_pert_current => tl_pert_head
IF (TRIM(tl_pert_current%time) .NE. TRIM(time)) THEN
WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(tl_pert_current%time), ">"
CALL wrf_message ( mess )
RETURN
endif
WRITE(mess, FMT='(A,A)') &
'read tl. perturbation time stamp:', TRIM(tl_pert_current%time)
CALL wrf_debug ( 1 , mess )
call restore_ad_forcing (tl_pert_current%data)
tl_pert_current => tl_pert_current%next
NULLIFY(tl_pert_head%next)
DEALLOCATE(tl_pert_head%data)
DEALLOCATE(tl_pert_head)
tl_pert_head => tl_pert_current
END SUBROUTINE read_tl_pert
SUBROUTINE read_ad_forcing ( time ) 3,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
TYPE (ad_forcing_list), POINTER :: ad_forcing_current
CHARACTER*256 :: mess
ad_forcing_current => ad_forcing_head
IF (TRIM(ad_forcing_current%time) .NE. TRIM(time)) THEN
WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(ad_forcing_current%time), ">"
CALL wrf_message ( mess )
RETURN
endif
WRITE(mess, FMT='(A,A)') &
'read ad. forcing time stamp:', TRIM(ad_forcing_current%time)
CALL wrf_debug ( 1 , mess )
call restore_ad_forcing (ad_forcing_current%data)
ad_forcing_current => ad_forcing_current%next
NULLIFY(ad_forcing_head%next)
DEALLOCATE(ad_forcing_head%data)
DEALLOCATE(ad_forcing_head)
ad_forcing_head => ad_forcing_current
END SUBROUTINE read_ad_forcing
SUBROUTINE xtraj_io_initialize 10,2
IMPLICIT NONE
TYPE (pertmod_io), POINTER :: current
INTEGER :: i
CALL get_ijk_from_grid ( head_grid , &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe )
! Calculate how many bytes are needed to store the ad_forcing
n3d = (ime-ims+1)*(jme-jms+1)*(kme-kms+1)
n2d = (ime-ims+1)*(jme-jms+1)
n1d = (kme-kms+1)
nsd = head_grid%num_soil_layers
nbd = head_grid%spec_bdy_width
! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, h_diabatic
!-------------- alt, alb, phb, pb, tke_2
! rublten,rvblten,rthblten,rqvblten
bytes_xtraj = n3d*8
! 2D variables: mu_2,tsk,psfc,snowc,snowh
!---------------lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
! vegfra, snow, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
! ht, xlat, xlong, albbck, tmn, xland, znt, mub,
! rainnc, rainncv, rainc, raincv, hfx, qfx, ustm
bytes_xtraj = bytes_xtraj + n2d*13
! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
!bytes_xtraj = bytes_xtraj + n1d*8
! 1D L variables: zs, dzs
!bytes_xtraj = bytes_xtraj + nsd*2
! 3D L variables: tslb, smois
!------------- sh2o, smcrel
bytes_xtraj = bytes_xtraj + n2d*nsd*2
! scalar : dtbc
!------------cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3
bytes_xtraj = bytes_xtraj + 1
! bdy variables: fcx, gcx
!bytes_xtraj = bytes_xtraj + nbd*2
! Moist variables
DO i = PARAM_FIRST_SCALAR, num_moist
bytes_xtraj = bytes_xtraj + n3d
ENDDO
! Tracer variables
DO i = PARAM_FIRST_SCALAR, num_tracer
bytes_xtraj = bytes_xtraj + n3d
ENDDO
! Scalar variables
!DO i = PARAM_FIRST_SCALAR, num_scalar
! bytes_xtraj = bytes_xtraj + n3d
!ENDDO
! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
!bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4*5
! : bxs, bxe, btxs, btxe : mu
!bytes_xtraj = bytes_xtraj + (jme-jms+1)*nbd*4
! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
!bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4*5
! : bys, bye, btys, btye : mu
!bytes_xtraj = bytes_xtraj + (ime-ims+1)*nbd*4
! Moist boundary variables
!DO i = PARAM_FIRST_SCALAR, num_moist
! bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4 ! bxs, bxe, btxs, btxe
! bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4 ! bys, bye, btys, btye
!ENDDO
! Scalar boundary variables
!DO i = PARAM_FIRST_SCALAR, num_scalar
! bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4 ! bxs, bxe, btxs, btxe
! bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4 ! bys, bye, btys, btye
!ENDDO
current => xtraj_head
DO WHILE ( ASSOCIATED (current) )
xtraj_head => current%next
DEALLOCATE ( current%data )
DEALLOCATE ( current )
current => xtraj_head
xtraj_pointer => xtraj_head
ENDDO
NULLIFY (xtraj_head)
CALL wrf_debug ( -500 , 'xtraj linked list is initialized' )
END SUBROUTINE xtraj_io_initialize
SUBROUTINE save_xtraj ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
TYPE (pertmod_io), POINTER :: current
CHARACTER*256 mess
IF ( .NOT. ASSOCIATED(xtraj_head) ) THEN
NULLIFY (xtraj_head)
ALLOCATE (xtraj_head)
ALLOCATE (xtraj_head%data(bytes_xtraj))
NULLIFY (xtraj_head%next)
xtraj_head%time = TRIM(time)
call packup_xtraj ( xtraj_head%data )
xtraj_tail => xtraj_head
xtraj_pointer => xtraj_head
ELSE
ALLOCATE (current)
ALLOCATE (current%data(bytes_xtraj))
NULLIFY (current%next)
NULLIFY (current%prev)
current%time = TRIM(time)
call packup_xtraj ( current%data )
current%next => xtraj_head
xtraj_head%prev => current
xtraj_head => current
xtraj_pointer => current
ENDIF
WRITE(mess, FMT='(A,A)') 'Push xtraj time_stamp:', TRIM(xtraj_head%time)
CALL wrf_debug ( 1 , mess )
END SUBROUTINE save_xtraj
SUBROUTINE read_xtraj ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
CHARACTER*256 :: mess
IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(xtraj_pointer%time), ">"
CALL wrf_message ( mess )
RETURN
ENDIF
WRITE(mess, FMT='(A,A)') &
'read xtraj time stamp:', TRIM(xtraj_pointer%time)
CALL wrf_debug ( 1 , mess )
CALL restore_xtraj (xtraj_pointer%data)
IF ( ASSOCIATED(xtraj_pointer%next) ) xtraj_pointer => xtraj_pointer%next
END SUBROUTINE read_xtraj
SUBROUTINE read_xtraj_reverse ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
CHARACTER*256 :: mess
IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
WRITE(mess, FMT='(A,A,A,A,A,A)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(xtraj_pointer%time), ">"
CALL wrf_message ( mess )
RETURN
endif
WRITE(mess, FMT='(A,A)') &
'read xtraj time stamp:', TRIM(xtraj_pointer%time)
CALL wrf_debug ( 1 , mess )
CALL restore_xtraj (xtraj_pointer%data)
IF ( ASSOCIATED(xtraj_pointer%prev) ) xtraj_pointer => xtraj_pointer%prev
END SUBROUTINE read_xtraj_reverse
SUBROUTINE read_nl_xtraj ( time ) 1,3
IMPLICIT NONE
CHARACTER*256, INTENT(IN) :: time
CHARACTER*256 :: mess
xtraj_pointer => xtraj_head
DO WHILE ( ASSOCIATED(xtraj_pointer) )
IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
xtraj_pointer => xtraj_pointer%next
CYCLE
ENDIF
WRITE(mess, FMT='(A,A)') &
'read nonlinear xtraj time stamp:', TRIM(xtraj_pointer%time)
CALL wrf_debug ( 1 , mess )
CALL restore_xtraj (xtraj_pointer%data)
RETURN
ENDDO
WRITE(mess, FMT='(A,A)') &
'Can not find nonlinear xtraj time stamp:', TRIM(time)
CALL wrf_error_fatal ( mess )
END SUBROUTINE read_nl_xtraj
SUBROUTINE packup_ad_forcing (data) 4,1
IMPLICIT NONE
REAL, DIMENSION(:), INTENT(OUT) :: data
INTEGER :: ns, ne, i
ns = 1 ; ne = n3d ; data(ns:ne) = RESHAPE( head_grid%g_u_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_v_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_w_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_t_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_ph_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_p, (/n3d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_mu_2, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainnc, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainncv, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainc, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_raincv, (/n2d/))
DO i = PARAM_FIRST_SCALAR, num_moist
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_moist(:,:,:,i), (/n3d/))
ENDDO
DO i = PARAM_FIRST_SCALAR, num_tracer
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_tracer(:,:,:,i), (/n3d/))
ENDDO
IF ( ne .NE. bytes_ad_forcing ) &
CALL wrf_error_fatal ( 'packup_ad_forcing: ne is not equal to bytes_ad_forcing' )
END SUBROUTINE packup_ad_forcing
SUBROUTINE restore_ad_forcing (data) 2,1
!
! Use perturbation variables to store the adjoint forcing temporarily.
!
IMPLICIT NONE
REAL, DIMENSION(:), INTENT(INOUT) :: data
INTEGER :: ns, ne, i
ns = 1 ; ne = n3d ; head_grid%g_u_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%g_v_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%g_w_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%g_t_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%g_ph_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%g_p = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%g_mu_2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%g_rainnc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%g_rainncv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%g_rainc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%g_raincv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
DO i = PARAM_FIRST_SCALAR, num_moist
ns = ne+1 ; ne = ne+n3d ; head_grid%g_moist(:,:,:,i) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ENDDO
DO i = PARAM_FIRST_SCALAR, num_tracer
ns = ne+1 ; ne = ne+n3d ; head_grid%g_tracer(:,:,:,i) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ENDDO
IF ( ne .NE. bytes_ad_forcing ) &
CALL wrf_error_fatal ( 'restore_ad_forcing: ne is not equal to bytes_ad_forcing' )
END SUBROUTINE restore_ad_forcing
SUBROUTINE packup_xtraj (data) 2,1
IMPLICIT NONE
REAL, DIMENSION(:), INTENT (OUT) :: data
INTEGER :: ns, ne, n, ntmp
! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, alt, alb, phb, pb, h_diabatic
! rublten, rvblten, rthblten, rqvblten
ns = 1 ; ne = n3d ; data(ns:ne) = RESHAPE( head_grid%u_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%v_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%w_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%t_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%ph_2, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%p, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%al, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%alt, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%alb, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%phb, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%pb, (/n3d/))
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%h_diabatic, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%tke_2, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rublten, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rvblten, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rthblten, (/n3d/))
!ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rqvblten, (/n3d/))
! 2D variables: mu_2, lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
! vegfra, snow, snowh, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
! ht, tsk, xlat, xlong, albbck, tmn, xland, znt, mub, psfc, snowc, hfx, qfx, ustm
! rainnc, rainncv, rainc, raincv
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%mu_2, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%lu_index, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%q2, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%t2, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%th2, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%u10, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%v10, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%landmask, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xice, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ivgtyp, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%isltyp, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%vegfra, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snow, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snowh, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%canwat, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%sst, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msft, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msfu, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msfv, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%f, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%e, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%sina, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%cosa, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ht, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%tsk, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xlat, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xlong, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%albbck, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%tmn, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xland, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%znt, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%mub, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%psfc, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snowc, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%hfx, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%qfx, (/n2d/))
!ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ustm, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainnc, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainncv, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainc, (/n2d/))
ns = ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%raincv, (/n2d/))
! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%znu
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%znw
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%fnm
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%fnp
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%rdnw
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%rdn
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%dnw
!ns = ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%dn
! 1D L variables: zs, dzs
!ns = ne+1 ; ne = ne+nsd ; data(ns:ne) = head_grid%zs
!ns = ne+1 ; ne = ne+nsd ; data(ns:ne) = head_grid%dzs
! 3D L variables: tslb, smois, sh2o, smcrel
ns = ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%tslb, (/n2d*nsd/))
ns = ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%smois, (/n2d*nsd/))
!ns = ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%sh2o, (/n2d*nsd/))
!ns = ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%smcrel, (/n2d*nsd/))
! scalar : cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3, dtbc
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cfn
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cfn1
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%rdx
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%rdy
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dts
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dtseps
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%resm
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%zetatop
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf1
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf2
!ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf3
ns = ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dtbc
! bdy variables: fcx, gcx
!ns = ne+1 ; ne = ne+nbd ; data(ns:ne) = head_grid%fcx
!ns = ne+1 ; ne = ne+nbd ; data(ns:ne) = head_grid%gcx
DO n = PARAM_FIRST_SCALAR, num_moist
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%moist(:,:,:,n), (/n3d/))
ENDDO
DO n = PARAM_FIRST_SCALAR, num_tracer
ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%tracer(:,:,:,n), (/n3d/))
ENDDO
!DO n = PARAM_FIRST_SCALAR, num_scalar
! ns = ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%scalar(:,:,:,n), (/n3d/))
!ENDDO
! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
!ntmp = (jme-jms+1)*n1d*nbd
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btxe(:,:,:), (/ntmp/))
! : bxs, bxe, btxs, btxe : mu
!ntmp = (jme-jms+1)*nbd
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bxe(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btxs(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btxe(:,:,:), (/ntmp/))
! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
!ntmp = (ime-ims+1)*n1d*nbd
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btye(:,:,:), (/ntmp/))
! : bys, bye, btys, btye : mu
!ntmp = (ime-ims+1)*nbd
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bye(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btys(:,:,:), (/ntmp/))
!ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btye(:,:,:), (/ntmp/))
! Moist boundary variables
!DO n = PARAM_FIRST_SCALAR, num_moist
! ntmp = (jme-jms+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bxs(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bxe(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btxs(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btxe(:,:,:,n), (/ntmp/))
! ntmp = (ime-ims+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bys(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bye(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btys(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btye(:,:,:,n), (/ntmp/))
!ENDDO
! Scalar boundary variables
!DO n = PARAM_FIRST_SCALAR, num_scalar
! ntmp = (jme-jms+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bxs(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bxe(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btxs(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btxe(:,:,:,n), (/ntmp/))
! ntmp = (ime-ims+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bys(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bye(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btys(:,:,:,n), (/ntmp/))
! ns = ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btye(:,:,:,n), (/ntmp/))
!ENDDO
IF ( ne .NE. bytes_xtraj ) &
CALL wrf_error_fatal ( 'packup_xtraj: ne is not equal to bytes_xtraj' )
END SUBROUTINE packup_xtraj
SUBROUTINE restore_xtraj (data) 3,1
IMPLICIT NONE
REAL, DIMENSION(:), INTENT (IN) :: data
INTEGER :: ns, ne, n, ntmp
! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, alt, alb, phb, pb, h_diabatic
! rublten, rvblten, rthblten, rqvblten
ns = 1 ; ne = n3d ; head_grid%u_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%v_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%w_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%t_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%ph_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%p = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%al = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%alt = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%alb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%phb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%pb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n3d ; head_grid%h_diabatic = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%tke_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%rublten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%rvblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%rthblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n3d ; head_grid%rqvblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
! 2D variables: mu_2, lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
! vegfra, snow, snowh, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
! ht, tsk, xlat, xlong, albbck, tmn, xland, znt, mub, psfc, snowc, hfx, qfx, ustm
! rainnc, rainncv, rainc, raincv
ns = ne+1 ; ne = ne+n2d ; head_grid%mu_2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%lu_index = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%q2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%t2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%th2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%u10 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%v10 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%landmask = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%xice = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%ivgtyp = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%isltyp = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%vegfra = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%snow = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%snowh = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%canwat = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%sst = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%msft = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%msfu = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%msfv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%f = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%e = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%sina = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%cosa = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%ht = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%tsk = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%xlat = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%xlong = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%albbck = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%tmn = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%xland = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%znt = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%mub = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%psfc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%snowc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%hfx = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%qfx = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d ; head_grid%ustm = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%rainnc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%rainncv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%rainc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d ; head_grid%raincv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
!ns = ne+1 ; ne = ne+n1d ; head_grid%znu = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%znw = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%fnm = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%fnp = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%rdnw = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%rdn = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%dnw = data(ns:ne)
!ns = ne+1 ; ne = ne+n1d ; head_grid%dn = data(ns:ne)
! 1D L variables: zs, dzs
!ns = ne+1 ; ne = ne+nsd ; head_grid%zs = data(ns:ne)
!ns = ne+1 ; ne = ne+nsd ; head_grid%dzs = data(ns:ne)
! 3D L variables: tslb, smois, sh2o, smcrel
ns = ne+1 ; ne = ne+n2d*nsd ; head_grid%tslb = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
ns = ne+1 ; ne = ne+n2d*nsd ; head_grid%smois = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d*nsd ; head_grid%sh2o = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
!ns = ne+1 ; ne = ne+n2d*nsd ; head_grid%smcrel = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
! scalar : cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3, dtbc
!ns = ne+1 ; ne = ne+1 ; head_grid%cfn = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%cfn1 = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%rdx = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%rdy = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%dts = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%dtseps = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%resm = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%zetatop = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%cf1 = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%cf2 = data(ns)
!ns = ne+1 ; ne = ne+1 ; head_grid%cf3 = data(ns)
ns = ne+1 ; ne = ne+1 ; head_grid%dtbc = data(ns)
! bdy variables: fcx, gcx
!ns = ne+1 ; ne = ne+nbd ; head_grid%fcx = data(ns:ne)
!ns = ne+1 ; ne = ne+nbd ; head_grid%gcx = data(ns:ne)
DO n = PARAM_FIRST_SCALAR, num_moist
ns = ne+1 ; ne = ne+n3d ; head_grid%moist(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ENDDO
DO n = PARAM_FIRST_SCALAR, num_tracer
ns = ne+1 ; ne = ne+n3d ; head_grid%tracer(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
ENDDO
!DO n = PARAM_FIRST_SCALAR, num_scalar
! ns = ne+1 ; ne = ne+n3d ; head_grid%scalar(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
!ENDDO
! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
!ntmp = (jme-jms+1)*n1d*nbd
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! : bxs, bxe, btxs, btxe : mu
!ntmp = (jme-jms+1)*nbd
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
!ntmp = (ime-ims+1)*n1d*nbd
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%u_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%v_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%w_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%ph_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%t_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! : bys, bye, btys, btye : mu
!ntmp = (ime-ims+1)*nbd
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
!ns = ne+1 ; ne = ne+ntmp ; head_grid%mu_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
! Moist boundary variables
!DO n = PARAM_FIRST_SCALAR, num_moist
! ntmp = (jme-jms+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_bxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_bxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_btxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_btxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ntmp = (ime-ims+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_bys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_bye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_btys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%moist_btye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ENDDO
! Scalar boundary variables
!DO n = PARAM_FIRST_SCALAR, num_scalar
! ntmp = (jme-jms+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_bxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_bxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_btxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_btxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
! ntmp = (ime-ims+1)*n1d*nbd
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_bys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_bye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_btys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
! ns = ne+1 ; ne = ne+ntmp ; head_grid%scalar_btye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
!ENDDO
IF ( ne .NE. bytes_xtraj ) &
CALL wrf_error_fatal ( 'restore_xtraj: ne is not equal to bytes_xtraj' )
END SUBROUTINE restore_xtraj
SUBROUTINE da_halo_em_e_ad ( data2dmu ) 2
IMPLICIT NONE
REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: data2dmu
type (domain), pointer :: grid
grid => head_grid
grid%a_mu_1 = data2dmu
#ifdef DM_PARALLEL
#include "HALO_EM_E_AD.inc"
#endif
data2dmu =grid%a_mu_1
END SUBROUTINE da_halo_em_e_ad
END MODULE mediation_pertmod_io
SUBROUTINE add_forcing_to_ad ( grid ) 2,1
USE module_domain, ONLY : domain
IMPLICIT NONE
TYPE(domain), INTENT(INOUT) :: grid
INTEGER :: n
grid%a_u_2 = grid%a_u_2 + grid%g_u_2
grid%a_v_2 = grid%a_v_2 + grid%g_v_2
grid%a_w_2 = grid%a_w_2 + grid%g_w_2
grid%a_ph_2 = grid%a_ph_2 + grid%g_ph_2
grid%a_t_2 = grid%a_t_2 + grid%g_t_2
grid%a_mu_2 = grid%a_mu_2 + grid%g_mu_2
grid%a_moist = grid%a_moist + grid%g_moist
grid%a_tracer = grid%a_tracer + grid%g_tracer
grid%a_rainnc = grid%a_rainnc + grid%g_rainnc
grid%a_rainncv = grid%a_rainncv + grid%g_rainncv
grid%a_rainc = grid%a_rainc + grid%g_rainc
grid%a_raincv = grid%a_raincv + grid%g_raincv
grid%a_p = grid%a_p + grid%g_p
! Reset forcings for ZERO
grid%g_u_2 = 0.0
grid%g_v_2 = 0.0
grid%g_w_2 = 0.0
grid%g_ph_2 = 0.0
grid%g_t_2 = 0.0
grid%g_mu_2 = 0.0
grid%g_moist = 0.0
grid%g_tracer = 0.0
grid%g_rainnc = 0.0
grid%g_rainncv = 0.0
grid%g_rainc = 0.0
grid%g_raincv = 0.0
grid%g_p = 0.0
END SUBROUTINE add_forcing_to_ad