var/da/da_setup_structures/da_write_vp.inc

   1 subroutine da_write_vp (grid,vp,filename)
   2
   3    !----------------------------------------------------------------------
   4    ! Purpose: Write vp, full varibles after balance transform Up
   5    !          will be interpolated into higher resolution by offline program
   6    ! Method:  based on da_write_increments.inc
   7    ! Author:  Zhiquan (Jake) Liu, NCAR/MMM, 2015-09
   8    !          add cloud and w variables,    2017-07
   9    !----------------------------------------------------------------------
  10
  11    implicit none
  12
  13    type (domain), intent(in)      :: grid
  14    type(vp_type), intent(in)      :: vp
  15    character(len=16), intent(in) :: filename
  16
  17    ! Arrays for write out increments:
  18    integer                                          :: ix, jy, kz
  19 #ifdef DM_PARALLEL
  20    !real, dimension(1:grid%xb%mix,1:grid%xb%mjy)               ::     gbuf_2d
  21    !real, dimension(1:grid%xb%mix+1,1:grid%xb%mjy+1)           ::     gbuf_2dd
  22    real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz) ::     gbuf
  23
  24    !real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz+1)    ::    wgbuf
  25    real, dimension(:,:,:), allocatable :: v1_global, v2_global, &
  26                                v3_global, v4_global, v5_global
  27    real, dimension(:,:,:), allocatable :: v6_global, v7_global, &
  28                     v8_global, v9_global, v10_global, v11_global
  29 #endif
  30
  31    integer :: vp_unit, vp_local_unit
  32    character(len=7) :: vpfile
  33
  34    if (trace_use) call da_trace_entry("da_write_vp")
  35
  36
  37    ! Dimension of the domain (unstagered):
  38    ix = grid%xb%mix
  39    jy = grid%xb%mjy
  40    kz = grid%xb%mkz
  41
  42 #ifdef DM_PARALLEL
  43
  44    ! 3-d and 2-d increments:
  45
  46    allocate (   v1_global (1:ix,1:jy,1:kz))
  47    allocate (   v2_global (1:ix,1:jy,1:kz))
  48    allocate (   v3_global (1:ix,1:jy,1:kz))
  49    allocate (   v4_global (1:ix,1:jy,1:kz))
  50    allocate (   v5_global (1:ix,1:jy,1:kz))
  51    if ( cloud_cv_options >= 2 ) then
  52      allocate (   v6_global (1:ix,1:jy,1:kz))
  53      allocate (   v7_global (1:ix,1:jy,1:kz))
  54      allocate (   v8_global (1:ix,1:jy,1:kz))
  55      allocate (   v9_global (1:ix,1:jy,1:kz))
  56      allocate (   v10_global (1:ix,1:jy,1:kz))
  57    end if
  58    if ( use_cv_w ) then
  59      allocate (   v11_global (1:ix,1:jy,1:kz))
  60    end if
  61
  62    call da_patch_to_global(grid, vp % v1, gbuf)  ! psi or u
  63    if (rootproc) then
  64       v1_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  65    end if
  66
  67    call da_patch_to_global(grid, vp % v2, gbuf)  ! chi_u or v
  68    if (rootproc) then
  69       v2_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  70    end if
  71
  72    call da_patch_to_global(grid, vp % v3, gbuf)  ! t_u or t
  73    if (rootproc) then
  74       v3_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  75    end if
  76
  77    call da_patch_to_global(grid, vp % v4, gbuf)  ! q/qs
  78    if (rootproc) then
  79       v4_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  80    end if
  81
  82    !print *, "local size v5: ", size(vp % v5,1),size(vp % v5,2),size(vp % v5,3)
  83    call da_patch_to_global(grid, vp % v5, gbuf) ! Ps (:,:,1)
  84    if (rootproc) then
  85       v5_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  86    end if
  87
  88   if ( cloud_cv_options >= 2 ) then
  89    call da_patch_to_global(grid, vp % v6, gbuf)  ! qcloud
  90    if (rootproc) then
  91       v6_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  92    end if
  93
  94    call da_patch_to_global(grid, vp % v7, gbuf)  ! qrain
  95    if (rootproc) then
  96       v7_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
  97    end if
  98
  99    call da_patch_to_global(grid, vp % v8, gbuf)  ! qice
 100    if (rootproc) then
 101       v8_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
 102    end if
 103
 104    call da_patch_to_global(grid, vp % v9, gbuf)  ! qsnow
 105    if (rootproc) then
 106       v9_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
 107    end if
 108
 109    call da_patch_to_global(grid, vp % v10, gbuf) ! qgraupel
 110    if (rootproc) then
 111       v10_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
 112    end if
 113   end if ! cloud_cv_options
 114
 115   if ( use_cv_w ) then
 116    call da_patch_to_global(grid, vp % v11, gbuf) ! w
 117    if (rootproc) then
 118       v11_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz)
 119    end if
 120   end if
 121
 122       !write(unit=vpfile,fmt='(a,i4.4)') 'vp_',myproc
 123       !call da_get_unit(vp_local_unit)
 124       !open(unit=vp_local_unit, file=trim(vpfile), form='unformatted')
 125
 126       !print *, "local: ips,ipe,jps,jpe,kps,kpe=", ips,ipe,jps,jpe,kps,kpe
 127       !print *, "local: ims,ime,jms,jme,kms,kme=", ims,ime,jms,jme,kms,kme
 128       !print *, "local: dimx, dimy, dimz=", size(vp%v5,1),size(vp%v5,2),size(vp%v5,3)
 129
 130       !write (unit=vp_local_unit) ips,ipe,jps,jpe,kps,kpe, &
 131       !                           ims,ime,jms,jme,kms,kme, &
 132       !              size(vp%v5,1),size(vp%v5,2),size(vp%v5,3)
 133
 134       !write (unit=vp_local_unit) vp%v1, vp%v2, &
 135       !                     vp%v3, vp%v4, vp%v5
 136
 137       !close(vp_local_unit)
 138       !call da_free_unit(vp_local_unit)
 139
 140
 141 #endif
 142
 143    if (rootproc) then
 144       call da_get_unit(vp_unit)
 145       open(unit=vp_unit, file=trim(filename), form='unformatted')
 146
 147       !print *, "ANALYSIS_DATE= ", ANALYSIS_DATE
 148       !write (unit=vp_unit) ANALYSIS_DATE
 149
 150       print *, "write_vp: Global ix, jy, kz=", ix, jy, kz
 151       write (unit=vp_unit) ix, jy, kz
 152
 153 #ifdef DM_PARALLEL
 154
 155       ! 3d- and 2d-increments in vp space:
 156       write (unit=vp_unit) v1_global, v2_global, &
 157                            v3_global, v4_global, v5_global
 158
 159       if ( cloud_cv_options >= 2 ) then
 160           write (unit=vp_unit) v6_global, v7_global, &
 161                            v8_global, v9_global, v10_global
 162       end if
 163       if ( use_cv_w ) write (unit=vp_unit) v11_global
 164
 165       close(vp_unit)
 166       call da_free_unit(vp_unit)
 167
 168 #else
 169
 170       ! 3d- and 2d-increments:
 171       write (unit=vp_unit) vp%v1(1:ix,1:jy,1:kz), &
 172                            vp%v2(1:ix,1:jy,1:kz), &
 173                            vp%v3(1:ix,1:jy,1:kz), &
 174                            vp%v4(1:ix,1:jy,1:kz), &
 175                            vp%v5(1:ix,1:jy,1)
 176       if ( cloud_cv_options >= 2 ) then
 177         write (unit=vp_unit) vp%v6(1:ix,1:jy,1:kz), &
 178                              vp%v7(1:ix,1:jy,1:kz), &
 179                              vp%v8(1:ix,1:jy,1:kz), &
 180                              vp%v9(1:ix,1:jy,1:kz), &
 181                              vp%v10(1:ix,1:jy,1:kz)
 182       end if
 183       if ( use_cv_w ) write (unit=vp_unit) vp%v11(1:ix,1:jy,1:kz)
 184
 185       close(vp_unit)
 186       call da_free_unit(vp_unit)
 187 #endif
 188
 189    end if
 190
 191    if (trace_use) call da_trace_exit("da_write_vp")
 192
 193 end subroutine da_write_vp
 194
 195