wrftladj/mediation_pertmod_io.F

   1 !
   2 !WRF:MEDIATION_LAYER:IO
   3 !
   4 MODULE mediation_pertmod_io
   5
   6 USE module_domain, ONLY : domain, head_grid, get_ijk_from_grid
   7 USE module_state_description, ONLY : PARAM_FIRST_SCALAR, num_moist, num_tracer, num_scalar
   8 #ifdef DM_PARALLEL
   9 USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y
  10 USE module_comm_dm, ONLY : halo_em_e_ad_sub
  11 #endif
  12
  13 TYPE pertmod_io
  14     CHARACTER*256 :: time                       ! time stamp
  15     REAL, ALLOCATABLE, DIMENSION(:)  :: data    ! data
  16     TYPE (pertmod_io), POINTER :: next          ! pointer to the next node
  17     TYPE (pertmod_io), POINTER :: prev          ! pointer to the previous node
  18 END TYPE pertmod_io
  19
  20 TYPE (pertmod_io), POINTER :: xtraj_head, xtraj_tail
  21 TYPE (pertmod_io), POINTER :: xtraj_pointer
  22
  23 TYPE ad_forcing_list
  24     CHARACTER*256 :: time                       ! time stamp
  25     REAL, ALLOCATABLE, DIMENSION(:)  :: data    ! data
  26     TYPE (ad_forcing_list), POINTER :: next     ! pointer to the next node
  27     TYPE (ad_forcing_list), POINTER :: prev     ! pointer to the previous node
  28 END TYPE ad_forcing_list
  29
  30 TYPE (ad_forcing_list), POINTER :: ad_forcing_head, ad_forcing_tail, tl_pert_head
  31
  32 INTEGER :: bytes_ad_forcing , bytes_xtraj, n3d, n2d, n1d, nsd, nbd
  33
  34 INTEGER                         :: ids , ide , jds , jde , kds , kde , &
  35                                    ims , ime , jms , jme , kms , kme , &
  36                                    ips , ipe , jps , jpe , kps , kpe
  37
  38 CONTAINS
  39
  40 SUBROUTINE adtl_initialize
  41
  42    IMPLICIT NONE
  43
  44    TYPE (ad_forcing_list), POINTER :: adtl_current
  45    INTEGER :: i
  46
  47    ! 3D variables: a_u, a_v, a_w, a_t, a_ph, a_p
  48    bytes_ad_forcing = n3d*6
  49    ! 2D variables: a_mu, a_rainnc, a_rainncv, a_rainc, a_raincv
  50    bytes_ad_forcing = bytes_ad_forcing + 5*n2d
  51    ! Moist variables
  52    DO i = PARAM_FIRST_SCALAR, num_moist
  53       bytes_ad_forcing = bytes_ad_forcing + n3d
  54    ENDDO
  55    ! Tracer variables
  56    DO i = PARAM_FIRST_SCALAR, num_tracer
  57       bytes_ad_forcing = bytes_ad_forcing + n3d
  58    ENDDO
  59
  60    adtl_current => ad_forcing_head
  61
  62    DO WHILE ( ASSOCIATED (adtl_current) )
  63        ad_forcing_head => adtl_current%next
  64        DEALLOCATE ( adtl_current%data )
  65        DEALLOCATE ( adtl_current )
  66        adtl_current => ad_forcing_head
  67    ENDDO
  68
  69    NULLIFY (ad_forcing_head)
  70
  71    CALL wrf_debug ( -500 , 'ad_forcing linked list is initialized' )
  72
  73    adtl_current => tl_pert_head
  74
  75    DO WHILE ( ASSOCIATED (adtl_current) )
  76        tl_pert_head => adtl_current%next
  77        DEALLOCATE ( adtl_current%data )
  78        DEALLOCATE ( adtl_current )
  79        adtl_current => tl_pert_head
  80    ENDDO
  81
  82    NULLIFY (tl_pert_head)
  83
  84    CALL wrf_debug ( -500 , 'tl_pert linked list is initialized' )
  85
  86 END SUBROUTINE adtl_initialize
  87
  88 SUBROUTINE save_tl_pert ( time )
  89
  90    IMPLICIT NONE
  91
  92    CHARACTER*256, INTENT(IN) :: time
  93
  94    TYPE (ad_forcing_list), POINTER :: tl_pert_current
  95    CHARACTER*256 mess
  96
  97    IF ( .NOT. ASSOCIATED(tl_pert_head) ) THEN
  98        NULLIFY (tl_pert_head)
  99
 100        ALLOCATE (tl_pert_head)
 101        ALLOCATE (tl_pert_head%data(bytes_ad_forcing))
 102        NULLIFY (tl_pert_head%next)
 103
 104        tl_pert_head%time = TRIM(time)
 105        call packup_ad_forcing (tl_pert_head%data)
 106
 107    ELSE
 108        ALLOCATE (tl_pert_current)
 109        ALLOCATE (tl_pert_current%data(bytes_ad_forcing))
 110        NULLIFY (tl_pert_current%next)
 111        tl_pert_current%time = TRIM(time)
 112        call packup_ad_forcing ( tl_pert_current%data)
 113        tl_pert_current%next => tl_pert_head
 114        tl_pert_head => tl_pert_current
 115    ENDIF
 116
 117    WRITE(mess, FMT='(A,A)') 'Push tl. perturbation time_stamp:', TRIM(tl_pert_head%time)
 118    CALL wrf_debug ( 1 , mess )
 119
 120 END SUBROUTINE save_tl_pert
 121
 122 SUBROUTINE save_ad_forcing ( time )
 123
 124    IMPLICIT NONE
 125
 126    CHARACTER*256, INTENT(IN) :: time
 127
 128    TYPE (ad_forcing_list), POINTER :: ad_forcing_current
 129    CHARACTER*256 mess
 130
 131    IF ( .NOT. ASSOCIATED(ad_forcing_head) ) THEN
 132        NULLIFY (ad_forcing_head)
 133
 134        ALLOCATE (ad_forcing_head)
 135        ALLOCATE (ad_forcing_head%data(bytes_ad_forcing))
 136        NULLIFY (ad_forcing_head%next)
 137
 138        ad_forcing_head%time = TRIM(time)
 139        call packup_ad_forcing (ad_forcing_head%data)
 140
 141        ad_forcing_tail => ad_forcing_head
 142
 143    ELSE
 144        ALLOCATE (ad_forcing_current)
 145        ALLOCATE (ad_forcing_current%data(bytes_ad_forcing))
 146        NULLIFY (ad_forcing_current%next)
 147        NULLIFY (ad_forcing_current%prev)
 148        ad_forcing_current%time = TRIM(time)
 149        call packup_ad_forcing ( ad_forcing_current%data)
 150        ad_forcing_current%next => ad_forcing_head
 151        ad_forcing_head%prev => ad_forcing_current
 152        ad_forcing_head => ad_forcing_current
 153    ENDIF
 154
 155    WRITE(mess, FMT='(A,A)') 'Push ad. forcing time_stamp:', TRIM(ad_forcing_head%time)
 156    CALL wrf_debug ( 1 , mess )
 157
 158 END SUBROUTINE save_ad_forcing
 159
 160 SUBROUTINE swap_ad_forcing (numberOfRun)
 161
 162    IMPLICIT NONE
 163
 164    INTEGER, INTENT(IN) :: numberOfRun
 165
 166    CHARACTER*256 time, mess
 167    REAL, ALLOCATABLE, DIMENSION(:)  :: data
 168    TYPE (ad_forcing_list), POINTER :: firstNode, secondNode
 169    INTEGER :: n
 170
 171    ALLOCATE(data(bytes_ad_forcing))
 172
 173    firstNode => ad_forcing_head
 174    secondNode => ad_forcing_tail
 175
 176    DO n = 1, numberOfRun
 177       WRITE(mess, FMT='(6a)') "Swap time: <", TRIM(firstNode%time), ">", "and: <", TRIM(secondNode%time), ">"
 178       CALL wrf_message ( mess )
 179       time = firstNode%time
 180       data = firstNode%data
 181       firstNode%time = secondNode%time
 182       firstNode%data = secondNode%data
 183       secondNode%time = time
 184       secondNode%data = data
 185
 186       IF ( n .LT. numberOfRun ) THEN
 187          firstNode => firstNode%next
 188          secondNode => secondNode%prev
 189       ENDIF
 190    ENDDO
 191
 192    DEALLOCATE(data)
 193    NULLIFY(firstNode)
 194    NULLIFY(secondNode)
 195
 196 END SUBROUTINE swap_ad_forcing
 197
 198 SUBROUTINE read_tl_pert ( time )
 199
 200    IMPLICIT NONE
 201
 202    CHARACTER*256, INTENT(IN) :: time
 203
 204    TYPE (ad_forcing_list), POINTER :: tl_pert_current
 205    CHARACTER*256 ::  mess
 206
 207    tl_pert_current => tl_pert_head
 208
 209    IF (TRIM(tl_pert_current%time) .NE. TRIM(time)) THEN
 210       WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(tl_pert_current%time), ">"
 211       CALL wrf_message ( mess )
 212       RETURN
 213    endif
 214
 215    WRITE(mess, FMT='(A,A)') &
 216          'read tl. perturbation time stamp:', TRIM(tl_pert_current%time)
 217    CALL wrf_debug ( 1 , mess )
 218
 219    call restore_ad_forcing (tl_pert_current%data)
 220
 221    tl_pert_current => tl_pert_current%next
 222
 223    NULLIFY(tl_pert_head%next)
 224    DEALLOCATE(tl_pert_head%data)
 225    DEALLOCATE(tl_pert_head)
 226    tl_pert_head => tl_pert_current
 227
 228 END SUBROUTINE read_tl_pert
 229
 230 SUBROUTINE read_ad_forcing ( time )
 231
 232    IMPLICIT NONE
 233
 234    CHARACTER*256, INTENT(IN) :: time
 235
 236    TYPE (ad_forcing_list), POINTER :: ad_forcing_current
 237    CHARACTER*256 ::  mess
 238
 239    ad_forcing_current => ad_forcing_head
 240
 241    IF (TRIM(ad_forcing_current%time) .NE. TRIM(time)) THEN
 242       WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(ad_forcing_current%time), ">"
 243       CALL wrf_message ( mess )
 244       RETURN
 245    endif
 246
 247    WRITE(mess, FMT='(A,A)') &
 248          'read ad. forcing time stamp:', TRIM(ad_forcing_current%time)
 249    CALL wrf_debug ( 1 , mess )
 250
 251    call restore_ad_forcing (ad_forcing_current%data)
 252
 253    ad_forcing_current => ad_forcing_current%next
 254
 255    NULLIFY(ad_forcing_head%next)
 256    DEALLOCATE(ad_forcing_head%data)
 257    DEALLOCATE(ad_forcing_head)
 258    ad_forcing_head => ad_forcing_current
 259
 260 END SUBROUTINE read_ad_forcing
 261
 262 SUBROUTINE xtraj_io_initialize
 263
 264    IMPLICIT NONE
 265
 266    TYPE (pertmod_io), POINTER :: current
 267
 268    INTEGER :: i
 269
 270    CALL get_ijk_from_grid (  head_grid ,                   &
 271                              ids, ide, jds, jde, kds, kde,    &
 272                              ims, ime, jms, jme, kms, kme,    &
 273                              ips, ipe, jps, jpe, kps, kpe )
 274
 275    ! Calculate how many bytes are needed to store the ad_forcing
 276
 277    n3d = (ime-ims+1)*(jme-jms+1)*(kme-kms+1)
 278    n2d = (ime-ims+1)*(jme-jms+1)
 279    n1d = (kme-kms+1)
 280    nsd = head_grid%num_soil_layers
 281    nbd = head_grid%spec_bdy_width
 282
 283    ! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, h_diabatic
 284    !-------------- alt, alb, phb, pb, tke_2
 285    !               rublten,rvblten,rthblten,rqvblten
 286    bytes_xtraj = n3d*8
 287
 288    ! 2D variables: mu_2,tsk,psfc,snowc,snowh
 289    !---------------lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
 290    !               vegfra, snow, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
 291    !               ht, xlat, xlong, albbck, tmn, xland, znt, mub,
 292    !               rainnc, rainncv, rainc, raincv, hfx, qfx, ustm
 293    bytes_xtraj = bytes_xtraj + n2d*13
 294
 295    ! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
 296    !bytes_xtraj = bytes_xtraj + n1d*8
 297
 298    ! 1D L variables: zs, dzs
 299    !bytes_xtraj = bytes_xtraj + nsd*2
 300
 301    ! 3D L variables: tslb, smois
 302    !------------- sh2o, smcrel
 303    bytes_xtraj = bytes_xtraj + n2d*nsd*2
 304
 305    ! scalar : dtbc
 306    !------------cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3
 307    bytes_xtraj = bytes_xtraj + 1
 308
 309    ! bdy variables: fcx, gcx
 310    !bytes_xtraj = bytes_xtraj + nbd*2
 311
 312    ! Moist variables
 313    DO i = PARAM_FIRST_SCALAR, num_moist
 314       bytes_xtraj = bytes_xtraj + n3d
 315    ENDDO
 316
 317    ! Tracer variables
 318    DO i = PARAM_FIRST_SCALAR, num_tracer
 319       bytes_xtraj = bytes_xtraj + n3d
 320    ENDDO
 321
 322    ! Scalar variables
 323    !DO i = PARAM_FIRST_SCALAR, num_scalar
 324    !   bytes_xtraj = bytes_xtraj + n3d
 325    !ENDDO
 326
 327    ! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
 328    !bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4*5
 329
 330    !                   : bxs, bxe, btxs, btxe : mu
 331    !bytes_xtraj = bytes_xtraj + (jme-jms+1)*nbd*4
 332
 333    ! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
 334    !bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4*5
 335
 336    !                   : bys, bye, btys, btye : mu
 337    !bytes_xtraj = bytes_xtraj + (ime-ims+1)*nbd*4
 338
 339    ! Moist boundary variables
 340    !DO i = PARAM_FIRST_SCALAR, num_moist
 341    !   bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4 ! bxs, bxe, btxs, btxe
 342    !   bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4 ! bys, bye, btys, btye
 343    !ENDDO
 344
 345    ! Scalar boundary variables
 346    !DO i = PARAM_FIRST_SCALAR, num_scalar
 347    !   bytes_xtraj = bytes_xtraj + (jme-jms+1)*n1d*nbd*4 ! bxs, bxe, btxs, btxe
 348    !   bytes_xtraj = bytes_xtraj + (ime-ims+1)*n1d*nbd*4 ! bys, bye, btys, btye
 349    !ENDDO
 350
 351    current => xtraj_head
 352
 353    DO WHILE ( ASSOCIATED (current) )
 354        xtraj_head => current%next
 355        DEALLOCATE ( current%data )
 356        DEALLOCATE ( current )
 357        current => xtraj_head
 358        xtraj_pointer => xtraj_head
 359    ENDDO
 360
 361    NULLIFY (xtraj_head)
 362
 363    CALL wrf_debug ( -500 , 'xtraj linked list is initialized' )
 364
 365 END SUBROUTINE xtraj_io_initialize
 366
 367 SUBROUTINE save_xtraj ( time )
 368
 369    IMPLICIT NONE
 370
 371    CHARACTER*256, INTENT(IN) :: time
 372
 373    TYPE (pertmod_io), POINTER :: current
 374    CHARACTER*256 mess
 375
 376    IF ( .NOT. ASSOCIATED(xtraj_head) ) THEN
 377        NULLIFY (xtraj_head)
 378
 379        ALLOCATE (xtraj_head)
 380        ALLOCATE (xtraj_head%data(bytes_xtraj))
 381        NULLIFY (xtraj_head%next)
 382
 383        xtraj_head%time = TRIM(time)
 384        call packup_xtraj ( xtraj_head%data )
 385
 386        xtraj_tail => xtraj_head
 387        xtraj_pointer => xtraj_head
 388    ELSE
 389        ALLOCATE (current)
 390        ALLOCATE (current%data(bytes_xtraj))
 391        NULLIFY (current%next)
 392        NULLIFY (current%prev)
 393        current%time = TRIM(time)
 394        call packup_xtraj ( current%data )
 395        current%next => xtraj_head
 396        xtraj_head%prev => current
 397        xtraj_head => current
 398        xtraj_pointer => current
 399    ENDIF
 400
 401    WRITE(mess, FMT='(A,A)') 'Push xtraj time_stamp:', TRIM(xtraj_head%time)
 402    CALL wrf_debug ( 1 , mess )
 403
 404 END SUBROUTINE save_xtraj
 405
 406 SUBROUTINE read_xtraj ( time )
 407
 408    IMPLICIT NONE
 409
 410    CHARACTER*256, INTENT(IN) :: time
 411
 412    CHARACTER*256 ::  mess
 413
 414    IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
 415       WRITE(mess, FMT='(6a)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(xtraj_pointer%time), ">"
 416       CALL wrf_message ( mess )
 417       RETURN
 418    ENDIF
 419
 420    WRITE(mess, FMT='(A,A)') &
 421          'read xtraj time stamp:', TRIM(xtraj_pointer%time)
 422    CALL wrf_debug ( 1 , mess )
 423
 424    CALL restore_xtraj (xtraj_pointer%data)
 425
 426    IF ( ASSOCIATED(xtraj_pointer%next) ) xtraj_pointer => xtraj_pointer%next
 427
 428 END SUBROUTINE read_xtraj
 429
 430 SUBROUTINE read_xtraj_reverse ( time )
 431
 432    IMPLICIT NONE
 433
 434    CHARACTER*256, INTENT(IN) :: time
 435
 436    CHARACTER*256 ::  mess
 437
 438    IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
 439       WRITE(mess, FMT='(A,A,A,A,A,A)') "Want time: <", TRIM(time), ">", "But time in list is: <", TRIM(xtraj_pointer%time), ">"
 440       CALL wrf_message ( mess )
 441       RETURN
 442    endif
 443
 444    WRITE(mess, FMT='(A,A)') &
 445          'read xtraj time stamp:', TRIM(xtraj_pointer%time)
 446    CALL wrf_debug ( 1 , mess )
 447
 448    CALL restore_xtraj (xtraj_pointer%data)
 449
 450    IF ( ASSOCIATED(xtraj_pointer%prev) ) xtraj_pointer => xtraj_pointer%prev
 451
 452 END SUBROUTINE read_xtraj_reverse
 453
 454 SUBROUTINE read_nl_xtraj ( time )
 455
 456    IMPLICIT NONE
 457
 458    CHARACTER*256, INTENT(IN) :: time
 459
 460    CHARACTER*256 ::  mess
 461
 462    xtraj_pointer => xtraj_head
 463
 464    DO WHILE ( ASSOCIATED(xtraj_pointer) )
 465
 466       IF (TRIM(xtraj_pointer%time) .NE. TRIM(time)) THEN
 467          xtraj_pointer => xtraj_pointer%next
 468          CYCLE
 469       ENDIF
 470
 471       WRITE(mess, FMT='(A,A)') &
 472          'read nonlinear xtraj time stamp:', TRIM(xtraj_pointer%time)
 473       CALL wrf_debug ( 1 , mess )
 474
 475       CALL restore_xtraj (xtraj_pointer%data)
 476
 477       RETURN
 478
 479    ENDDO
 480
 481    WRITE(mess, FMT='(A,A)') &
 482        'Can not find nonlinear xtraj time stamp:', TRIM(time)
 483    CALL wrf_error_fatal ( mess )
 484
 485 END SUBROUTINE read_nl_xtraj
 486
 487 SUBROUTINE packup_ad_forcing (data)
 488
 489    IMPLICIT NONE
 490
 491    REAL, DIMENSION(:), INTENT(OUT) :: data
 492
 493    INTEGER :: ns, ne, i
 494
 495    ns =       1 ; ne =    n3d ; data(ns:ne) = RESHAPE( head_grid%g_u_2, (/n3d/))
 496    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_v_2, (/n3d/))
 497    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_w_2, (/n3d/))
 498    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_t_2, (/n3d/))
 499    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_ph_2, (/n3d/))
 500    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_p, (/n3d/))
 501    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_mu_2, (/n2d/))
 502    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainnc, (/n2d/))
 503    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainncv, (/n2d/))
 504    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_rainc, (/n2d/))
 505    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%g_raincv, (/n2d/))
 506
 507    DO i = PARAM_FIRST_SCALAR, num_moist
 508       ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_moist(:,:,:,i), (/n3d/))
 509    ENDDO
 510
 511    DO i = PARAM_FIRST_SCALAR, num_tracer
 512       ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%g_tracer(:,:,:,i), (/n3d/))
 513    ENDDO
 514
 515    IF ( ne .NE. bytes_ad_forcing ) &
 516       CALL wrf_error_fatal ( 'packup_ad_forcing:  ne is not equal to bytes_ad_forcing' )
 517
 518 END SUBROUTINE packup_ad_forcing
 519
 520 SUBROUTINE restore_ad_forcing (data)
 521
 522    !
 523    !   Use perturbation variables to store the adjoint forcing temporarily.
 524    !
 525    IMPLICIT NONE
 526
 527    REAL, DIMENSION(:), INTENT(INOUT) :: data
 528
 529    INTEGER :: ns, ne, i
 530
 531    ns =       1 ; ne =    n3d ; head_grid%g_u_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 532    ns =    ne+1 ; ne = ne+n3d ; head_grid%g_v_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 533    ns =    ne+1 ; ne = ne+n3d ; head_grid%g_w_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 534    ns =    ne+1 ; ne = ne+n3d ; head_grid%g_t_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 535    ns =    ne+1 ; ne = ne+n3d ; head_grid%g_ph_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 536    ns =    ne+1 ; ne = ne+n3d ; head_grid%g_p = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 537    ns =    ne+1 ; ne = ne+n2d ; head_grid%g_mu_2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 538    ns =    ne+1 ; ne = ne+n2d ; head_grid%g_rainnc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 539    ns =    ne+1 ; ne = ne+n2d ; head_grid%g_rainncv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 540    ns =    ne+1 ; ne = ne+n2d ; head_grid%g_rainc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 541    ns =    ne+1 ; ne = ne+n2d ; head_grid%g_raincv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 542
 543    DO i = PARAM_FIRST_SCALAR, num_moist
 544       ns =    ne+1 ; ne = ne+n3d ; head_grid%g_moist(:,:,:,i) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 545    ENDDO
 546
 547    DO i = PARAM_FIRST_SCALAR, num_tracer
 548       ns =    ne+1 ; ne = ne+n3d ; head_grid%g_tracer(:,:,:,i) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 549    ENDDO
 550
 551    IF ( ne .NE. bytes_ad_forcing ) &
 552       CALL wrf_error_fatal ( 'restore_ad_forcing:  ne is not equal to bytes_ad_forcing' )
 553
 554 END SUBROUTINE restore_ad_forcing
 555
 556 SUBROUTINE packup_xtraj (data)
 557
 558    IMPLICIT NONE
 559
 560    REAL, DIMENSION(:), INTENT (OUT) :: data
 561
 562    INTEGER :: ns, ne, n, ntmp
 563
 564    ! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, alt, alb, phb, pb, h_diabatic
 565    !               rublten, rvblten, rthblten, rqvblten
 566    ns =       1 ; ne =    n3d ; data(ns:ne) = RESHAPE( head_grid%u_2, (/n3d/))
 567    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%v_2, (/n3d/))
 568    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%w_2, (/n3d/))
 569    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%t_2, (/n3d/))
 570    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%ph_2, (/n3d/))
 571    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%p, (/n3d/))
 572    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%al, (/n3d/))
 573    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%alt, (/n3d/))
 574    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%alb, (/n3d/))
 575    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%phb, (/n3d/))
 576    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%pb, (/n3d/))
 577    ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%h_diabatic, (/n3d/))
 578    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%tke_2, (/n3d/))
 579    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rublten, (/n3d/))
 580    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rvblten, (/n3d/))
 581    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rthblten, (/n3d/))
 582    !ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%rqvblten, (/n3d/))
 583
 584    ! 2D variables: mu_2, lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
 585    !               vegfra, snow, snowh, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
 586    !               ht, tsk, xlat, xlong, albbck, tmn, xland, znt, mub, psfc, snowc, hfx, qfx, ustm
 587    !               rainnc, rainncv, rainc, raincv
 588    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%mu_2, (/n2d/))
 589    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%lu_index, (/n2d/))
 590    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%q2, (/n2d/))
 591    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%t2, (/n2d/))
 592    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%th2, (/n2d/))
 593    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%u10, (/n2d/))
 594    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%v10, (/n2d/))
 595    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%landmask, (/n2d/))
 596    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xice, (/n2d/))
 597    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ivgtyp, (/n2d/))
 598    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%isltyp, (/n2d/))
 599    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%vegfra, (/n2d/))
 600    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snow, (/n2d/))
 601    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snowh, (/n2d/))
 602    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%canwat, (/n2d/))
 603    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%sst, (/n2d/))
 604    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msft, (/n2d/))
 605    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msfu, (/n2d/))
 606    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%msfv, (/n2d/))
 607    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%f, (/n2d/))
 608    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%e, (/n2d/))
 609    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%sina, (/n2d/))
 610    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%cosa, (/n2d/))
 611    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ht, (/n2d/))
 612    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%tsk, (/n2d/))
 613    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xlat, (/n2d/))
 614    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xlong, (/n2d/))
 615    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%albbck, (/n2d/))
 616    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%tmn, (/n2d/))
 617    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%xland, (/n2d/))
 618    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%znt, (/n2d/))
 619    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%mub, (/n2d/))
 620    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%psfc, (/n2d/))
 621    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%snowc, (/n2d/))
 622    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%hfx, (/n2d/))
 623    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%qfx, (/n2d/))
 624    !ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%ustm, (/n2d/))
 625    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainnc, (/n2d/))
 626    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainncv, (/n2d/))
 627    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%rainc, (/n2d/))
 628    ns =    ne+1 ; ne = ne+n2d ; data(ns:ne) = RESHAPE( head_grid%raincv, (/n2d/))
 629
 630    ! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
 631    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%znu
 632    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%znw
 633    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%fnm
 634    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%fnp
 635    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%rdnw
 636    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%rdn
 637    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%dnw
 638    !ns =    ne+1 ; ne = ne+n1d ; data(ns:ne) = head_grid%dn
 639
 640    ! 1D L variables: zs, dzs
 641    !ns =    ne+1 ; ne = ne+nsd ; data(ns:ne) = head_grid%zs
 642    !ns =    ne+1 ; ne = ne+nsd ; data(ns:ne) = head_grid%dzs
 643
 644    ! 3D L variables: tslb, smois, sh2o, smcrel
 645    ns =    ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%tslb, (/n2d*nsd/))
 646    ns =    ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%smois, (/n2d*nsd/))
 647    !ns =    ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%sh2o, (/n2d*nsd/))
 648    !ns =    ne+1 ; ne = ne+n2d*nsd ; data(ns:ne) = RESHAPE( head_grid%smcrel, (/n2d*nsd/))
 649
 650    ! scalar : cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3, dtbc
 651    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cfn
 652    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cfn1
 653    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%rdx
 654    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%rdy
 655    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dts
 656    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dtseps
 657    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%resm
 658    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%zetatop
 659    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf1
 660    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf2
 661    !ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%cf3
 662    ns =    ne+1 ; ne = ne+1 ; data(ns:ne) = head_grid%dtbc
 663
 664    ! bdy variables: fcx, gcx
 665    !ns =    ne+1 ; ne = ne+nbd ; data(ns:ne) = head_grid%fcx
 666    !ns =    ne+1 ; ne = ne+nbd ; data(ns:ne) = head_grid%gcx
 667
 668    DO n = PARAM_FIRST_SCALAR, num_moist
 669       ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%moist(:,:,:,n), (/n3d/))
 670    ENDDO
 671
 672    DO n = PARAM_FIRST_SCALAR, num_tracer
 673       ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%tracer(:,:,:,n), (/n3d/))
 674    ENDDO
 675
 676    !DO n = PARAM_FIRST_SCALAR, num_scalar
 677    !   ns =    ne+1 ; ne = ne+n3d ; data(ns:ne) = RESHAPE( head_grid%scalar(:,:,:,n), (/n3d/))
 678    !ENDDO
 679
 680    ! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
 681    !ntmp = (jme-jms+1)*n1d*nbd
 682    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bxs(:,:,:), (/ntmp/))
 683    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bxe(:,:,:), (/ntmp/))
 684    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btxs(:,:,:), (/ntmp/))
 685    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btxe(:,:,:), (/ntmp/))
 686    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bxs(:,:,:), (/ntmp/))
 687    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bxe(:,:,:), (/ntmp/))
 688    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btxs(:,:,:), (/ntmp/))
 689    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btxe(:,:,:), (/ntmp/))
 690    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bxs(:,:,:), (/ntmp/))
 691    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bxe(:,:,:), (/ntmp/))
 692    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btxs(:,:,:), (/ntmp/))
 693    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btxe(:,:,:), (/ntmp/))
 694    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bxs(:,:,:), (/ntmp/))
 695    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bxe(:,:,:), (/ntmp/))
 696    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btxs(:,:,:), (/ntmp/))
 697    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btxe(:,:,:), (/ntmp/))
 698    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bxs(:,:,:), (/ntmp/))
 699    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bxe(:,:,:), (/ntmp/))
 700    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btxs(:,:,:), (/ntmp/))
 701    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btxe(:,:,:), (/ntmp/))
 702
 703    !                   : bxs, bxe, btxs, btxe : mu
 704    !ntmp = (jme-jms+1)*nbd
 705    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bxs(:,:,:), (/ntmp/))
 706    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bxe(:,:,:), (/ntmp/))
 707    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btxs(:,:,:), (/ntmp/))
 708    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btxe(:,:,:), (/ntmp/))
 709
 710    ! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
 711    !ntmp = (ime-ims+1)*n1d*nbd
 712    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bys(:,:,:), (/ntmp/))
 713    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_bye(:,:,:), (/ntmp/))
 714    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btys(:,:,:), (/ntmp/))
 715    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%u_btye(:,:,:), (/ntmp/))
 716    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bys(:,:,:), (/ntmp/))
 717    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_bye(:,:,:), (/ntmp/))
 718    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btys(:,:,:), (/ntmp/))
 719    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%v_btye(:,:,:), (/ntmp/))
 720    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bys(:,:,:), (/ntmp/))
 721    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_bye(:,:,:), (/ntmp/))
 722    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btys(:,:,:), (/ntmp/))
 723    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%w_btye(:,:,:), (/ntmp/))
 724    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bys(:,:,:), (/ntmp/))
 725    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_bye(:,:,:), (/ntmp/))
 726    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btys(:,:,:), (/ntmp/))
 727    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%ph_btye(:,:,:), (/ntmp/))
 728    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bys(:,:,:), (/ntmp/))
 729    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_bye(:,:,:), (/ntmp/))
 730    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btys(:,:,:), (/ntmp/))
 731    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%t_btye(:,:,:), (/ntmp/))
 732
 733    !                   : bys, bye, btys, btye : mu
 734    !ntmp = (ime-ims+1)*nbd
 735    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bys(:,:,:), (/ntmp/))
 736    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_bye(:,:,:), (/ntmp/))
 737    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btys(:,:,:), (/ntmp/))
 738    !ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%mu_btye(:,:,:), (/ntmp/))
 739
 740    ! Moist boundary variables
 741    !DO n = PARAM_FIRST_SCALAR, num_moist
 742    !   ntmp = (jme-jms+1)*n1d*nbd
 743    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bxs(:,:,:,n), (/ntmp/))
 744    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bxe(:,:,:,n), (/ntmp/))
 745    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btxs(:,:,:,n), (/ntmp/))
 746    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btxe(:,:,:,n), (/ntmp/))
 747    !   ntmp = (ime-ims+1)*n1d*nbd
 748    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bys(:,:,:,n), (/ntmp/))
 749    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_bye(:,:,:,n), (/ntmp/))
 750    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btys(:,:,:,n), (/ntmp/))
 751    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%moist_btye(:,:,:,n), (/ntmp/))
 752    !ENDDO
 753
 754    ! Scalar boundary variables
 755    !DO n = PARAM_FIRST_SCALAR, num_scalar
 756    !   ntmp = (jme-jms+1)*n1d*nbd
 757    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bxs(:,:,:,n), (/ntmp/))
 758    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bxe(:,:,:,n), (/ntmp/))
 759    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btxs(:,:,:,n), (/ntmp/))
 760    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btxe(:,:,:,n), (/ntmp/))
 761    !   ntmp = (ime-ims+1)*n1d*nbd
 762    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bys(:,:,:,n), (/ntmp/))
 763    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_bye(:,:,:,n), (/ntmp/))
 764    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btys(:,:,:,n), (/ntmp/))
 765    !   ns =    ne+1 ; ne = ne+ntmp ; data(ns:ne) = RESHAPE( head_grid%scalar_btye(:,:,:,n), (/ntmp/))
 766    !ENDDO
 767
 768    IF ( ne .NE. bytes_xtraj ) &
 769       CALL wrf_error_fatal ( 'packup_xtraj:  ne is not equal to bytes_xtraj' )
 770
 771 END SUBROUTINE packup_xtraj
 772
 773 SUBROUTINE restore_xtraj (data)
 774
 775    IMPLICIT NONE
 776
 777    REAL, DIMENSION(:), INTENT (IN) :: data
 778
 779    INTEGER :: ns, ne, n, ntmp
 780
 781    ! 3D variables: u_2, v_2, w_2, t_2, ph_2, p, al, alt, alb, phb, pb, h_diabatic
 782    !               rublten, rvblten, rthblten, rqvblten
 783    ns =       1 ; ne =    n3d ; head_grid%u_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 784    ns =    ne+1 ; ne = ne+n3d ; head_grid%v_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 785    ns =    ne+1 ; ne = ne+n3d ; head_grid%w_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 786    ns =    ne+1 ; ne = ne+n3d ; head_grid%t_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 787    ns =    ne+1 ; ne = ne+n3d ; head_grid%ph_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 788    ns =    ne+1 ; ne = ne+n3d ; head_grid%p = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 789    ns =    ne+1 ; ne = ne+n3d ; head_grid%al = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 790    !ns =    ne+1 ; ne = ne+n3d ; head_grid%alt = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 791    !ns =    ne+1 ; ne = ne+n3d ; head_grid%alb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 792    !ns =    ne+1 ; ne = ne+n3d ; head_grid%phb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 793    !ns =    ne+1 ; ne = ne+n3d ; head_grid%pb = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 794    ns =    ne+1 ; ne = ne+n3d ; head_grid%h_diabatic = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 795    !ns =    ne+1 ; ne = ne+n3d ; head_grid%tke_2 = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 796    !ns =    ne+1 ; ne = ne+n3d ; head_grid%rublten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 797    !ns =    ne+1 ; ne = ne+n3d ; head_grid%rvblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 798    !ns =    ne+1 ; ne = ne+n3d ; head_grid%rthblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 799    !ns =    ne+1 ; ne = ne+n3d ; head_grid%rqvblten = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 800
 801    ! 2D variables: mu_2, lu_index, q2, t2, th2, u10, v10, landmask, xice, ivgtyp, isltyp,
 802    !               vegfra, snow, snowh, canwat, sst, msft, msfu, msfv, f, e, sina, cosa,
 803    !               ht, tsk, xlat, xlong, albbck, tmn, xland, znt, mub, psfc, snowc, hfx, qfx, ustm
 804    !               rainnc, rainncv, rainc, raincv
 805    ns =    ne+1 ; ne = ne+n2d ; head_grid%mu_2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 806    !ns =    ne+1 ; ne = ne+n2d ; head_grid%lu_index = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 807    ns =    ne+1 ; ne = ne+n2d ; head_grid%q2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 808    ns =    ne+1 ; ne = ne+n2d ; head_grid%t2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 809    !ns =    ne+1 ; ne = ne+n2d ; head_grid%th2 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 810    ns =    ne+1 ; ne = ne+n2d ; head_grid%u10 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 811    ns =    ne+1 ; ne = ne+n2d ; head_grid%v10 = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 812    !ns =    ne+1 ; ne = ne+n2d ; head_grid%landmask = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 813    !ns =    ne+1 ; ne = ne+n2d ; head_grid%xice = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 814    !ns =    ne+1 ; ne = ne+n2d ; head_grid%ivgtyp = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 815    !ns =    ne+1 ; ne = ne+n2d ; head_grid%isltyp = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 816    !ns =    ne+1 ; ne = ne+n2d ; head_grid%vegfra = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 817    !ns =    ne+1 ; ne = ne+n2d ; head_grid%snow = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 818    ns =    ne+1 ; ne = ne+n2d ; head_grid%snowh = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 819    !ns =    ne+1 ; ne = ne+n2d ; head_grid%canwat = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 820    !ns =    ne+1 ; ne = ne+n2d ; head_grid%sst = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 821    !ns =    ne+1 ; ne = ne+n2d ; head_grid%msft = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 822    !ns =    ne+1 ; ne = ne+n2d ; head_grid%msfu = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 823    !ns =    ne+1 ; ne = ne+n2d ; head_grid%msfv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 824    !ns =    ne+1 ; ne = ne+n2d ; head_grid%f = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 825    !ns =    ne+1 ; ne = ne+n2d ; head_grid%e = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 826    !ns =    ne+1 ; ne = ne+n2d ; head_grid%sina = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 827    !ns =    ne+1 ; ne = ne+n2d ; head_grid%cosa = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 828    !ns =    ne+1 ; ne = ne+n2d ; head_grid%ht = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 829    ns =    ne+1 ; ne = ne+n2d ; head_grid%tsk = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 830    !ns =    ne+1 ; ne = ne+n2d ; head_grid%xlat = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 831    !ns =    ne+1 ; ne = ne+n2d ; head_grid%xlong = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 832    !ns =    ne+1 ; ne = ne+n2d ; head_grid%albbck = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 833    !ns =    ne+1 ; ne = ne+n2d ; head_grid%tmn = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 834    !ns =    ne+1 ; ne = ne+n2d ; head_grid%xland = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 835    !ns =    ne+1 ; ne = ne+n2d ; head_grid%znt = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 836    !ns =    ne+1 ; ne = ne+n2d ; head_grid%mub = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 837    ns =    ne+1 ; ne = ne+n2d ; head_grid%psfc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 838    ns =    ne+1 ; ne = ne+n2d ; head_grid%snowc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 839    !ns =    ne+1 ; ne = ne+n2d ; head_grid%hfx = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 840    !ns =    ne+1 ; ne = ne+n2d ; head_grid%qfx = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 841    !ns =    ne+1 ; ne = ne+n2d ; head_grid%ustm = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 842    ns =    ne+1 ; ne = ne+n2d ; head_grid%rainnc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 843    ns =    ne+1 ; ne = ne+n2d ; head_grid%rainncv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 844    ns =    ne+1 ; ne = ne+n2d ; head_grid%rainc = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 845    ns =    ne+1 ; ne = ne+n2d ; head_grid%raincv = RESHAPE( data(ns:ne), (/ime-ims+1,jme-jms+1/))
 846
 847    ! 1D K variables: znu, znw, fnm, fnp, rdnw, rdn, dnw, dn
 848    !ns =    ne+1 ; ne = ne+n1d ; head_grid%znu = data(ns:ne)
 849    !ns =    ne+1 ; ne = ne+n1d ; head_grid%znw = data(ns:ne)
 850    !ns =    ne+1 ; ne = ne+n1d ; head_grid%fnm = data(ns:ne)
 851    !ns =    ne+1 ; ne = ne+n1d ; head_grid%fnp = data(ns:ne)
 852    !ns =    ne+1 ; ne = ne+n1d ; head_grid%rdnw = data(ns:ne)
 853    !ns =    ne+1 ; ne = ne+n1d ; head_grid%rdn = data(ns:ne)
 854    !ns =    ne+1 ; ne = ne+n1d ; head_grid%dnw = data(ns:ne)
 855    !ns =    ne+1 ; ne = ne+n1d ; head_grid%dn = data(ns:ne)
 856
 857    ! 1D L variables: zs, dzs
 858    !ns =    ne+1 ; ne = ne+nsd ; head_grid%zs = data(ns:ne)
 859    !ns =    ne+1 ; ne = ne+nsd ; head_grid%dzs = data(ns:ne)
 860
 861    ! 3D L variables: tslb, smois, sh2o, smcrel
 862    ns =    ne+1 ; ne = ne+n2d*nsd ; head_grid%tslb = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
 863    ns =    ne+1 ; ne = ne+n2d*nsd ; head_grid%smois = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
 864    !ns =    ne+1 ; ne = ne+n2d*nsd ; head_grid%sh2o = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
 865    !ns =    ne+1 ; ne = ne+n2d*nsd ; head_grid%smcrel = RESHAPE( data(ns:ne), (/ime-ims+1,nsd,jme-jms+1/))
 866
 867    ! scalar : cfn, cfn1, rdx, rdy, dts, dtseps, resm, zetatop, cf1, cf2, cf3, dtbc
 868    !ns =    ne+1 ; ne = ne+1 ; head_grid%cfn = data(ns)
 869    !ns =    ne+1 ; ne = ne+1 ; head_grid%cfn1 = data(ns)
 870    !ns =    ne+1 ; ne = ne+1 ; head_grid%rdx = data(ns)
 871    !ns =    ne+1 ; ne = ne+1 ; head_grid%rdy = data(ns)
 872    !ns =    ne+1 ; ne = ne+1 ; head_grid%dts = data(ns)
 873    !ns =    ne+1 ; ne = ne+1 ; head_grid%dtseps = data(ns)
 874    !ns =    ne+1 ; ne = ne+1 ; head_grid%resm = data(ns)
 875    !ns =    ne+1 ; ne = ne+1 ; head_grid%zetatop = data(ns)
 876    !ns =    ne+1 ; ne = ne+1 ; head_grid%cf1 = data(ns)
 877    !ns =    ne+1 ; ne = ne+1 ; head_grid%cf2 = data(ns)
 878    !ns =    ne+1 ; ne = ne+1 ; head_grid%cf3 = data(ns)
 879    ns =    ne+1 ; ne = ne+1 ; head_grid%dtbc = data(ns)
 880
 881    ! bdy variables: fcx, gcx
 882    !ns =    ne+1 ; ne = ne+nbd ; head_grid%fcx = data(ns:ne)
 883    !ns =    ne+1 ; ne = ne+nbd ; head_grid%gcx = data(ns:ne)
 884
 885    DO n = PARAM_FIRST_SCALAR, num_moist
 886       ns =    ne+1 ; ne = ne+n3d ; head_grid%moist(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 887    ENDDO
 888
 889    DO n = PARAM_FIRST_SCALAR, num_tracer
 890       ns =    ne+1 ; ne = ne+n3d ; head_grid%tracer(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 891    ENDDO
 892
 893    !DO n = PARAM_FIRST_SCALAR, num_scalar
 894    !   ns =    ne+1 ; ne = ne+n3d ; head_grid%scalar(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,jme-jms+1/))
 895    !ENDDO
 896
 897    ! Boundary variables: bxs, bxe, btxs, btxe : u,v,w,ph,t
 898    !ntmp = (jme-jms+1)*n1d*nbd
 899    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 900    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 901    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 902    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 903    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 904    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 905    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 906    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 907    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 908    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 909    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 910    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 911    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 912    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 913    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 914    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 915    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 916    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 917    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 918    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 919
 920    !                   : bxs, bxe, btxs, btxe : mu
 921    !ntmp = (jme-jms+1)*nbd
 922    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_bxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
 923    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_bxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
 924    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_btxs(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
 925    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_btxe(:,:,:) = RESHAPE( data(ns:ne), (/jme-jms+1,1,nbd/))
 926
 927    ! Boundary variables: bys, bye, btys, btye : u,v,w,ph,t
 928    !ntmp = (ime-ims+1)*n1d*nbd
 929    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 930    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 931    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 932    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%u_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 933    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 934    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 935    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 936    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%v_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 937    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 938    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 939    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 940    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%w_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 941    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 942    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 943    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 944    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%ph_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 945    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 946    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 947    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 948    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%t_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 949
 950    !                   : bys, bye, btys, btye : mu
 951    !ntmp = (ime-ims+1)*nbd
 952    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_bys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
 953    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_bye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
 954    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_btys(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
 955    !ns =    ne+1 ; ne = ne+ntmp ; head_grid%mu_btye(:,:,:) = RESHAPE( data(ns:ne), (/ime-ims+1,1,nbd/))
 956
 957    ! Moist boundary variables
 958    !DO n = PARAM_FIRST_SCALAR, num_moist
 959    !   ntmp = (jme-jms+1)*n1d*nbd
 960    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_bxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 961    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_bxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 962    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_btxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 963    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_btxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 964    !   ntmp = (ime-ims+1)*n1d*nbd
 965    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_bys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 966    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_bye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 967    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_btys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 968    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%moist_btye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 969    !ENDDO
 970
 971    ! Scalar boundary variables
 972    !DO n = PARAM_FIRST_SCALAR, num_scalar
 973    !   ntmp = (jme-jms+1)*n1d*nbd
 974    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_bxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 975    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_bxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 976    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_btxs(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 977    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_btxe(:,:,:,n) = RESHAPE( data(ns:ne), (/jme-jms+1,kme-kms+1,nbd/))
 978    !   ntmp = (ime-ims+1)*n1d*nbd
 979    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_bys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 980    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_bye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 981    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_btys(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 982    !   ns =    ne+1 ; ne = ne+ntmp ; head_grid%scalar_btye(:,:,:,n) = RESHAPE( data(ns:ne), (/ime-ims+1,kme-kms+1,nbd/))
 983    !ENDDO
 984
 985    IF ( ne .NE. bytes_xtraj ) &
 986       CALL wrf_error_fatal ( 'restore_xtraj:  ne is not equal to bytes_xtraj' )
 987
 988 END SUBROUTINE restore_xtraj
 989
 990 SUBROUTINE da_halo_em_e_ad ( data2dmu )
 991
 992     IMPLICIT NONE
 993
 994     REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: data2dmu
 995
 996     type (domain), pointer :: grid
 997
 998     grid => head_grid
 999
1000     grid%a_mu_1 = data2dmu
1001
1002 #ifdef DM_PARALLEL
1003 #include "HALO_EM_E_AD.inc"
1004 #endif
1005
1006     data2dmu =grid%a_mu_1
1007
1008 END SUBROUTINE da_halo_em_e_ad
1009
1010 END MODULE mediation_pertmod_io
1011
1012 SUBROUTINE add_forcing_to_ad ( grid )
1013    USE module_domain, ONLY : domain
1014
1015    IMPLICIT NONE
1016
1017    TYPE(domain), INTENT(INOUT)  :: grid
1018
1019    INTEGER :: n
1020
1021    grid%a_u_2  = grid%a_u_2  + grid%g_u_2
1022    grid%a_v_2  = grid%a_v_2  + grid%g_v_2
1023    grid%a_w_2  = grid%a_w_2  + grid%g_w_2
1024    grid%a_ph_2 = grid%a_ph_2 + grid%g_ph_2
1025    grid%a_t_2  = grid%a_t_2  + grid%g_t_2
1026    grid%a_mu_2 = grid%a_mu_2 + grid%g_mu_2
1027    grid%a_moist = grid%a_moist + grid%g_moist
1028    grid%a_tracer = grid%a_tracer + grid%g_tracer
1029    grid%a_rainnc = grid%a_rainnc + grid%g_rainnc
1030    grid%a_rainncv = grid%a_rainncv + grid%g_rainncv
1031    grid%a_rainc = grid%a_rainc + grid%g_rainc
1032    grid%a_raincv = grid%a_raincv + grid%g_raincv
1033
1034    grid%a_p = grid%a_p + grid%g_p
1035
1036    ! Reset forcings for ZERO
1037    grid%g_u_2  = 0.0
1038    grid%g_v_2  = 0.0
1039    grid%g_w_2  = 0.0
1040    grid%g_ph_2 = 0.0
1041    grid%g_t_2  = 0.0
1042    grid%g_mu_2 = 0.0
1043    grid%g_moist = 0.0
1044    grid%g_tracer = 0.0
1045    grid%g_rainnc = 0.0
1046    grid%g_rainncv = 0.0
1047    grid%g_rainc = 0.0
1048    grid%g_raincv = 0.0
1049
1050    grid%g_p = 0.0
1051 END SUBROUTINE add_forcing_to_ad
1052