pkg/gridalt/dyn2phys.F

cc36b35673 Jean*0001 #include "GRIDALT_OPTIONS.h"
                0002
8aa94f3b31 Andr*0003       subroutine dyn2phys(qdyn,pedyn,im1,im2,jm1,jm2,lmdyn,Nsx,Nsy,
                0004      . idim1,idim2,jdim1,jdim2,bi,bj,windphy,pephy,Lbot,lmphy,nlperdyn,
                0005      . flg,qphy)
                0006 C***********************************************************************
                0007 C Purpose:
                0008 C   To interpolate an arbitrary quantity from the 'dynamics' eta (pstar)
cc36b35673 Jean*0009 C               grid to the higher resolution physics grid
8aa94f3b31 Andr*0010 C Algorithm:
                0011 C   Routine works one layer (edge to edge pressure) at a time.
                0012 C   Dynamics -> Physics retains the dynamics layer mean value,
cc36b35673 Jean*0013 C   weights the field either with the profile of the physics grid
8aa94f3b31 Andr*0014 C   wind speed (for U and V fields), or uniformly (T and Q)
                0015 C
                0016 C Input:
                0017 C   qdyn..... [im,jm,lmdyn] Arbitrary Quantity on Input Grid
                0018 C   pedyn.... [im,jm,lmdyn+1] Pressures at bottom edges of input levels
                0019 C   im1,2 ... Limits for Longitude Dimension of Input
                0020 C   jm1,2 ... Limits for Latitude  Dimension of Input
                0021 C   lmdyn.... Vertical  Dimension of Input
                0022 C   Nsx...... Number of processes in x-direction
                0023 C   Nsy...... Number of processes in y-direction
                0024 C   idim1,2.. Beginning and ending i-values to calculate
                0025 C   jdim1,2.. Beginning and ending j-values to calculate
                0026 C   bi....... Index of process number in x-direction
                0027 C   bj....... Index of process number in x-direction
                0028 C   windphy.. [im,jm,lmphy] Magnitude of the wind on the output levels
                0029 C   pephy.... [im,jm,lmphy+1] Pressures at bottom edges of output levels
                0030 C   lmphy.... Vertical  Dimension of Output
                0031 C   nlperdyn. [im,jm,lmdyn] Highest Physics level in each dynamics level
                0032 C   flg...... Flag to indicate field type (0 for T or Q, 1 for U or V)
                0033 C
                0034 C Output:
                0035 C   qphy..... [im,jm,lmphy] Quantity at output grid (physics grid)
                0036 C
                0037 C Notes:
                0038 C   1) This algorithm assumes that the output (physics) grid levels
                0039 C      fit exactly into the input (dynamics) grid levels
                0040 C***********************************************************************
                0041       implicit none
                0042
                0043       integer  im1, im2, jm1, jm2, lmdyn, lmphy, Nsx, Nsy, flg
                0044       integer idim1, idim2, jdim1, jdim2, bi, bj
                0045       _RL qdyn(im1:im2,jm1:jm2,lmdyn,Nsx,Nsy)
                0046       _RL pedyn(im1:im2,jm1:jm2,lmdyn+1,Nsx,Nsy)
                0047       _RL pephy(im1:im2,jm1:jm2,lmphy+1,Nsx,Nsy)
                0048       _RL windphy(im1:im2,jm1:jm2,lmphy,Nsx,Nsy)
                0049       integer nlperdyn(im1:im2,jm1:jm2,lmdyn,Nsx,Nsy)
                0050       _RL qphy(im1:im2,jm1:jm2,lmphy,Nsx,Nsy)
                0051       integer Lbot(im1:im2,jm1:jm2,Nsx,Nsy)
                0052
                0053       _RL weights(im1:im2,jm1:jm2,lmphy)
29d4ea4c99 Andr*0054       _RL pphy(im1:im2,jm1:jm2,lmphy)
8bb9f0d9db Andr*0055       _RL dpkedyn, dpkephy, windsum, qd
8aa94f3b31 Andr*0056       integer  i,j,L,Lout1,Lout2,Lphy
4d198cba86 Jean*0057 cinterp1  _RL kappa
                0058 #ifdef ALLOW_FIZHI
                0059 cinterp1  _RL getcon
                0060 #else
                0061 cinterp1 #include 'SIZE.h'
                0062 cinterp1 #include 'EEPARAMS.h'
                0063 cinterp1 #include 'PARAMS.h'
                0064 #endif
8aa94f3b31 Andr*0065
4d198cba86 Jean*0066 #ifdef ALLOW_FIZHI
                0067 cinterp1  kappa = getcon('KAPPA')
                0068 #else
                0069 cinterp1  kappa = atm_kappa
                0070 #endif
8aa94f3b31 Andr*0071
29d4ea4c99 Andr*0072 C define physics grid mid level pressures
                0073       do Lphy = 1,lmphy
                0074        do j = jdim1,jdim2
                0075         do i = idim1,idim2
cc36b35673 Jean*0076          pphy(i,j,Lphy) =
29d4ea4c99 Andr*0077      .       (pephy(i,j,Lphy,bi,bj)+pephy(i,j,Lphy+1,bi,bj))/2.
                0078         enddo
                0079        enddo
                0080       enddo
                0081
8aa94f3b31 Andr*0082 c do loop for all dynamics (input) levels
8bb9f0d9db Andr*0083       do L = 1,lmdyn
                0084 c do loop for all grid points
                0085        do j = jdim1,jdim2
                0086         do i = idim1,idim2
                0087          qd = qdyn(i,j,L,bi,bj)
8aa94f3b31 Andr*0088 c Check to make sure we are above ground - if not, do nothing
                0089          if(L.ge.Lbot(i,j,bi,bj))then
                0090           if(L.eq.Lbot(i,j,bi,bj)) then
                0091            Lout1 = 0
                0092           else
                0093            Lout1 = nlperdyn(i,j,L-1,bi,bj)
                0094           endif
                0095           Lout2 = nlperdyn(i,j,L,bi,bj)
                0096 c for U and V fields, need to compute for the weights:
29d4ea4c99 Andr*0097 cinterp1  dpkedyn = (pedyn(i,j,L,bi,bj)**kappa)-
                0098 cinterp1                                  (pedyn(i,j,L+1,bi,bj)**kappa)
                0099           dpkedyn = pedyn(i,j,L,bi,bj)-pedyn(i,j,L+1,bi,bj)
8aa94f3b31 Andr*0100           if(flg.eq.1)then
                0101            windsum = 0.
                0102            do Lphy = Lout1+1,Lout2
616b995d4d Andr*0103 cinterp1    dpkephy = (pephy(i,j,Lphy,bi,bj)**kappa)-
                0104 cinterp1                                (pephy(i,j,Lphy+1,bi,bj)**kappa)
                0105             dpkephy = pephy(i,j,Lphy,bi,bj)-pephy(i,j,Lphy+1,bi,bj)
8aa94f3b31 Andr*0106             windsum = windsum+(windphy(i,j,Lphy,bi,bj)*dpkephy)/dpkedyn
                0107            enddo
                0108           endif
                0109 c do loop for all physics levels contained in this dynamics level
                0110           do Lphy = Lout1+1,Lout2
                0111            weights(i,j,Lphy) = 1.
                0112            if( (flg.eq.1).and.(windsum.ne.0.) )
                0113      .                weights(i,j,Lphy)=windphy(i,j,Lphy,bi,bj)/windsum
29d4ea4c99 Andr*0114            if( (flg.eq.2) .and. (pedyn(i,j,L,bi,bj).lt.10000.)) then
cc36b35673 Jean*0115             weights(i,j,Lphy) =
29d4ea4c99 Andr*0116      .   (qd-5. + (10.*(pedyn(i,j,L,bi,bj)-pphy(i,j,Lphy))/dpkedyn))/qd
                0117            elseif( (flg.eq.2) .and. (pedyn(i,j,L,bi,bj).ge.10000.)) then
                0118             weights(i,j,Lphy) = 1.
cc36b35673 Jean*0119            endif
8bb9f0d9db Andr*0120            qphy(i,j,Lphy,bi,bj) = qd * weights(i,j,Lphy)
8aa94f3b31 Andr*0121           enddo
                0122          endif
                0123         enddo
                0124        enddo
                0125       enddo
                0126
                0127       return
                0128       end