SUBROUTINE CH_VARTRANS(PVAR1,PVAR2,PMUL,PADD, 1 & KN,KNK,KTR,KNVAR,KMODE,CDVAR) C IMPLICIT NONE C C* Declaration of arguments C INTEGER KN,KNK,KMODE,KNVAR,KTR REAL*8 PVAR1(KN,KNK),PVAR2(KN,KNK),PMUL,PADD CHARACTER*(*) CDVAR C *--------------------------------------------------------- #if defined (DOC) * ***s/r CH_VARTRANS - Variable transformation. * **Author : Y.J. Rochon ARQX/MSC July 2005 * **Revisions: * * ------------------- * *Purpose: Variable transformation. * *Arguments: * * INPUT * * KN,KNK: Dimensions * KNVAR: Index specifying variable on which to operate. * 0 for analysis or trial field (PVAR1) * 1 for increments (PVAR2) * 2 for both (PVAR1 and PVAR2) * PVAR1: Input analysis or trial field * PVAR2: Input increment field (or dummy array) * KTR: Forward transformation scheme * 0 for none * 1 for log of input * KMODE: Index for forward or inverse transformation * 0 for forward * 1 for inverse * PMUL: Scaling factor * PADD: Addition factor (after scaling) * CDVAR: Variable name * * OUTPUT * * PVAR1: Output analysis or trial field (KNVAR.ne.1) * PVAR2: Output increment field (KNVAR.ne.0) * *Comments: * *----------------------------------------------------------- #endif C C* Global variables C #include "comlun.cdk"
#include "comcst.cdk"
C C* Declaration of local variables C INTEGER IC C IF (KTR.eq.0) RETURN C IF (KTR.eq.1) THEN C C Forward transform is log(input) C IF (KMODE.eq.0) THEN C C Apply forward transform C IF (KNVAR.EQ.1.OR.KNVAR.EQ.2) THEN IC=COUNT(MASK=PVAR1+PVAR2 < 1.E-32) IF (IC.GT.0) THEN write(nulout,*) 'CH_VARTRANS: 1. Values too small for ',CDVAR call abort3d(nulout,'CH_VARTRANS') ELSE PVAR2=LOG(PVAR1+PVAR2) END IF END IF IF (KNVAR.EQ.0.OR.KNVAR.EQ.2) THEN IC=COUNT(MASK=PVAR1 < 1.E-32) IF (IC.GT.0) THEN write(nulout,*) 'CH_VARTRANS: 2. Values too small for ',CDVAR call abort3d(nulout,'CH_VARTRANS') ELSE PVAR1=LOG(PVAR1) END IF END IF ELSE C C Apply inverse transform C IF (KNVAR.EQ.1.OR.KNVAR.EQ.2) THEN IC=COUNT(MASK=(PVAR1+PVAR2.lt.-70.0.or.PVAR1+PVAR2.gt.70)) IF (IC.GT.0) THEN write(nulout,*) 'CH_VARTRANS: 1. Values out of range for ',CDVAR call abort3d(nulout,'CH_VARTRANS') ELSE PVAR2=EXP(PVAR1+PVAR2) END IF END IF IF (KNVAR.EQ.0.OR.KNVAR.EQ.2) THEN IC=COUNT(MASK=(PVAR1.lt.-70.0.or.PVAR1.gt.70)) IF (IC.GT.0) THEN write(nulout,*) 'CH_VARTRANS: 2. Values out of range for ',CDVAR call abort3d(nulout,'CH_VARTRANS') ELSE PVAR1=EXP(PVAR1) END IF END IF END IF C ELSE C write(nulout,*) 'CH_VARTRANS: Unknown transform. ' call abort3d(nulout,'CH_VARTRANS') C END IF C RETURN END