SUBROUTINE CH_VCOORD(KIND,KIND2,KNLEV,KNDESC,KALT, 1 & KVCORDTYP,KVCORD,KDESC,PROF,PROF2) * IMPLICIT NONE * INTEGER KIND,KIND2,KNLEV,KNDESC,KVCORDTYP,KVCORD,KALT REAL*8 PROF(knlev),PROF2(knlev) INTEGER KDESC(kndesc) * #if defined (DOC) *------------------------------------------------------------------------- * ***s/r CH_VCOORD - Finalize vertical coordinate arrays and related flags. * * *Author . Y.J. Rochon and Y. Yang, *AQRB/MSC June 2005 * Based on initial code by Y. Yang * *Revision: * * PURPOSE: Finalize vertical coordinate arrays and related flags. * * Step 1: Test for availability of required coordinate info. * Step 2: Add station altitude to heights when appropriate * Step 3: For KIND2>0, ensure that the layer top is stored in zprof * and the layer bottom is in zprof2 * * ARGUMENTS: * * INPUT: * * KIND : Flag indicating presence of reference * vertical coordinate profile (<0 for no) * KIND2 : Flag indicating presence of second reference * vertical coordinate profile (<0 for no) * KNLEV : Number of levels * KNDESC : Number of obs descriptors found * KDESC : List of obs descriptors found * KVCORDTYP:Flag indicating type of vertical coordinate * KVCORD : Coordinate descriptor * KALT : Station altitude (+400) in meters obtained * from report header * PROF : First vertical coordinate array * PROF2 : Second vertical coordinate array if available * * OUTPUT: * * PROF : Reference array for vertical coordinate * PROF2 : Array of layer bottoms (when relevant) * KVCORDTYP:Flag indicating type of vertical coordinate * KVCORD : Coordinate descriptor * *------------------------------------------------------------------------- #endif * #include "comlun.cdk"
#include "cparbrp.cdk"
* INTEGER JJ,J REAL*8 ZPROF3(jpmxnlv) C C* Test for availability of required coordinate info. C IF (KIND.LE.0.AND.KNLEV.NE.1) then C C No vertical cordinate data found C write(nulout, *) 'CH_VCOORD:' write(nulout, *) 'Could not find vertical coordinate data.' write(nulout,*) call abort3d(nulout,'CH_VCOORD') ENDIF C J=1 IF (KIND.LE.0.AND.KNLEV.EQ.1) then C C No vertical cordinate data found. Check for total column obs C if (kdesc(j).eq.15001.or.kdesc(j).eq.15198.or.kdesc(j).eq.15024.or. & kdesc(j).eq.15020.or.kdesc(j).eq.15200) then C kIND=1 kIND2=1 kVCORDTYP=2 kVCORD=7004 prof(1)=0.0 prof2(1)=120000. ! 1200.00 hPa ELSE write(nulout, *) 'CH_VCOORD:' write(nulout, *) 'Could not find vertical coordinate.' write(nulout,*) call abort3d(nulout,'CH_VCOORD') END IF ELSE IF (kIND2.LE.0) THEN kIND2=0 ENDIF C C* Verify if the station altitude should be added C to the vertical coordinate values C IF (KALT.NE.0.AND.KVCORD.EQ.7006.AND.KIND.GT.0) THEN C C Station altitude in the header can be used. C DO jj=1,KNLEV prof(JJ)= prof(JJ) + REAL(KALT-400) END DO IF (KIND2.GT.0) THEN DO jj=1,KNLEV prof2(JJ)= prof2(JJ) + REAL(KALT-400) END DO ENDIF ELSE IF (KVCORD.eq.007006) THEN C C For 7006, station altitude should exist. Give a warning if not. C write(nulout, *) 'CH_VCOORD:' WRITE(nulout, *) 'Station altitude is missing for 7006.' write(nulout,*) call abort3d(nulout,'CH_VCOORD') END IF C C* When relevant, examine, and re-arrange as required, order of C layer boundaries. C IF (KIND.GT.0.and.KIND2.GT.0) then C C Ensure that the layer top is stored in zprof and C the layer bottom is in zprof2 C if (KVCORDTYP.eq.2) then C C Pressure levels C if (prof2(1) .lt. prof(1)) then DO jj=1,KNLEV zprof3(JJ) = prof(JJ) prof(JJ) = prof2(JJ) prof2(JJ) = zprof3(JJ) END DO endif C else C C Altitude or geopotential C if (prof2(1) .gt. prof(1)) then DO jj=1,KNLEV zprof3(JJ) = prof(JJ) prof(JJ) = prof2(JJ) prof2(JJ) = zprof3(JJ) END DO endif C endif !(KVCORDTYP .eq.2) C END IF C RETURN END