var/da/da_main/da_solve_dual_res_init.inc

   1 subroutine reallocate_analysis_grid(grid)
   2
   3    implicit none
   4
   5    type(domain), intent(inout)      :: grid
   6    integer :: sm31, em31, sm32, em32, sm33, em33, ep_dim
   7
   8    if (trace_use) call da_trace_entry("da_solve_dual_res_init")
   9
  10    !
  11    ! First deallocate the arrays associated with alpha and ensemble perturbations
  12    !
  13
  14    if (trace_use) call da_trace("da_solve_dual_res_init", &
  15       Message="Deallocating arrays")
  16
  17
  18    IF ( ASSOCIATED( grid%ep%v1 ) ) THEN
  19      DEALLOCATE(grid%ep%v1,STAT=ierr)
  20     if (ierr.ne.0) then
  21        print *, ' Failed to deallocate grid%ep%v1. '
  22     endif
  23    ENDIF
  24    IF ( ASSOCIATED( grid%ep%v2 ) ) THEN
  25      DEALLOCATE(grid%ep%v2,STAT=ierr)
  26     if (ierr.ne.0) then
  27        print *, ' Failed to deallocate grid%ep%v2. '
  28     endif
  29    ENDIF
  30    IF ( ASSOCIATED( grid%ep%v3 ) ) THEN
  31      DEALLOCATE(grid%ep%v3,STAT=ierr)
  32     if (ierr.ne.0) then
  33        print *, ' Failed to deallocate grid%ep%v3. '
  34     endif
  35    ENDIF
  36    IF ( ASSOCIATED( grid%ep%v4 ) ) THEN
  37      DEALLOCATE(grid%ep%v4,STAT=ierr)
  38     if (ierr.ne.0) then
  39        print *, ' Failed to deallocate grid%ep%v4. '
  40     endif
  41    ENDIF
  42    IF ( ASSOCIATED( grid%ep%v5 ) ) THEN
  43      DEALLOCATE(grid%ep%v5,STAT=ierr)
  44     if (ierr.ne.0) then
  45        print *, ' Failed to deallocate grid%ep%v5. '
  46     endif
  47    ENDIF
  48 if ( alpha_hydrometeors ) then
  49    IF ( ASSOCIATED( grid%ep%cw ) ) THEN
  50      DEALLOCATE(grid%ep%cw,STAT=ierr)
  51      if (ierr.ne.0) then
  52         write(unit=message(1),fmt='(a)') 'Failed to deallocate grid%ep%cw '
  53         call da_error(__FILE__,__LINE__,message(1:1))
  54      endif
  55    ENDIF
  56    IF ( ASSOCIATED( grid%ep%rn ) ) THEN
  57      DEALLOCATE(grid%ep%rn,STAT=ierr)
  58      if (ierr.ne.0) then
  59         write(unit=message(1),fmt='(a)') 'Failed to deallocate grid%ep%rn '
  60         call da_error(__FILE__,__LINE__,message(1:1))
  61      endif
  62    ENDIF
  63    IF ( ASSOCIATED( grid%ep%ci ) ) THEN
  64      DEALLOCATE(grid%ep%ci,STAT=ierr)
  65      if (ierr.ne.0) then
  66         write(unit=message(1),fmt='(a)') 'Failed to deallocate grid%ep%ci '
  67         call da_error(__FILE__,__LINE__,message(1:1))
  68      endif
  69    ENDIF
  70    IF ( ASSOCIATED( grid%ep%sn ) ) THEN
  71      DEALLOCATE(grid%ep%sn,STAT=ierr)
  72      if (ierr.ne.0) then
  73         write(unit=message(1),fmt='(a)') 'Failed to deallocate grid%ep%sn '
  74         call da_error(__FILE__,__LINE__,message(1:1))
  75      endif
  76    ENDIF
  77    IF ( ASSOCIATED( grid%ep%gr ) ) THEN
  78      DEALLOCATE(grid%ep%gr,STAT=ierr)
  79      if (ierr.ne.0) then
  80         write(unit=message(1),fmt='(a)') 'Failed to deallocate grid%ep%gr '
  81         call da_error(__FILE__,__LINE__,message(1:1))
  82      endif
  83    ENDIF
  84 end if ! alpha_hydrometeors
  85   IF ( ASSOCIATED( grid%vp%alpha ) ) THEN
  86      DEALLOCATE(grid%vp%alpha,STAT=ierr)
  87     if (ierr.ne.0) then
  88        print *, ' Failed to deallocate grid%vp%alpha. '
  89     endif
  90    ENDIF
  91    IF ( ASSOCIATED( grid%vv%alpha ) ) THEN
  92      DEALLOCATE(grid%vv%alpha,STAT=ierr)
  93     if (ierr.ne.0) then
  94        print *, ' Failed to deallocate grid%vv%alpha. '
  95     endif
  96    ENDIF
  97
  98
  99    !
 100    ! Now, reallocate the arrays with the intermediate grid dimensions
 101    !
 102
 103    if (trace_use) call da_trace("da_solve_dual_res_init", &
 104       Message="Reallocating arrays")
 105
 106    sm31 = grid%intermediate_grid%sm31
 107    em31 = grid%intermediate_grid%em31
 108    sm32 = grid%intermediate_grid%sm32
 109    em32 = grid%intermediate_grid%em32
 110    sm33 = grid%intermediate_grid%sm33
 111    em33 = grid%intermediate_grid%em33
 112
 113    ep_dim=1
 114    if ( use_4denvar ) ep_dim=num_fgat_time   !  4D-En-Var
 115    !
 116    ! allocate grid%vp%alpha
 117    !
 118    ALLOCATE(grid%vp%alpha(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha),STAT=ierr)
 119    if (ierr.ne.0) then
 120      print *,' Failed to allocate grid%vp%alpha(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 121    endif
 122    grid%vp%alpha=0.
 123
 124    !
 125    ! allocate grid%vv%alpha
 126    !
 127    ALLOCATE(grid%vv%alpha(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha),STAT=ierr)
 128    if (ierr.ne.0) then
 129      print *,' Failed to allocate grid%vv%alpha(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 130    endif
 131    grid%vv%alpha=0.
 132
 133    !
 134    ! allocate grid%ep%v1
 135    !
 136    ALLOCATE(grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 137    if (ierr.ne.0) then
 138      print *,' Failed to allocate grid%ep%v1(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 139    endif
 140    grid%ep%v1=0.
 141
 142    !
 143    ! allocate grid%ep%v2
 144    !
 145    ALLOCATE(grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 146    if (ierr.ne.0) then
 147      print *,' Failed to allocate grid%ep%v2(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 148    endif
 149    grid%ep%v2=0.
 150
 151
 152    !
 153    ! allocate grid%ep%v3
 154    !
 155    ALLOCATE(grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 156    if (ierr.ne.0) then
 157      print *,' Failed to allocate grid%ep%v3(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 158    endif
 159    grid%ep%v3=0.
 160
 161    !
 162    ! allocate grid%ep%v4
 163    !
 164    ALLOCATE(grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 165    if (ierr.ne.0) then
 166      print *,' Failed to allocate grid%ep%v4(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 167    endif
 168    grid%ep%v4=0.
 169
 170    !
 171    ! allocate grid%ep%v5
 172    !
 173    ALLOCATE(grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 174    if (ierr.ne.0) then
 175      print *,' Failed to allocate grid%ep%v5(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha). '
 176    endif
 177    grid%ep%v5=0.
 178
 179 if ( alpha_hydrometeors ) then
 180    !
 181    ! allocate grid%ep%cw
 182    !
 183    ALLOCATE(grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 184    if (ierr.ne.0) then
 185       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%cw(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 186       call da_error(__FILE__,__LINE__,message(1:1))
 187    endif
 188    grid%ep%cw=0.
 189    !
 190    ! allocate grid%ep%rn
 191    !
 192    ALLOCATE(grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 193    if (ierr.ne.0) then
 194       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%rn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 195       call da_error(__FILE__,__LINE__,message(1:1))
 196    endif
 197    grid%ep%rn=0.
 198    !
 199    ! allocate grid%ep%ci
 200    !
 201    ALLOCATE(grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 202    if (ierr.ne.0) then
 203       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%ci(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 204       call da_error(__FILE__,__LINE__,message(1:1))
 205    endif
 206    grid%ep%ci=0.
 207    !
 208    ! allocate grid%ep%sn
 209    !
 210    ALLOCATE(grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 211    if (ierr.ne.0) then
 212       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%sn(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 213       call da_error(__FILE__,__LINE__,message(1:1))
 214    endif
 215    grid%ep%sn=0.
 216    !
 217    ! allocate grid%ep%gr
 218    !
 219    ALLOCATE(grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha*ep_dim),STAT=ierr)
 220    if (ierr.ne.0) then
 221       write(unit=message(1),fmt='(a)') 'Failed to allocate grid%ep%gr(sm31:em31,sm32:em32,sm33:em33,1:config_flags%ensdim_alpha) '
 222       call da_error(__FILE__,__LINE__,message(1:1))
 223    endif
 224    grid%ep%gr=0.
 225 end if ! alpha_hydrometeors
 226
 227    if (trace_use) call da_trace_exit("da_solve_dual_res_init")
 228
 229 end subroutine reallocate_analysis_grid
 230
 231 !!!!!!!!!!!!!!
 232
 233 subroutine allocate_intermediate_grid(grid)
 234
 235    type(domain), intent(inout)      :: grid
 236
 237    integer :: sm31, em31, sm32, em32, sm33, em33
 238    integer :: sm31x, em31x, sm32x, em32x, sm33x, em33x
 239    integer :: sm31y, em31y, sm32y, em32y, sm33y, em33y
 240
 241    !
 242    ! First deallocate the arrays
 243    !
 244
 245    IF ( ASSOCIATED( grid%xp%vxy ) ) THEN
 246      DEALLOCATE(grid%xp%vxy,STAT=ierr)
 247     if (ierr.ne.0) then
 248        print *, ' Failed to deallocate grid%xp%vxy. '
 249     endif
 250    ENDIF
 251    IF ( ASSOCIATED( grid%xp%v1z ) ) THEN
 252      DEALLOCATE(grid%xp%v1z,STAT=ierr)
 253     if (ierr.ne.0) then
 254        print *, ' Failed to deallocate grid%xp%v1z. '
 255     endif
 256    ENDIF
 257    IF ( ASSOCIATED( grid%xp%v1x ) ) THEN
 258      DEALLOCATE(grid%xp%v1x,STAT=ierr)
 259     if (ierr.ne.0) then
 260        print *, ' Failed to deallocate grid%xp%v1x. '
 261     endif
 262    ENDIF
 263    IF ( ASSOCIATED( grid%xp%v1y ) ) THEN
 264      DEALLOCATE(grid%xp%v1y,STAT=ierr)
 265     if (ierr.ne.0) then
 266        print *, ' Failed to deallocate grid%xp%v1y. '
 267     endif
 268    ENDIF
 269    IF ( ASSOCIATED( grid%xp%v2z ) ) THEN
 270      DEALLOCATE(grid%xp%v2z,STAT=ierr)
 271     if (ierr.ne.0) then
 272        print *, ' Failed to deallocate grid%xp%v2z. '
 273     endif
 274    ENDIF
 275    IF ( ASSOCIATED( grid%xp%v2x ) ) THEN
 276      DEALLOCATE(grid%xp%v2x,STAT=ierr)
 277     if (ierr.ne.0) then
 278        print *, ' Failed to deallocate grid%xp%v2x. '
 279     endif
 280    ENDIF
 281    IF ( ASSOCIATED( grid%xp%v2y ) ) THEN
 282      DEALLOCATE(grid%xp%v2y,STAT=ierr)
 283     if (ierr.ne.0) then
 284        print *, ' Failed to deallocate grid%xp%v2y. '
 285     endif
 286    ENDIF
 287    IF ( ASSOCIATED( grid%xb%grid_box_area ) ) THEN
 288      DEALLOCATE(grid%xb%grid_box_area,STAT=ierr)
 289     if (ierr.ne.0) then
 290        print *, ' Failed to deallocate grid%xb%grid_box_area. '
 291     endif
 292    ENDIF
 293
 294    sm31 = grid%sm31
 295    em31 = grid%em31
 296    sm32 = grid%sm32
 297    em32 = grid%em32
 298    sm33 = grid%sm33
 299    em33 = grid%em33
 300
 301    sm31x = grid%sm31x
 302    em31x = grid%em31x
 303    sm32x = grid%sm32x
 304    em32x = grid%em32x
 305    sm33x = grid%sm33x
 306    em33x = grid%em33x
 307
 308    sm31y = grid%sm31y
 309    em31y = grid%em31y
 310    sm32y = grid%sm32y
 311    em32y = grid%em32y
 312    sm33y = grid%sm33y
 313    em33y = grid%em33y
 314
 315 !
 316 ! allocate grid%xp%vxy
 317 !
 318   ALLOCATE(grid%xp%vxy(sm31:em31,sm32:em32),STAT=ierr)
 319   if (ierr.ne.0) then
 320       print *,' Failed to allocate grid%xp%vxy'
 321   endif
 322   grid%xp%vxy=0.
 323
 324 !
 325 ! allocate grid%xp%v1z
 326 !
 327   ALLOCATE(grid%xp%v1z(sm31:em31,sm32:em32,sm33:em33),STAT=ierr)
 328   if (ierr.ne.0) then
 329       print *,' Failed to allocate grid%xp%v1z'
 330   endif
 331   grid%xp%v1z=0.
 332
 333 !
 334 ! allocate grid%xp%v1x
 335 !
 336   ALLOCATE(grid%xp%v1x(sm31x:em31x,sm32x:em32x,sm33x:em33x),STAT=ierr)
 337   if (ierr.ne.0) then
 338       print *,' Failed to allocate grid%xp%v1x'
 339   endif
 340   grid%xp%v1x=0.
 341
 342 !
 343 ! allocate grid%xp%v1y
 344 !
 345  ALLOCATE(grid%xp%v1y(sm31y:em31y,sm32y:em32y,sm33y:em33y),STAT=ierr)
 346   if (ierr.ne.0) then
 347       print *,' Failed to allocate grid%xp%v1y'
 348   endif
 349   grid%xp%v1y=0.
 350
 351 !
 352 ! allocate grid%xp%v2z
 353 !
 354   ALLOCATE(grid%xp%v2z(sm31:em31,sm32:em32,sm33:em33),STAT=ierr)
 355   if (ierr.ne.0) then
 356       print *,' Failed to allocate grid%xp%v2z'
 357   endif
 358   grid%xp%v2z=0.
 359
 360
 361 !
 362 ! allocate grid%xp%v2x
 363 !
 364   ALLOCATE(grid%xp%v2x(sm31x:em31x,sm32x:em32x,sm33x:em33x),STAT=ierr)
 365   if (ierr.ne.0) then
 366       print *,' Failed to allocate grid%xp%v2x'
 367   endif
 368   grid%xp%v2x=0.
 369
 370
 371 !
 372 ! allocate grid%xp%v2y
 373 !
 374   ALLOCATE(grid%xp%v2y(sm31y:em31y,sm32y:em32y,sm33y:em33y),STAT=ierr)
 375   if (ierr.ne.0) then
 376       print *,' Failed to allocate grid%xp%v2y'
 377   endif
 378   grid%xp%v2y=0.
 379
 380 !
 381 ! allocate grid%xb%grid_box_area
 382 !
 383    ALLOCATE(grid%xb%grid_box_area(sm31:em31,sm32:em32),STAT=ierr)
 384     if (ierr.ne.0) then
 385       print *,' Failed to allocate grid%xb%grid_box_area(sm31:em31,sm32:em32)'
 386     endif
 387     grid%xb%grid_box_area=0.
 388
 389 end subroutine allocate_intermediate_grid
 390
 391