SUBROUTINE CH_VOBS_TO_P(KULOUT,KOBS,POBSLEV,POBSLEV2, 5,6
1 K1,K2,KOBSLEV,KDIM,KFLAG)
IMPLICIT NONE
INTEGER KULOUT,KOBS,K1,K2,KFLAG,KDIM,KOBSLEV
REAL*8 POBSLEV(KDIM),POBSLEV2(KDIM)
#if defined (DOC)
*
*
**s/r CH_VOBS_TO_P - Convert observation vertical coordinate values to
* pressure (or sigma).
*
* AUTHOR: Y. Rochon *ARQX/AES Jan. 1999
*
* REVISIONS:
* Y. Yang Sep. 2003
* - Change ROBDATA to ROBDATA8 to be compatible with
* the new version
* - account for extra vertical columns
* Y.J. Rochon, *ARQX/MSC Jan 2005
* - Completed changes for additional vertical coordinates.
* Y.J. Rochon and Y. Yang, *ARQX/MSC Jan 2005
* - Cleaned up options for model vertical coordinate type
* 'SIGMA' and 'PRESS'
*
* PURPOSE: - Convert observation vertical coordinate values to
* pressure (or sigma).
*
* ARGUMENTS
*
* INPUT:
*
* KULOUT.......Output unit
* KOBS.........Observation index.
* KDIM.........Max dim of POBSLEV
* (must be >= max(MOBHDR(NCMNLV,*))
* K1...........Index of first data point.
* If 0, then obtain from MOBHDR(NCMRNL,KOBS)
* K2...........Index of last data point.
* Irrelevant when K1=0
*
* OUTPUT:
*
* POBSLEV......Pressures at data points for a single observation.
* POBSLEV2.....Second set of pressures - when applicable
* Requires ROBDATA8(NCMPOB,*)>0.
* KFLAG........Flag indicating whether or not conversion
* was possible (0 for yes)
* KOBSLEV......Final dimension of POBSLEV
* (= MOBHDR(NCMNLV,KOBS) or K2-K1+1)
*
************************************************************************
#endif
C Common block parameters and variables
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comgem.cdk"
#include "comchem.cdk"
#include "commvo.cdk"
#include "commvo1.cdk"
#include "commvog.cdk"
#include "comoahdr.cdk"
#include "comoabdy.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "comstate.cdk"
C
INTEGER IIK2,I1,I2,J
REAL*8 ZWORK3(1000),ZWORK22(1000)
REAL*8 ZSCALE,ZWORK1(1000),ZWORK2(1000)
REAL*8 ZWORK33(1000)
REAL*8 VPRES(NFLEV)
C
C Find range of data points per observation
C
IF (K1.GT.0) THEN
I1=K1
I2=K2
KOBSLEV=K2-K1+1
ELSE
I1=MOBHDR(NCMRLN,KOBS)
I2=MOBHDR(NCMRLN,KOBS)+MOBHDR(NCMNLV,KOBS)-1
KOBSLEV=MOBHDR(NCMNLV,KOBS)
END IF
C
KFLAG=0
IF (MOBHDR(NCMNLV,KOBS).LE.0.OR.KOBSLEV.LE.0) THEN
KFLAG=1
RETURN
END IF
C
IIK2=MOBDATA(NCMOBS,I1)
C
C Set vertical coordinate dependent constant and flags
C
ZSCALE=1.0E0
IF (CVCORD.EQ.'SIGMA') THEN
ZSCALE=GOMPS1(1,MOBDATA(NCMOBS,I1))
END IF
C
C Check if conversion required.
C
IF (MOBDATA(NCMVCO,I1).EQ.0) THEN
C
C Vertical coordinate type undefined
C
KFLAG=2
RETURN
C
ENDIF
IF (MOBDATA(NCMVCO,I1) .EQ.2) THEN
C
C Obs vertical coordinate in pressure.
C No conversion required.
C
DO J=1,KOBSLEV
POBSLEV(J)=ROBDATA8(NCMPPP,I1-1+J)
END DO
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
DO J=1,KOBSLEV
POBSLEV2(J)=ROBDATA8(NCMPOB,I1-1+J)
END DO
END IF
C
RETURN
C
END IF
C
C More involved conversion may be required.
C
IF (nogz.LE.0) THEN
C
C GZ not available
C
CALL ABORT3D(KULOUT,
1 "CH_VOBS_TO_P: Need missing GZ")
C
END IF
C
C Get model geopotential at observation points
C
c DO J=1,NFLEV
c ZWORK1(J)=GOMOBS((nogz-1)*NFLEV+J,IIK2)
c END DO
DO J=1,NFLEV
ZWORK1(J)=GOMGZG(J,IIK2)
END DO
c
C Extract observation vertical coordinate array
c
DO J=1,KOBSLEV
ZWORK2(J)=ROBDATA8(NCMPPP,I1-1+J)
END DO
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
DO J=1,KOBSLEV
ZWORK22(J)=ROBDATA8(NCMPOB,I1-1+J)
END DO
END IF
IF (MOBDATA(NCMVCO,I1) .EQ. 1 ) THEN
C
C Observations are on altitude levels (relative to sea surface)
C
CALL CH_GP_TO_Z(ZWORK3,ZWORK2,KOBSLEV,-1,
1 ROBHDR(NCMLAT,KOBS))
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
CALL CH_GP_TO_Z(ZWORK33,ZWORK22,KOBSLEV,-1,
1 ROBHDR(NCMLAT,KOBS))
END IF
C
ELSE IF (MOBDATA(NCMVCO,I1) .EQ. 3 ) THEN
C
C Observations are on geopotential height levels
C
CALL CH_GP_TO_Z(ZWORK3,ZWORK2,KOBSLEV,-2,
1 ROBHDR(NCMLAT,KOBS))
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
CALL CH_GP_TO_Z(ZWORK33,ZWORK22,KOBSLEV,-2,
1 ROBHDR(NCMLAT,KOBS))
END IF
C
C
ELSE IF (MOBDATA(NCMVCO,I1) .EQ. 4) THEN
C
C Observations are on geopotential levels
C
C No conversion needed
C
DO J=1,KOBSLEV
ZWORK3(J)=ZWORK2(J)
END DO
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
DO J=1,KOBSLEV
ZWORK33(J)=ZWORK22(J)
END DO
END IF
ELSE
C
C Vertical coordinate conversion option not available.
C
CALL ABORT3D(KULOUT,
1 "CH_VOBS_TO_P: Obs. vert. coord. problem")
C
END IF
C
C Convert from geopotential to pressure (or sigma)
C (all arrays should already be ordered in increasing pressure)
c
C Get pressure on model level at obs. point
c
do J=1,NFLEV
vpres(J)= rppobs(J, KOBS)
ENDDO
C
CALL CH_GP_TO_P(ZWORK3,POBSLEV,KOBSLEV,ZWORK1,VPRES,NFLEV,1)
C
IF (ROBDATA8(NCMPOB,I1).GT.0.0) THEN
CALL CH_GP_TO_P(ZWORK33,POBSLEV2,KOBSLEV,ZWORK1,VPRES,NFLEV,1)
END IF
C
RETURN
END