program testg ! to test if LINTAD is perfect adjoint of LINT ! verifies that scalar product ! pert1 times LINTAD(pert2) = pert2 times LINT(pert1) ! Louis Garand 2005 parameter (N1=10,N2=15) real*8 p1(n1),p2(n2),pert1(n1),pert2(n2) integer IL(20) real*8 dum1(20),dum2(20),dum3(20),po1(n2),po2(n2),sca1,sca2 real*8 pvig(n2),eta(n2),dpps(1) do i=1,n1 p1(i)= float(i) pert1(i)=0.55 * 2.*(rand()-0.5) enddo do i=1,n2 pert2(i)=0.5* 2.*(rand()-0.5) enddo p2(1)= p1(1) p2(n2)= p1(n1) p2(2)=1.55 p2(3)=2.06 p2(4)=2.70 p2(5)=3.2 p2(6)=3.78 p2(7)=4.67 p2(8)=5.3 p2(9)=5.95 p2(10)=6.7 p2(11)=7.8 p2(12)=8.4 p2(13)=9.2 p2(14)=9.7 call lint(p1,pert1,n1,n1,1,n2,p2,po2) call lintad(p1,po1,n1,n1,1,n2,p2,pert2,pvig,eta,dpps) ! call lint(p2,pert2,n2,n2,1,n1,p1,po1) ! call lintad(p2,po2,n2,n2,1,n1,p1,pert1) sca1=0. sca2=0. do i=1,n1 sca1=sca1+ pert1(i) *po1(i) enddo do i=1,n2 sca2=sca2+ pert2(i) *po2(i) enddo write(*,22) sca1,sca2 22 format('sca1 sca2:',2 f20.15) stop end SUBROUTINE LINT (PVLEV,PVI,KNIDIM,KNI, & & KNPROF,KNO,PPO,PVO) ! !**s/r LINT - Linear interpolation and constant value extrapolation. ! ! !Author : J. Halle *CMDA/AES December 29, 1998 ! L. Garand Revised June 2005: to insure that all input values participate in fit ! with properly balanced weights when KNI > KNO ! !Arguments ! i PVLEV(KNIDIM,KNPROF : Vertical levels (source) ! i PVI(KNIDIM,KNPROF) : Vector to be interpolated (source) ! i KNIDIM : Max dimension of input levels (source) ! i KNI : Actual number of input levels (source) ! i KNPROF : Number of profiles ! i KNO : Number of output levels (destination) ! i PPO(KNO) : Vertical levels (destination) ! o PVO(KNO,KNPROF) : Interpolated profiles (destination) ! ! ------------------- !* Purpose: Performs the vertical interpolation in log of pressure ! and constant value extrapolation of one-dimensional vectors. IMPLICIT NONE ! INTEGER JI, JK, JO, JN, IK, IORDER,K INTEGER KNIDIM, KNI, KNO, KNPROF, ILEN, IERR INTEGER IUP,IDOWN,IKMOD real*8 SUMD,DD(2) real*8 SUMW,weight(0:KNI+1) INTEGER II,NSUP,NDOWN real*8 XSUP,XDOWN ! REAL*8 PVLEV(KNIDIM,KNPROF) REAL*8 PPO(KNO), PVO(KNO,KNPROF) REAL*8 PVI(KNIDIM,KNPROF) ! REAL*8 ZPI (0:KNI+1,KNPROF) REAL*8 ZPO (KNO ,KNPROF) REAL*8 ZPVI(0:KNI+1,KNPROF) INTEGER IL (0:KNO+1 ,KNPROF) ! REAL*8 ZP, XI, ZRT, ZP1, ZP2 INTEGER NPT ! DO JN = 1, KNPROF ZPI(0 ,JN) = PVLEV(1,JN)/2. ZPI(KNI+1,JN) = 2000.0 ENDDO ! !** 1.1 Determine if input pressure levels are in ascending or ! . descending order. ! . ------------------------------------------------------- ! IF ( PVLEV(1,1) .LT. PVLEV(KNI,1) ) THEN IORDER = 1 ELSE IORDER = -1 ENDIF ! DO JK = 1, KNI DO JN = 1, KNPROF ZPI(JK,JN) = PVLEV(JK,JN) ENDDO ENDDO ! !** 2.2 Destination levels ! . ------------------ ! DO JK = 1, KNO DO JN = 1, KNPROF ZPO(JK,JN) = PPO(JK) ENDDO ENDDO ! DO JO=1,KNO DO JN = 1, KNPROF IL(JO,JN) = 0 ENDDO ENDDO ! DO JO=1,KNO DO JI=1,KNI DO JN = 1, KNPROF ZRT = ZPO(JO,JN) ZP = ZPI(JI,JN) XI = SIGN(1.D0,IORDER*(ZRT-ZP)) IL(JO,JN) = IL(JO,JN) + MAX(0.,XI) ENDDO ENDDO ENDDO ! DO JN = 1, KNPROF IL(0,JN) = IL(1,JN) IL(KNO+1,JN)= IL(KNO,JN) ENDDO DO JK = 1, KNI DO JN = 1, KNPROF ZPVI(JK,JN) = PVI(JK,JN) ENDDO ENDDO DO JN = 1, KNPROF ZPVI(0 ,JN) = PVI(1 ,JN) ZPVI(KNI+1,JN) = PVI(KNI,JN) ENDDO DO JO=1,KNO DO JN = 1, KNPROF SUMD=0. SUMW=0. IK = IL(JO,JN) ZP = ZPO(JO,JN) IUP= IK IDOWN=IK+1 NPT = 2 ZP1= ZPI(IUP,JN) ZP2= ZPI(IDOWN,JN) DD(1) = log(ZP/ZP1) DD(2) = log(ZP2/ZP) SUMD = DD(1)+DD(2) ! neighbors of JO weight(IK)= 1. weight(IK+1)= 1. ! search for upward participants (excluding neighbors of JO) NSUP = IL(JO,JN) -IL(JO-1,JN) -2 ! weights defined as 1/(NSUP+1),2/(NSUP+1),...,NSUP/(NSUP+1) if(JO.gt.1.AND.NSUP.GT.0)then IUP=IL(JO-1,JN)+2 II=0 XSUP= 1.0/FLOAT(NSUP+1) DO K= IUP,IL(JO,JN)-1 NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(II)*XSUP SUMW=SUMW+weight(K) ENDDO endif ! search for downward participants (excluding neighbors of JO) NDOWN = IL(JO+1,JN) -IL(JO,JN) -2 if(JO.LT.KNO.AND.NDOWN.GT.0)then IDOWN=IL(JO+1,JN)-1 II=0 XDOWN= 1.0/FLOAT(NDOWN+1) DO K=IL(JO,JN)+2,IDOWN NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(NDOWN-II+1)*XDOWN SUMW=SUMW+weight(K) ENDDO endif ! special cases IKMOD=0 IF(NSUP.eq.-1.AND.NDOWN.EQ.0)weight(IK)=0.5*weight(IK) IF(NDOWN.eq.-1.and.NSUP.EQ.0)weight(IK+1)= 0.5*weight(IK+1) IF(NSUP.eq.-2.and.ndown.eq.0)IKMOD=1 IF(NSUP.eq.0.and.ndown.eq.-2)IKMOD=1 IF(NSUP.eq.-1.and.ndown.eq.-1.and.KNI.gt.kno)IKMOD=1 SUMW=sumW+weight(IK)+weight(IK+1) PVO(JO,JN)=0. do k =IUP,IDOWN JK=K-IUP+1 ! linear interpolation in log P case if(NPT.eq.2.and.(NSUP+NDOWN).LE.-2.and.ikmod.eq.0) THEN PVO(JO,JN) = PVO(JO,JN)+ (1.-DD(JK)/SUMD)* ZPVI(K,JN) ! write(*,88) Jo,K,JK,DD(JK),SUMD,ZPVI(K,JN) ! 88 format(' jo k jk dd sumd zpvi:',3i5,4f10.3) else ! weighted average case ! write(*,51)JO,k,JK,ZPVI(K,jn),weight(k),SUMW ! 51 format('lo k jk zpvi wg sumw:',3i5,5f10.3) PVO(JO,JN) = PVO(JO,JN)+ ZPVI(K,JN)*weight(K)/SUMW ENDIF ENDDO ENDDO ENDDO ! RETURN END SUBROUTINE LINTAD (PVLEV,DPVI,KNIDIM,KNI, & & KNPROF,KNO,PPO,DPVO,PVIG,ETALEV,DPPS) ! !**s/r LINTAD - Adjoint of linear interpolation and ! constant value extrapolation. ! ! !Author : J. Halle, CMDA/AES, December 29, 1998 ! L. Garand Revision June 2005: to insure that all input values participate in fit ! with properly balanced weights when KNI > KNO !Arguments ! i PVLEV(KNIDIM,KNPROF) : Vertical levels as used in forward model ! o DPVI(KNIDIM,KNPROF) : Adjoint of vector to be interpolated (source) ! i KNIDIM : Max dimension of forward levels ! i KNI : Actual number of forward levels ! i KNPROF : Number of profiles ! i KNO : Number of adjoint levels ! i PPO(KNO) : Vertical levels associated with adjoint ! i DPVO(KNO,KNPROF) : Adjoint of interpolated profiles: input to project on PVLEV levels ! i PVIG(KNIDIM,KNPROF) : Input profile (e.g. T, Q, ozone: only used to compute DPPS) ! i ETALEV(KNIDIM) : ETA levels corresponding to PVLEV (only used to get DPPS) ! i DPPS(KNPROF) : component of PS gradient due to change of pressure levels ! ------------------- !* Purpose: Performs the adjoint calculations of vertical interpolation ! in log of pressure and constant value extrapolation of ! one-dimensional vectors. IMPLICIT NONE ! INTEGER JI, JK, JO, JN, IK, IORDER INTEGER KNIDIM, KNI, KNO, KNPROF, ILEN, IERR INTEGER IUP,IDOWN, K,IKMOD real*8 SUMD,DD(2) real*8 weight(0:KNI+1),SUMW INTEGER II,NSUP,NDOWN real*8 XSUP,XDOWN,ZDADPS ! REAL*8 ETALEV(KNIDIM),PVIG(KNIDIM,KNPROF),DPPS(KNPROF) REAL*8 PVLEV(KNIDIM,KNPROF) REAL*8 PPO(KNO),DPVO(KNO,KNPROF) REAL*8 DPVI(KNIDIM,KNPROF) ! REAL*8 ZPI (0:KNI+1,KNPROF) REAL*8 ZPO (KNO ,KNPROF) REAL*8 ZDPVI(0:KNI+1,KNPROF) real*8 ZVLEV(0:KNI+1) REAL*8 ZPVIG(0:KNI+1,KNPROF) INTEGER IL (0:KNO+1 ,KNPROF) ! REAL*8 ZW1, ZW2, XPVO REAL*8 ZP, XI, ZRT, ZP1, ZP2,ADUM INTEGER NPT ! !** 1. Initialization for vertical extrapolation (extra dummy levels) ! . -------------------------------------------------------------- ! 100 CONTINUE ! DO JN = 1, KNPROF ZPI(0 ,JN) = PVLEV(1,JN)/2. ZPI(KNI+1,JN) = 2000.0 ENDDO ! !** 1.1 Determine if input pressure levels are in ascending or ! . descending order. ! . ------------------------------------------------------- ! IF ( PVLEV(1,1) .LT. PVLEV(KNI,1) ) THEN IORDER = 1 ELSE IORDER = -1 ENDIF ! !** 2. Compute pressure levels ! . ----------------------- !** 2.1 Source levels ! . ------------- ! DO JK = 1, KNI DO JN = 1, KNPROF ZPI(JK,JN) = PVLEV(JK,JN) ENDDO ENDDO ! !** 2.2 Destination levels ! . ------------------ ! DO JK = 1, KNO DO JN = 1, KNPROF ZPO(JK,JN) = PPO(JK) ENDDO ENDDO ! !* 3. Interpolate in log of pressure or extrapolate with constant value !* . for each destination pressure level ! . ----------------------------------------------------------------- ! !* . 3.1 Find the adjacent level below ! . ----------------------------- DO JO=1,KNO DO JN = 1, KNPROF IL(JO,JN) = 0 ENDDO ENDDO ! DO JO=1,KNO DO JI=1,KNI DO JN = 1, KNPROF ZRT = ZPO(JO,JN) ZP = ZPI(JI,JN) XI = SIGN(1.D0,IORDER*(ZRT-ZP)) IL(JO,JN) = IL(JO,JN) + MAX(0.,XI) ENDDO ENDDO ENDDO ! DO JN = 1, KNPROF IL(0,JN)= IL(1,JN) IL(KNO+1,JN) = IL(KNO,JN) ENDDO !** Initialize adjoint of profile ! DO JK = 0, KNI+1 DO JN = 1, KNPROF ZDPVI(JK,JN) = 0.0 ENDDO ENDDO !* . 3.2 Fill extra levels, for constant value extrapolation ! . --------------------------------------------------- ! ! DO JK = 1, KNI ZVLEV (JK) = ETALEV (JK) DO JN = 1, KNPROF ZPVIG(JK,JN) = PVIG(JK,JN) ENDDO ENDDO ! ZVLEV (0 ) = ETALEV (1 ) ZVLEV (KNI+1) = ETALEV (KNI) DO JN = 1, KNPROF ZPVIG(0 ,JN) = PVIG(1 ,JN) ZPVIG(KNI+1,JN) = PVIG(KNI,JN) ENDDO do JN=1,KNPROF DPPS(JN)=0. enddo DO JO=1,KNO DO JN = 1, KNPROF SUMD=0. SUMW=0. IK = IL(JO,JN) ZP = ZPO(JO,JN) IUP= IK IDOWN=IK+1 NPT = 2 ZP1= ZPI(IUP,JN) ZP2= ZPI(IDOWN,JN) DD(1) = log(ZP/ZP1) DD(2) = log(ZP2/ZP) SUMD = DD(1)+DD(2) ! neighbors of JO weight(IK)= 1.0 weight(IK+1)= 1.0 ! search for upward participants (excluding neighbors of JO) NSUP = IL(JO,JN) -IL(JO-1,JN) -2 ! weights defined as 1/(NSUP+1),2/(NSUP+1),...,NSUP/(NSUP+1) if(JO.gt.1.AND.NSUP.GT.0)then IUP=IL(JO-1,JN)+2 II=0 XSUP= 1.0/FLOAT(NSUP+1) DO K= IUP,IL(JO,JN)-1 NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(II)*XSUP SUMW=SUMW+weight(K) ENDDO endif ! search for downward participants (excluding neighbors of JO) NDOWN = IL(JO+1,JN) -IL(JO,JN) -2 if(JO.LT.KNO.AND.NDOWN.GT.0)then IDOWN=IL(JO+1,JN)-1 II=0 XDOWN= 1.0/FLOAT(NDOWN+1) DO K=IL(JO,JN)+2,IDOWN NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(NDOWN-II+1)*XDOWN SUMW=SUMW+weight(K) ENDDO endif ! special cases IKMOD=0 IF(NSUP.eq.-1.AND.NDOWN.EQ.0)weight(IK)=0.5*weight(IK) IF(NDOWN.eq.-1.and.NSUP.EQ.0)weight(IK+1)= 0.5*weight(IK+1) IF(NSUP.eq.-2.and.ndown.eq.0)IKMOD=1 IF(NSUP.eq.0.and.ndown.eq.-2)IKMOD=1 IF(NSUP.eq.-1.and.ndown.eq.-1.and.KNI.gt.kno)IKMOD=1 SUMW=SUMW+ weight(IK)+weight(IK+1) ! adjoint ZDADPS= (-ZVLEV(IK)/ZP1*DD(2) -ZVLEV(IK+1)/ZP2*DD(1))/LOG(ZP2/ZP1)**2 ZDADPS = ZDADPS * (ZPVIG(IK+1,JN)-ZPVIG(IK,JN)) do k =IUP,IDOWN jk=K-IUP+1 ! log-linear interpolation case ! as a rule using either log-lin or average mode for whole profile ! is preferable to mixed mode if(NPT.eq.2.and.(NSUP+NDOWN).LE.-2.and.IKMOD.EQ.0)then ZDPVI(K,JN) = ZDPVI(K,JN) + DPVO(JO,JN) *(1.-DD(JK)/SUMD) ! write(*,56)JO,K,JK,IL(JO+JK-1,JN),nsup,ndown,dd(JK),SUMD ! 56 format(' jo k jk dd sumd:',6i5,2f10.3) IF(K.eq.IDOWN) DPPS(JN) = DPPS(JN) + ZDADPS*DPVO(JO,JN) else ! weighted average case ZDPVI(K,JN) = ZDPVI(K,JN) + DPVO(JO,JN)*weight(K)/SUMW ! write(*,55)JO,NPT,IK,iup,idown,k,nsup,ndown,dpvo(jo,jn), ! x weight(k),sumw ! 55 format(' weight sumw:'8i5,4f10.3) endif ENDDO ENDDO ENDDO ! DO JK = 1, KNI DO JN = 1, KNPROF DPVI(JK,JN) = ZDPVI(JK,JN) ENDDO ENDDO ! RETURN END SUBROUTINE LINTTL (PVLEV,DPVI,KNIDIM,KNI, & & KNPROF,KNO,PPO,DPVO,PVIG,ETALEV,DPPS) ! !**s/r LINTTL - Tangent linear of linear interpolation and ! constant value extrapolation. ! ! !Author : J. Halle, CMDA/AES, December 29, 1998 ! L. Garand Revision June 2005: to insure that all input values participate in fit ! with properly balanced weights when KNI > KNO !Arguments ! i PVLEV(KNIDIM,KNPROF) : Vertical levels as used in forward model ! o DPVI(KNIDIM,KNPROF) : Tangent linear of vector to be interpolated (source) ! i KNIDIM : Max dimension of forward levels ! i KNI : Actual number of forward levels ! i KNPROF : Number of profiles ! i KNO : Number of tangent linear levels ! i PPO(KNO) : Vertical levels associated with tangent linear ! i DPVO(KNO,KNPROF) : Tangent linear of interpolated profiles: input to project on PVLEV levels ! i PVIG(KNIDIM,KNPROF) : Input profile (e.g. T, Q, ozone: only used to compute DPPS) ! i ETALEV(KNIDIM) : ETA levels corresponding to PVLEV (only used to get DPPS) ! i DPPS(KNPROF) : component of PS gradient due to change of pressure levels ! ------------------- !* Purpose: Performs the tangent linear calculations of vertical interpolation ! in log of pressure and constant value extrapolation of ! one-dimensional vectors. IMPLICIT NONE ! INTEGER JI, JK, JO, JN, IK, IORDER INTEGER KNIDIM, KNI, KNO, KNPROF, ILEN, IERR INTEGER IUP,IDOWN, K,IKMOD real*8 SUMD,DD(2) real*8 weight(0:KNI+1),SUMW INTEGER II,NSUP,NDOWN real*8 XSUP,XDOWN,ZDADPS ! REAL*8 ETALEV(KNIDIM),PVIG(KNIDIM,KNPROF),DPPS(KNPROF) REAL*8 PVLEV(KNIDIM,KNPROF) REAL*8 PPO(KNO),DPVO(KNO,KNPROF) REAL*8 DPVI(KNIDIM,KNPROF) ! REAL*8 ZPI (0:KNI+1,KNPROF) REAL*8 ZPO (KNO ,KNPROF) REAL*8 ZDPVI(0:KNI+1,KNPROF) real*8 ZVLEV(0:KNI+1) REAL*8 ZPVIG(0:KNI+1,KNPROF) INTEGER IL (0:KNO+1 ,KNPROF) ! REAL*8 ZW1, ZW2, XPVO REAL*8 ZP, XI, ZRT, ZP1, ZP2,ADUM INTEGER NPT ! !** 1. Initialization for vertical extrapolation (extra dummy levels) ! . -------------------------------------------------------------- ! 100 CONTINUE ! DO JN = 1, KNPROF ZPI(0 ,JN) = PVLEV(1,JN)/2. ZPI(KNI+1,JN) = 2000.0 ENDDO ! !** 1.1 Determine if input pressure levels are in ascending or ! . descending order. ! . ------------------------------------------------------- ! IF ( PVLEV(1,1) .LT. PVLEV(KNI,1) ) THEN IORDER = 1 ELSE IORDER = -1 ENDIF ! !** 2. Compute pressure levels ! . ----------------------- !** 2.1 Source levels ! . ------------- ! DO JK = 1, KNI DO JN = 1, KNPROF ZPI(JK,JN) = PVLEV(JK,JN) ENDDO ENDDO ! !** 2.2 Destination levels ! . ------------------ ! DO JK = 1, KNO DO JN = 1, KNPROF ZPO(JK,JN) = PPO(JK) ENDDO ENDDO ! !* 3. Interpolate in log of pressure or extrapolate with constant value !* . for each destination pressure level ! . ----------------------------------------------------------------- ! !* . 3.1 Find the adjacent level below ! . ----------------------------- DO JO=1,KNO DO JN = 1, KNPROF IL(JO,JN) = 0 ENDDO ENDDO ! DO JO=1,KNO DO JI=1,KNI DO JN = 1, KNPROF ZRT = ZPO(JO,JN) ZP = ZPI(JI,JN) XI = SIGN(1.D0,IORDER*(ZRT-ZP)) IL(JO,JN) = IL(JO,JN) + MAX(0.0D0,XI) ENDDO ENDDO ENDDO ! DO JN = 1, KNPROF IL(0,JN)= IL(1,JN) IL(KNO+1,JN) = IL(KNO,JN) ENDDO !* . 3.2 Fill extra levels, for constant value extrapolation ! . --------------------------------------------------- ! ! DO JK = 1, KNI ZVLEV (JK) = ETALEV (JK) DO JN = 1, KNPROF ZDPVI(JK,JN) = DPVI(JK,JN) ZPVIG(JK,JN) = PVIG(JK,JN) ENDDO ENDDO ! ZVLEV (0 ) = ETALEV (1 ) ZVLEV (KNI+1) = ETALEV (KNI) DO JN = 1, KNPROF ZDPVI(0 ,JN) = 0. ZDPVI(KNI+1,JN) = 0. ZPVIG(0 ,JN) = PVIG(1 ,JN) ZPVIG(KNI+1,JN) = PVIG(KNI,JN) ENDDO DO JO=1,KNO DO JN = 1, KNPROF DPVO(JO,JN) = 0. SUMD=0. SUMW=0. IK = IL(JO,JN) ZP = ZPO(JO,JN) IUP= IK IDOWN=IK+1 NPT = 2 ZP1= ZPI(IUP,JN) ZP2= ZPI(IDOWN,JN) DD(1) = log(ZP/ZP1) DD(2) = log(ZP2/ZP) SUMD = DD(1)+DD(2) ! neighbors of JO weight(IK)= 1.0 weight(IK+1)= 1.0 ! search for upward participants (excluding neighbors of JO) NSUP = IL(JO,JN) -IL(JO-1,JN) -2 ! weights defined as 1/(NSUP+1),2/(NSUP+1),...,NSUP/(NSUP+1) if(JO.gt.1.AND.NSUP.GT.0)then IUP=IL(JO-1,JN)+2 II=0 XSUP= 1.0/FLOAT(NSUP+1) DO K= IUP,IL(JO,JN)-1 NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(II)*XSUP SUMW=SUMW+weight(K) ENDDO endif ! search for downward participants (excluding neighbors of JO) NDOWN = IL(JO+1,JN) -IL(JO,JN) -2 if(JO.LT.KNO.AND.NDOWN.GT.0)then IDOWN=IL(JO+1,JN)-1 II=0 XDOWN= 1.0/FLOAT(NDOWN+1) DO K=IL(JO,JN)+2,IDOWN NPT=NPT+1 II=II+1 WEIGHT(K)=FLOAT(NDOWN-II+1)*XDOWN SUMW=SUMW+weight(K) ENDDO endif ! special cases IKMOD=0 IF(NSUP.eq.-1.AND.NDOWN.EQ.0)weight(IK)=0.5*weight(IK) IF(NDOWN.eq.-1.and.NSUP.EQ.0)weight(IK+1)= 0.5*weight(IK+1) IF(NSUP.eq.-2.and.ndown.eq.0)IKMOD=1 IF(NSUP.eq.0.and.ndown.eq.-2)IKMOD=1 IF(NSUP.eq.-1.and.ndown.eq.-1.and.KNI.gt.kno)IKMOD=1 SUMW=SUMW+ weight(IK)+weight(IK+1) ! tangent linear ZDADPS= (-ZVLEV(IK)/ZP1*DD(2) & & -ZVLEV(IK+1)/ZP2*DD(1))/LOG(ZP2/ZP1)**2 ZDADPS = ZDADPS * (ZPVIG(IK+1,JN)-ZPVIG(IK,JN)) do k =IUP,IDOWN jk=K-IUP+1 ! log-linear interpolation case ! as a rule using either log-lin or average mode for whole profile ! is preferable to mixed mode if(NPT.eq.2.and.(NSUP+NDOWN).LE.-2.and.IKMOD.EQ.0)then DPVO(JO,JN) = DPVO(JO,JN)+ (1.-DD(JK)/SUMD)* ZDPVI(K,JN) IF(K.eq.IDOWN) DPVO(JO,JN) = DPVO(JO,JN) + ZDADPS* DPPS(JN) else ! weighted average case DPVO(JO,JN) = DPVO(JO,JN) + ZDPVI(K,JN)*weight(K)/SUMW ! write(*,55)JO,NPT,IK,iup,idown,k,nsup,ndown,dpvo(jo,jn), ! x weight(k),sumw ! 55 format(' weight sumw:'8i5,4f10.3) endif ENDDO ENDDO ENDDO ! RETURN END