var/da/da_vtox_transforms/da_transform_bal.inc

   1 SUBROUTINE da_transform_bal( vp, be, grid )
   2
   3    IMPLICIT NONE
   4
   5    TYPE (vp_type), INTENT(INOUT)        :: vp ! work array.
   6    TYPE (be_type), INTENT(IN)           :: be ! Background errors.
   7    type (domain) , intent(inout)        :: grid   ! Domain variables.
   8
   9    INTEGER                              :: i, j, k, kk, ij  ! Loop counters.
  10
  11 !-------------------------------------------------------------------
  12 !  [1.0] Initialise:
  13 !-------------------------------------------------------------------
  14 !
  15 !  linear balance btw psi and t-b, Psfc_b and chi_b
  16 !  [3.1] Calculate t_b from psi
  17
  18    !$OMP PARALLEL DO &
  19    !$OMP PRIVATE (i, j, k, ij)
  20    DO ij = 1, grid%num_tiles
  21       DO k = kts,kte
  22          DO j = grid%j_start(ij), grid%j_end(ij)
  23             DO i= its,ite
  24                grid%xa%t(i,j,k)=vp%v3(i,j,k)
  25             END DO
  26          END DO
  27       END DO
  28    END DO
  29    !$OMP END PARALLEL DO
  30
  31    !$OMP PARALLEL DO &
  32    !$OMP PRIVATE (i, j, k, kk, ij)
  33    DO ij = 1, grid%num_tiles
  34       DO kk = kts,kte
  35          DO k = kts,kte
  36             DO j = grid%j_start(ij), grid%j_end(ij)
  37                DO i= its,ite
  38                   grid%xa%t(i,j,k) = grid%xa%t(i,j,k) + &
  39                                      be%agvz(i,j,k,kk) * vp%v1(i,j,kk)
  40                END DO
  41             END DO
  42          END DO
  43       END DO
  44    END DO
  45    !$OMP END PARALLEL DO
  46
  47 !  [3.2] Calculate chi_b from psi
  48
  49    !$OMP PARALLEL DO &
  50    !$OMP PRIVATE (i, j, k, ij)
  51    DO ij = 1, grid%num_tiles
  52       DO k = kts,kte
  53          DO j = grid%j_start(ij), grid%j_end(ij)
  54             DO i= its,ite
  55                vp%v2(i,j,k) = vp%v2(i,j,k) + &
  56                               be%bvz(i,j,k) * vp%v1(i,j,k)
  57             END DO
  58          END DO
  59       END DO
  60    END DO
  61    !$OMP END PARALLEL DO
  62
  63 !  [3.3] Calculate Psfc_b from psi
  64
  65    !$OMP PARALLEL DO &
  66    !$OMP PRIVATE (i, j, ij)
  67    DO ij = 1, grid%num_tiles
  68       DO j = grid%j_start(ij), grid%j_end(ij)
  69          DO i= its,ite
  70             grid%xa%psfc(i,j)=vp%v5(i,j,1)
  71          END DO
  72       END DO
  73    END DO
  74    !$OMP END PARALLEL DO
  75
  76
  77    !$OMP PARALLEL DO &
  78    !$OMP PRIVATE (i, j, k, ij)
  79    DO ij = 1, grid%num_tiles
  80       DO k = kts,kte
  81          DO j = grid%j_start(ij), grid%j_end(ij)
  82             DO i= its,ite
  83                grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + &
  84                                    be%wgvz(i,j,k) * vp%v1(i,j,k)
  85             END DO
  86          END DO
  87       END DO
  88    END DO
  89    !$OMP END PARALLEL DO
  90
  91 !--convert from delt.ln(ps) to delt.ps
  92    !$OMP PARALLEL DO &
  93    !$OMP PRIVATE (i, j, ij)
  94    DO ij = 1, grid%num_tiles
  95       DO j = grid%j_start(ij), grid%j_end(ij)
  96          DO i= its,ite
  97             grid%xa%psfc(i,j) = grid%xa%psfc(i,j) * grid%xb%psfc(i,j)
  98          END DO
  99       END DO
 100    END DO
 101    !$OMP END PARALLEL DO
 102
 103 !  [3.4] Transform psi and chi to u and v:
 104
 105 !  Communicate halo region.
 106 #ifdef DM_PARALLEL
 107 #include "HALO_PSICHI_UV.inc"
 108 #endif
 109
 110    call da_psichi_to_uv( vp%v1, vp%v2, grid%xb%coefx, &
 111                          grid%xb%coefy, grid%xa%u, grid%xa%v    )
 112
 113 !  [3.5] treat humidity
 114
 115
 116    IF ( cv_options == 3 ) THEN
 117    !$OMP PARALLEL DO &
 118    !$OMP PRIVATE (i, j, k, ij)
 119    DO ij = 1, grid%num_tiles
 120       DO k = kts,kte
 121          DO j = grid%j_start(ij), grid%j_end(ij)
 122             DO i= its,ite
 123                grid%xa%q(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k)
 124             END DO
 125          END DO
 126       END DO
 127    END DO
 128    !$OMP END PARALLEL DO
 129    ELSE IF ( cv_options_hum == 1 ) THEN
 130
 131       grid%xa%q(its:ite,jts:jte,kts:kte) = vp%v4(its:ite,jts:jte,kts:kte)
 132
 133    ELSE IF ( cv_options_hum == 2 ) THEN
 134
 135       grid%xa%rh(its:ite,jts:jte,kts:kte) = vp%v4(its:ite,jts:jte,kts:kte)
 136
 137       CALL DA_TPRH_To_Q_Lin( grid )
 138
 139    END IF
 140
 141 END SUBROUTINE da_transform_bal
 142