subroutine psichi2uv_reg( psi, chi, u, v) !$$$ subprogram documentation block ! . . . . ! subprogram: psichi2uv_reg ! prgmmr: barker, d org: np22 date: 2000-02-03 ! ! abstract: Calculate wind components u and v from psi and chi ! (streamfunction and velocity potential, respectively) ! ! program history log: ! 2000/02/03 barker, dale - creation of F90 version ! 2001/10/30 barker - parallel version ! 2003/09/05 parrish - adapted to unified NCEP 3dvar ! 2003/10/17 wu, wanshu - first index Y second X ! 2004-06-22 treadon - update documentation ! 2008-04-23 safford - rm unused vars ! 2009-04-19 derber - modify to fit gsi ! ! input argument list: ! psi - streamfunction ! chi - velocity potential ! ! output argument list: ! u - zonal wind component ! v - meridional wind component ! ! remarks: ! The method used is ! u = ( -dpsi/dy + dchi/dx ) ! v = ( dpsi/dx + dchi/dy ) ! ! The assumptions made in this routine are: ! - unstaggered grid, ! - lateral boundary conditions - dpsi/dn, dchi/dn = 0 (FCT) ! - dy=rearth*dph , dx=cos(ph)*rearth*dlm (dx,dy is rotated grid) ! ! attributes: ! language: f90 ! machine: ibm rs/6000 sp ! !$$$ end documentation block use kinds, only: r_kind,i_kind use constants, only: half use gridmod, only: coeffx,coeffy,nlat,nlon implicit none real(r_kind), intent(in ) :: psi(nlat,nlon) ! Stream function real(r_kind), intent(in ) :: chi(nlat,nlon) ! Velocity potential real(r_kind), intent( out) :: u(nlat,nlon) ! u wind comp (m/s) real(r_kind), intent( out) :: v(nlat,nlon) ! v wind comp (m/s) integer(i_kind) :: i, j ! Loop counters. !------------------------------------------------------------------------------ ! [2.0] Compute u, v at interior points (2nd order central finite diffs): !------------------------------------------------------------------------------ do j = 2,nlon-1 do i = 2,nlat-1 u(i,j) = -( psi(i+1,j ) - psi(i-1,j ) )*coeffy(i,j) + & ( chi(i ,j+1) - chi(i ,j-1) )*coeffx(i,j) v(i,j) = ( psi(i ,j+1) - psi(i ,j-1) )*coeffx(i,j) + & ( chi(i+1,j ) - chi(i-1,j ) )*coeffy(i,j) end do end do !------------------------------------------------------------------------------ ! [3.0] Compute u, v at domain boundaries: !------------------------------------------------------------------------------ ! [3.1] Western boundaries: j = 1 do i = 2,nlat-1 u(i,j) = -( psi(i+1,j ) - psi(i-1,j ) )*coeffy(i,j) + & ( chi(i ,j+2) - chi(i ,j ) )*coeffx(i,j) v(i,j) = ( psi(i ,j+2) - psi(i ,j ) )*coeffx(i,j) + & ( chi(i+1,j ) - chi(i-1,j ) )*coeffy(i,j) end do ! [3.2] Eastern boundaries: j = nlon do i = 2,nlat-1 u(i,j) = -( psi(i+1,j ) - psi(i-1,j ) )*coeffy(i,j) + & ( chi(i ,j ) - chi(i ,j-2) )*coeffx(i,j) v(i,j) = ( psi(i ,j ) - psi(i ,j-2) )*coeffx(i,j) + & ( chi(i+1,j ) - chi(i-1,j ) )*coeffy(i,j) end do ! [3.3] Southern boundaries: i = 1 do j = 2,nlon-1 u(i,j) = -( psi(i+2,j ) - psi(i ,j ) )*coeffy(i,j) + & ( chi(i ,j+1) - chi(i ,j-1) )*coeffx(i,j) v(i,j) = ( psi(i ,j+1) - psi(i ,j-1) )*coeffx(i,j) + & ( chi(i+2,j ) - chi(i ,j ) )*coeffy(i,j) end do ! [3.4] Northern boundaries: i = nlat do j = 2,nlon-1 u(i,j) = -( psi(i ,j ) - psi(i-2,j ) )*coeffy(i,j) + & ( chi(i ,j+1) - chi(i ,j-1) )*coeffx(i,j) v(i,j) = ( psi(i ,j+1) - psi(i ,j-1) )*coeffx(i,j) + & ( chi(i ,j ) - chi(i-2,j ) )*coeffy(i,j) end do !------------------------------------------------------------------------------ ! [4.0] Corner points (assume average of surrounding points - poor?): !------------------------------------------------------------------------------ ! [4.1] Bottom-left point: u(1,1) = half * ( u(2,1) + u(1,2) ) v(1,1) = half * ( v(2,1) + v(1,2) ) ! [4.2] Top-left point: u(nlat,1) = half * ( u(nlat-1,1) + u(nlat,2) ) v(nlat,1) = half * ( v(nlat-1,1) + v(nlat,2) ) ! [4.3] Bottom-right point: u(1,nlon) = half * ( u(2,nlon) + u(1,nlon-1) ) v(1,nlon) = half * ( v(2,nlon) + v(1,nlon-1) ) ! [4.4] Top-right point: u(nlat,nlon) = half * ( u(nlat-1,nlon) + u(nlat,nlon-1) ) v(nlat,nlon) = half * ( v(nlat-1,nlon) + v(nlat,nlon-1) ) end subroutine psichi2uv_reg subroutine delx_reg( chi, u,vector) !$$$ subprogram documentation block ! . . . . ! subprogram: psichi2uv_reg ! prgmmr: barker, d org: np22 date: 2000-02-03 ! ! abstract: Calculate wind components u and v from psi and chi ! (streamfunction and velocity potential, respectively) ! ! program history log: ! 2000/02/03 barker, dale - creation of F90 version ! 2001/10/30 barker - parallel version ! 2003/09/05 parrish - adapted to unified NCEP 3dvar ! 2003/10/17 wu, wanshu - first index Y second X ! 2004-06-22 treadon - update documentation ! 2009-04-19 derber - modify to fit gsi ! ! input argument list: ! chi - velocity potential ! vector ! ! output argument list: ! u ! ! remarks: ! The method used is ! u = ( -dpsi/dy + dchi/dx ) ! ! The assumptions made in this routine are: ! - unstaggered grid, ! - lateral boundary conditions - dpsi/dn, dchi/dn = 0 (FCT) ! - dy=rearth*dph , dx=cos(ph)*rearth*dlm (dx,dy is rotated grid) ! ! attributes: ! language: f90 ! machine: ibm rs/6000 sp ! !$$$ use kinds, only: r_kind,i_kind use constants, only: half use gridmod, only: coeffx,nlat,nlon,region_dy,region_dyi implicit none logical , intent(in ) :: vector real(r_kind), intent(in ) :: chi(nlat,nlon) ! Velocity potential real(r_kind), intent( out) :: u(nlat,nlon) ! v wind comp (m/s) integer(i_kind) :: i, j ! Loop counters. real(r_kind) :: ch2(nlat,nlon) if(vector) then do j=1,nlon do i=1,nlat ch2(i,j)=chi(i,j)*region_dy(i,j) end do end do !------------------------------------------------------------------------------ ! [2.0] Compute u, v at interior points (2nd order central finite diffs): !------------------------------------------------------------------------------ do j = 2,nlon-1 do i = 1,nlat u(i,j) = ( ch2(i ,j+1) - ch2(i ,j-1) )*coeffx(i,j) end do end do !------------------------------------------------------------------------------ ! [3.0] Compute u, v at domain boundaries: !------------------------------------------------------------------------------ ! [3.1] Western boundaries: j = 1 do i = 1,nlat u(i,j) = ( ch2(i ,j+2) - ch2(i ,j ) )*coeffx(i,j) end do ! [3.2] Eastern boundaries: j = nlon do i = 1,nlat u(i,j) = ( ch2(i ,j ) - ch2(i ,j-2) )*coeffx(i,j) end do else !------------------------------------------------------------------------------ ! [2.0] Compute u, v at interior points (2nd order central finite diffs): !------------------------------------------------------------------------------ do j = 2,nlon-1 do i = 1,nlat u(i,j) = ( chi(i ,j+1) - chi(i ,j-1) )*coeffx(i,j) end do end do !------------------------------------------------------------------------------ ! [3.0] Compute u, v at domain boundaries: !------------------------------------------------------------------------------ ! [3.1] Western boundaries: j = 1 do i = 1,nlat u(i,j) = ( chi(i ,j+2) - chi(i ,j ) )*coeffx(i,j) end do ! [3.2] Eastern boundaries: j = nlon do i = 1,nlat u(i,j) = ( chi(i ,j ) - chi(i ,j-2) )*coeffx(i,j) end do end if !------------------------------------------------------------------------------ ! [4.0] Corner points (assume average of surrounding points - poor?): !------------------------------------------------------------------------------ ! [4.1] Bottom-left point: u(1 ,1 ) = half * ( u(2 ,1 ) + u(1 ,2 ) ) ! [4.2] Top-left point: u(nlat,1 ) = half * ( u(nlat-1,1 ) + u(nlat,2 ) ) ! [4.3] Bottom-right point: u(1,nlon ) = half * ( u(2 ,nlon) + u(1 ,nlon-1) ) ! [4.4] Top-right point: u(nlat,nlon) = half * ( u(nlat-1,nlon) + u(nlat,nlon-1) ) if(vector) then do j=1,nlon do i=1,nlat u(i,j)=u(i,j)*region_dyi(i,j) end do end do end if end subroutine delx_reg subroutine dely_reg( chi, v,vector) !$$$ subprogram documentation block ! . . . . ! subprogram: psichi2uv_reg ! prgmmr: barker, d org: np22 date: 2000-02-03 ! ! abstract: Calculate wind components u and v from psi and chi ! (streamfunction and velocity potential, respectively) ! ! program history log: ! 2000/02/03 barker, dale - creation of F90 version ! 2001/10/30 barker - parallel version ! 2003/09/05 parrish - adapted to unified NCEP 3dvar ! 2003/10/17 wu, wanshu - first index Y second X ! 2004-06-22 treadon - update documentation ! 2009-04-19 derber - modify to fit gsi ! ! input argument list: ! chi - velocity potential ! vector ! ! output argument list: ! v - meridional wind component ! ! remarks: ! The method used is ! u = ( dchi/dx ) ! ! The assumptions made in this routine are: ! - unstaggered grid, ! - lateral boundary conditions - dpsi/dn, dchi/dn = 0 (FCT) ! - dy=rearth*dph , dx=cos(ph)*rearth*dlm (dx,dy is rotated grid) ! ! attributes: ! language: f90 ! machine: ibm rs/6000 sp ! !$$$ use kinds, only: r_kind,i_kind use constants, only: half use gridmod, only: coeffy,nlat,nlon,region_dx,region_dxi implicit none logical , intent(in ) :: vector real(r_kind), intent(in ) :: chi(nlat,nlon) ! Velocity potential real(r_kind), intent( out) :: v(nlat,nlon) ! v wind comp (m/s) integer(i_kind) :: i, j ! Loop counters. real(r_kind) :: ch2(nlat,nlon) if(vector) then do j=1,nlon do i=1,nlat ch2(i,j)=chi(i,j)*region_dx(i,j) end do end do !------------------------------------------------------------------------------ ! [2.0] Compute u, v at interior points (2nd order central finite diffs): !------------------------------------------------------------------------------ do j = 1,nlon do i = 2,nlat-1 v(i,j) = ( ch2(i+1,j ) - ch2(i-1,j ) ) * coeffy(i,j) end do end do !------------------------------------------------------------------------------ ! [3.0] Compute u, v at domain boundaries: !------------------------------------------------------------------------------ ! [3.3] Southern boundaries: i = 1 do j = 1,nlon v(i,j) = ( ch2(i+2,j ) - ch2(i ,j ) ) * coeffy(i,j) end do ! [3.4] Northern boundaries: i = nlat do j = 1,nlon v(i,j) = ( ch2(i ,j ) - ch2(i-2,j ) ) * coeffy(i,j) end do else !------------------------------------------------------------------------------ ! [2.0] Compute u, v at interior points (2nd order central finite diffs): !------------------------------------------------------------------------------ do j = 1,nlon do i = 2,nlat-1 v(i,j) = ( chi(i+1,j ) - chi(i-1,j ) ) * coeffy(i,j) end do end do !------------------------------------------------------------------------------ ! [3.0] Compute u, v at domain boundaries: !------------------------------------------------------------------------------ ! [3.3] Southern boundaries: i = 1 do j = 1,nlon v(i,j) = ( chi(i+2,j ) - chi(i ,j ) ) * coeffy(i,j) end do ! [3.4] Northern boundaries: i = nlat do j = 1,nlon v(i,j) = ( chi(i ,j ) - chi(i-2,j ) ) * coeffy(i,j) end do end if !------------------------------------------------------------------------------ ! [4.0] Corner points (assume average of surrounding points - poor?): !------------------------------------------------------------------------------ ! [4.1] Bottom-left point: v(1 ,1 ) = half * ( v(2 ,1 ) + v(1 ,2 ) ) ! [4.2] Top-left point: v(nlat,1 ) = half * ( v(nlat-1,1 ) + v(nlat,2 ) ) ! [4.3] Bottom-right point: v(1 ,nlon) = half * ( v(2 ,nlon) + v(1 ,nlon-1) ) ! [4.4] Top-right point: v(nlat,nlon) = half * ( v(nlat-1,nlon) + v(nlat,nlon-1) ) if(vector) then do j=1,nlon do i=1,nlat v(i,j)=v(i,j)*region_dxi(i,j) end do end do end if end subroutine dely_reg