SUBROUTINE CH_TLMTRANS(PVAR1,PVAR2,PMUL,PADD, 2 & KN,KNK,KTR,KMODE,CDVAR) C IMPLICIT NONE C C* Declaration of arguments C INTEGER KN,KNK,KMODE,KTR REAL*8 PVAR1(KN,KNK),PVAR2(KN,KNK),PMUL,PADD CHARACTER*(*) CDVAR C *--------------------------------------------------------- #if defined (DOC) * ***s/r CH_TLMTRANS - TLM of variable transformation in CH_VARTRANS * **Author : Y.J. Rochon ARQX/MSC July 2005 * **Revisions: * * ------------------- * *Purpose: TLM of variable transformation in CH_VARTRANS * *Arguments: * * INPUT * * KN,KNK: Dimensions * PVAR1: Input analysis or trial field (or dummy array if not required) * PVAR2: Input increment field * KTR: Forward TLM 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 * * PVAR2: Output increment field * *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 d(log(x)) = (dx)/x C where PVAR1=x, PVAR2=dx C IF (KMODE.eq.0) THEN C C Apply forward transform (non-linearity considerations disregarded) C IC=COUNT(MASK=(PVAR2.lt.-70.*PVAR1.or.PVAR2.gt.70.*PVAR1)) IF (IC.GT.0) THEN write(nulout,*) 'CH_TLMTRANS: 1. Out of range for ',CDVAR call abort3d(nulout,'CH_TLMTRANS') ELSE PVAR2=PVAR2/PVAR1 END IF ELSE C C Apply inverse transform: dx = x*d(log(x))= exp(log(x)) * d(log(x)) C where PVAR1=x, PVAR2=d(log(x)) C IC=COUNT(MASK=(PVAR2.lt.-70.0.or.PVAR2.gt.70)) IF (IC.GT.0) THEN write(nulout,*) 'CH_TLMTRANS: 2. Out of range for ',CDVAR call abort3d(nulout,'CH_TLMTRANS') ELSE c PVAR2=EXP(PVAR1)*PVAR2 PVAR2=PVAR1*PVAR2 END IF END IF C ELSE C write(nulout,*) 'CH_TLMTRANS: Unknown transform. ' call abort3d(nulout,'CH_TLMTRANS') C END IF C RETURN END