!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
*
***S/R AJHUM - PURPOSE: AJUSTER LE PROFIL D'ANALYSE D HUMIDITE.
* Calculer la temperature vituelle TV.
* S'assurer que minHU et maxHU sont a l'interieur des
* limites utilisees par le modele radiatif des TOVS(voir comtov.cdk)
* S'assurer que l'analyse HU n'est pas sur sur-saturee.
*
SUBROUTINE AJHUM(PX,TT,HU,TV,WRK1,NISIG,NJSIG,NLSIG,PLEVS, 4,4
1 HUMIN2,QCLIP)
*
IMPLICIT NONE
*
INTEGER NISIG,NJSIG,NLSIG
REAL*8 HUMIN,HUMIN2(NLSIG)
REAL*8 PLEVS(NLSIG)
REAL*8 PX(NISIG*NJSIG,NLSIG),TT(NISIG*NJSIG,NLSIG)
REAL*8 HU(NISIG*NJSIG,NLSIG),TV(NISIG*NJSIG,NLSIG)
REAL*8 WRK1(NISIG*NJSIG,NLSIG)
LOGICAL QCLIP
*
*AUTHOR - J. MORNEAU OCTOBRE 1998
*
*LANGUAGE - FORTRAN
* Revision:
* S. Pellerin *ARMA/SMC May 2000
* .Introduction into 3DVAR
*
* JM Belanger CMDA/SMC Aug 2000
* . 32 bits conversion
* (REAL*8 thermo. functions, generic intrinsic
* functions)
* P KOCLAS JAN 2003: IFIX --> IDINT (AIX)
*
* J Halle CMDA/SMC April 2003
* . replace 300 HPA limit by variable LIMLVHU, which
* defines the upper level of the moisture analysis.
*
* C Charette ARMA Jan 2004
* . Constrains HU within the limits used for the TOVS
* The limits are contained in comtov.cdk. LINTV2
* is used to interpolate to the model pressure levels.
* The extrapolation of HU above LIMLVHU is removed.
* Variable LEVS which contained the list of IP1 of
* RPN standard file is replaced by PLEVS which now
* contains the list of model levels.
* C.Charette Y.Rochon - ARMA/SMC - Sept 2004
* Options for cvcord = CMAM
* J. Halle CMDA/SMC June 2005
* Adapt for RTTOV-8
* S. Pellerin ARMA August 2008
* Call to optimized LINTV_MINMAX
*LIBRAIRIES
* - RPN SOURCE RCS /users/dor/arma/ccc/oi3d (pollux)
* - OBJET LB /home/3rarm/arma/ccc/oilib/liboa64multi_r6.2.a (sx3r)
* - ABSOLUS REP /home/3rarm/arma/ccc/oilib/abs_liboa64multi_r6.2 (sx3r)
* - OBJET LB /data/rpn02/ccc/ao_lib/liboa64_r6.2.a (sx3)
* - ABSOLUS REP /data/rpn02/ccc/ao_lib/abs_liboa64_r6.2 (sx3)
CHARACTER *(*) VERSION
PARAMETER ( VERSION = 'OASRT10N' )
*
*ARGUMENTS-
* E - PX - "ANALYSED" PRESSURE ON MODEL LEVELS
* E - TT - ANALYSED TT ON MODEL LEVES
* E - TV - TV CALCULATED ON MODEL LEVES
* E
* E - NISIG,
* NJSIG - RESOLUTION OF THE MODEL FIELDS GRID
* E - NLSIG - NUMBER OF MODEL LEVELS
* E - PLEVS - MODEL LEVELS
* E - HUMIN2 - Minimun a chaque niveau pour le champs d'essai
* E - WRK1 - WORK ARRAYS
*
*MODULES
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdimo.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "partov.cdk"
#include "comtov.cdk"
*
REAL*8 SFOEW8, SFOQST8, SFOQST8_CMAM
EXTERNAL SFOEW8, SFOQST8, MFOTVT8, SFOQST8_CMAM
**
*-----------------------------------------------------------------------
*
INTEGER I,J,NP,L,PNHUMIN,PNHUMAX,PNHUSAT
REAL*8 ZHUMIN8(NISIG*NJSIG,NLSIG),ZHUMAX8(NISIG*NJSIG,NLSIG)
REAL*8 ZPO(NLSIG),ZMIN(NLSIG),ZMAX(NLSIG)
REAL*8 T0, HUSAT
DATA T0 /273.16/
*
*
*_____PRINT TABLE MAX/MIN OF HU (FROM COMTOV.CDK)
*
WRITE(NULOUT,618)
DO J = 1,NLEVELS1
WRITE(NULOUT,620) J,XPRES(J),OQMIN(J),OQMAX(J)
ENDDO
*
*_____INTERPOLATE MAX/MIN OF HU TO ANALYSIS LEVELS
*
NP = NISIG*NJSIG
CALL LINTV_MINMAX(XPRES,OQMIN,OQMAX,JPLEVMAX,NLEVELS1,NP,NLSIG,PX
& ,ZHUMIN8,ZHUMAX8)
*
*
*_____IMPOSE MAX/MIN
*
WRITE(NULOUT,600) QCLIP
DO I=NLSIG,1,-1
PNHUMIN = 0
PNHUMAX = 0
PNHUSAT = 0
DO J=1,NP
IF (QCLIP) THEN
IF (cvcord(1:3).ne.'MAM') THEN
HU(J,I)= MAX ( ZHUMIN8(J,I), HU(J,I) )
PNHUMIN= PNHUMIN + IDINT(ZHUMIN8(J,I)/HU(J,I))
HU(J,I)= MIN ( ZHUMAX8(J,I) , HU(J,I))
PNHUMAX= PNHUMAX + IDINT(HU(J,I)/ZHUMAX8(J,I))
HUSAT= SFOQST8(TT(J,I)+T0,PX(J,I)*100.0)
ELSE
HUSAT= SFOQST8_CMAM(TT(J,I)+T0,PX(J,I)*100.0)
HU(J,I)= MAX(MIN(ZHUMIN8(J,I),HUMIN2(I)),HU(J,I))
PNHUMIN= PNHUMIN + IDINT(HUMIN2(I)/HU(J,I))
END IF
HU(J,I)= MIN ( husat , HU(J,I))
PNHUSAT= PNHUSAT + IDINT(HU(J,I)/HUSAT)
IF (cvcord(1:3).eq.'MAM') PNHUMAX=PNHUSAT
ENDIF
*
140 enddo
WRITE(NULOUT,610)PLEVS(I) ,ZHUMIN8(1,I),(FLOAT(PNHUMIN)/NP)*100
& ,ZHUMAX8(1,I),(FLOAT(PNHUMAX)/NP)*100,(FLOAT(PNHUSAT)/NP)
& *100
150 enddo
DO I=1,NLSIG
DO J=1,NP
WRK1(J,I)=TT(J,I)+T0
200 enddo
210 enddo
CALL MFOTVT8(TV,WRK1,HU,NP,NLSIG,NP)
DO I=1,NLSIG
DO J=1,NP
TV(J,I)=TV(J,I)-T0
ENDDO
ENDDO
600 FORMAT('-AJHUM-TRAITEMENT DE L HUMIDITE L ANALYSE AVEC ',
1 'CLIP=',L3//)
610 FORMAT('-AJHUM-NIV =',E13.6,', % points .LT. HUMIN(',E10.2,') ='
& ,f7.2,', % points .GT. HUMAX(',E10.2,') =',f7.2
& ,'%, Au-dessus de HUSAT =',f7.2,'%',/)
618 FORMAT('-AJHUM-TABLEAU MIN/MAX DE HU LU DE COMTOV.CDK')
620 FORMAT('-AJHUM-NIV =',I4,', PRES =',F7.2,', HUMIN ='
& ,E10.2,', HUMAX =',E10.2)
RETURN
END