Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:58 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
861a196fd3 Jean*0001 #include "DIAG_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_INTERP_P2P
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGNOSTICS_INTERP_P2P(
                0009      O                       qprs,
                0010      I                       qinp,pkz,pksrf,pktop,pk,
                0011      I                       undef, pInc,ijm,lm, myThid )
                0012 
                0013 C     !DESCRIPTION:
                0014 C***********************************************************************
                0015 C
                0016 C PURPOSE
                0017 C   To interpolate an arbitrary quantity to Specified Pressure Levels
                0018 C
                0019 C INPUT
                0020 C   QINP .. QINP (ijm,lm) Arbitrary Input Quantity
                0021 C   PKZ ... PKZ  (ijm,lm) Pressure to the Kappa at Input Levels
                0022 C   PKSRF . PKSRF(ijm) Surface Pressure to the Kappa
                0023 C   PKTOP . Pressure to the Kappa at Input-Level-Edge (1) (top of model)
                0024 C   PK .... Output Pressure to the Kappa Level (mb)
                0025 C   pInc .. if True, assume pressure increases with level index
                0026 C   IJM ... Horizontal Dimension of Input
                0027 C   LM .... Vertical  Dimension of Input
                0028 C
                0029 C OUTPUT
                0030 C   QPRS .. QPRS (ijm) Arbitrary Quantity at Pressure p
                0031 C
                0032 C NOTE
                0033 C   Quantity is interpolated Linear in P**Kappa.
                0034 C   Between  PTOP**Kappa and PKZ(1),  quantity is extrapolated.
                0035 C   Between PKSRF**Kappa and PKZ(LM), quantity is extrapolated.
                0036 C   Undefined Input quantities are not used.
                0037 C   Finally: This routine assumes that pressure levels are counted
                0038 C            top down -- ie, level 1 is the top, level lm is the bottom
                0039 C
                0040 C***********************************************************************
                0041 C     !USES:
                0042       IMPLICIT NONE
                0043 
                0044 C     !INPUT PARAMETERS:
                0045       INTEGER  ijm,lm,myThid
                0046       _RL  qinp (ijm,lm)
                0047       _RL  pkz  (ijm,lm)
                0048       _RL  pksrf(ijm)
                0049       _RL  pktop,pk
                0050       _RL  undef
                0051       LOGICAL pInc
                0052 
                0053 C     !OUTPUT PARAMETERS:
                0054       _RL  qprs (ijm)
                0055 CEOP
                0056 
                0057 C     !LOCAL VARIABLES:
                0058       INTEGER  i,l
                0059       _RL  pkmin,pkmax,temp
                0060 
                0061 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0062 
                0063 c Initialize to UNDEFINED
                0064 c -----------------------
                0065       DO i=1,ijm
                0066        qprs(i) = undef
                0067       ENDDO
                0068 
                0069       IF ( pInc ) THEN
                0070 C---  Case where Levels are orderd by increasing pressure
                0071 
                0072 c Interpolate to Pressure Between Input Levels
                0073 c --------------------------------------------
                0074       DO L=1,lm-1
                0075        pkmin = pkz(1,L)
                0076        pkmax = pkz(1,L+1)
                0077 
                0078        DO i=2,ijm
                0079          IF ( pkz(i,L)  .LT.pkmin ) pkmin = pkz(i,L)
                0080          IF ( pkz(i,L+1).GT.pkmax ) pkmax = pkz(i,L+1)
                0081        ENDDO
                0082 
                0083        IF ( pk.LE.pkmax .AND. pk.GE.pkmin ) THEN
                0084          DO i=1,ijm
                0085            IF ( pk.GE.pkz(i,L) .AND. pk.LE.pkz(i,L+1) ) THEN
                0086              temp = ( pk-pkz(i,L) ) / ( pkz(i,L+1)-pkz(i,L) )
                0087 
                0088              IF     ( qinp(i,L)  .NE.undef  .AND.
                0089      &                qinp(i,L+1).NE.undef ) THEN
                0090                qprs(i) = qinp(i,L+1)*temp + qinp(i,L)*(1.-temp)
                0091              ELSEIF ( qinp(i,L+1).NE.undef  .AND. temp.GE.0.5 ) THEN
                0092                qprs(i) = qinp(i,L+1)
                0093              ELSEIF ( qinp(i,L)  .NE.undef  .AND. temp.LE.0.5 ) THEN
                0094                qprs(i) = qinp(i,L)
                0095              ENDIF
                0096            ENDIF
                0097          ENDDO
                0098        ENDIF
                0099 
                0100       ENDDO
                0101 
                0102       DO i=1,ijm
                0103 c Extrapolate to Pressure between Ptop and Highest Input Level
                0104 c ----------------------------------------------------------
                0105        IF ( pk.LE.pkz(i,1) .AND. pk.GE.pktop ) THEN
                0106          temp = ( pk-pkz(i,1) ) / ( pkz(i,2)-pkz(i,1) )
                0107 
                0108          IF     ( qinp(i,1).NE.undef  .AND.
                0109      &           qinp(i,2).NE.undef ) THEN
                0110            qprs(i) = qinp(i,2)*temp + qinp(i,1)*(1.-temp)
                0111          ELSEIF ( qinp(i,1).NE.undef ) THEN
                0112            qprs(i) = qinp(i,1)
                0113          ENDIF
                0114 
                0115        ENDIF
                0116 
                0117 c Extrapolate to Pressure between Psurf and Lowest Input Level
                0118 c ------------------------------------------------------------
                0119        IF ( pk.GE.pkz(i,lm) .AND. pk.LE.pksrf(i) ) THEN
                0120          temp = ( pk-pkz(i,lm) ) / ( pkz(i,lm-1)-pkz(i,lm) )
                0121 
                0122          IF     ( qinp(i,lm)  .NE.undef  .AND.
                0123      &            qinp(i,lm-1).NE.undef ) THEN
                0124             qprs(i) = qinp(i,lm-1)*temp + qinp(i,lm)*(1.-temp)
                0125          ELSEIF ( qinp(i,lm)  .NE.undef ) THEN
                0126             qprs(i) = qinp(i,lm)
                0127          ENDIF
                0128 
                0129        ENDIF
                0130       ENDDO
                0131 
                0132       ELSE
                0133 C---  Case where Levels are orderd by decreasing pressure
                0134 
                0135 c Interpolate to Pressure Between Input Levels
                0136 c --------------------------------------------
                0137       DO L=1,lm-1
                0138        pkmin = pkz(1,L+1)
                0139        pkmax = pkz(1,L)
                0140 
                0141        DO i=2,ijm
                0142          IF ( pkz(i,L+1).LT.pkmin ) pkmin = pkz(i,L+1)
                0143          IF ( pkz(i,L)  .GT.pkmax ) pkmax = pkz(i,L)
                0144        ENDDO
                0145 
                0146        IF ( pk.LE.pkmax .AND. pk.GE.pkmin ) THEN
                0147          DO i=1,ijm
                0148            IF ( pk.LE.pkz(i,L) .AND. pk.GE.pkz(i,L+1) ) THEN
                0149              temp = ( pk-pkz(i,L) ) / ( pkz(i,L+1)-pkz(i,L) )
                0150 
                0151              IF     ( qinp(i,L)  .NE.undef  .AND.
                0152      &                qinp(i,L+1).NE.undef ) THEN
                0153                qprs(i) = qinp(i,L+1)*temp + qinp(i,L)*(1.-temp)
                0154              ELSEIF ( qinp(i,L+1).NE.undef  .AND. temp.GE.0.5 ) THEN
                0155                qprs(i) = qinp(i,L+1)
                0156              ELSEIF ( qinp(i,L)  .NE.undef  .AND. temp.LE.0.5 ) THEN
                0157                qprs(i) = qinp(i,L)
                0158              ENDIF
                0159            ENDIF
                0160          ENDDO
                0161        ENDIF
                0162 
                0163       ENDDO
                0164 
                0165       DO i=1,ijm
                0166 c Extrapolate to Pressure between Ptop and Highest Input Level
                0167 c ----------------------------------------------------------
                0168        IF ( pk.LE.pkz(i,lm) .AND. pk.GE.pktop ) THEN
                0169          temp = ( pk-pkz(i,lm) ) / ( pkz(i,lm-1)-pkz(i,lm) )
                0170 
                0171          IF     ( qinp(i,lm)  .NE.undef  .AND.
                0172      &            qinp(i,lm-1).NE.undef ) THEN
                0173             qprs(i) = qinp(i,lm-1)*temp + qinp(i,lm)*(1.-temp)
                0174          ELSEIF ( qinp(i,lm)  .NE.undef ) THEN
                0175             qprs(i) = qinp(i,lm)
                0176          ENDIF
                0177 
                0178        ENDIF
                0179 
                0180 c Extrapolate to Pressure between Psurf and Lowest Input Level
                0181 c ------------------------------------------------------------
                0182        IF ( pk.GE.pkz(i,1) .AND. pk.LE.pksrf(i) ) THEN
                0183          temp = ( pk-pkz(i,1) ) / ( pkz(i,2)-pkz(i,1) )
                0184 
                0185          IF     ( qinp(i,1).NE.undef  .AND.
                0186      &            qinp(i,2).NE.undef ) THEN
                0187            qprs(i) = qinp(i,2)*temp + qinp(i,1)*(1.-temp)
                0188          ELSEIF ( qinp(i,1).NE.undef ) THEN
                0189            qprs(i) = qinp(i,1)
                0190          ENDIF
                0191 
                0192        ENDIF
                0193       ENDDO
                0194 
                0195 C---  End case increasing/decreasing pressure
                0196       ENDIF
                0197 
                0198       RETURN
                0199       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!