Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:40 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
e259fb67de Jean*0001 #include "ATM_PHYS_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C !ROUTINE: ATM_PHYS_DYN2PHYS
                0005 
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE ATM_PHYS_DYN2PHYS(
                0008      O                    lat2d, pHalf3d, pFull3d,
                0009      O                    zHalf3d, zFull3d,
                0010      O                    t3d, q3d, u3d, v3d,
                0011      I                    bi, bj, myTime, myIter, myThid )
                0012 
                0013 C !DESCRIPTION:
                0014 C     *==========================================================*
                0015 C     | S/R ATM_PHYS_DYN2PHYS
                0016 C     | o Get grid and dynamical fields (from main model common
                0017 C     |   blocks) and return them as argument to ATM_PHYS_DRIVER
                0018 C     *==========================================================*
                0019 C     \ev
                0020 
                0021 C !USES: ===============================================================
                0022       IMPLICIT NONE
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "DYNVARS.h"
                0028 #include "SURFACE.h"
                0029 
                0030 C !INPUT PARAMETERS: ===================================================
                0031 C  bi, bj   :: Tile indices
                0032 C  myTime   :: Current time in simulation
                0033 C  myIter   :: Current time-step number
                0034 C  myThid   :: my Thread Id number
                0035       INTEGER bi, bj
                0036       _RL     myTime
                0037       INTEGER myIter, myThid
                0038 
                0039 C !OUTPUT PARAMETERS: ==================================================
                0040 C  lat2d    :: latitude of grid-cell center          [rad]
                0041 C pHalf3d   :: pressure at interface between 2 levels [Pa]
                0042 C pFull3d   :: pressure at level center               [Pa]
                0043 C zHalf3d   :: height of interface between 2 levels   [m]
                0044 C zFull3d   :: height of level center                 [m]
                0045 C  t3d      :: absolute temperature                   [K]
                0046 C  q3d      :: specific humidity                    [kg/kg]
                0047 C  u3d      :: wind speed, 1rst component (X-dir)    [m/s]
                0048 C  v3d      :: wind speed, 2nd  component (Y-dir)    [m/s]
                0049       _RL lat2d   (sNx,sNy)
                0050       _RL pHalf3d (sNx,sNy,Nr+1)
                0051       _RL pFull3d (sNx,sNy,Nr)
                0052       _RL zHalf3d (sNx,sNy,Nr+1)
                0053       _RL zFull3d (sNx,sNy,Nr)
                0054       _RL t3d     (sNx,sNy,Nr)
                0055       _RL q3d     (sNx,sNy,Nr)
                0056       _RL u3d     (sNx,sNy,Nr)
                0057       _RL v3d     (sNx,sNy,Nr)
                0058 
                0059 C !LOCAL VARIABLES: ====================================================
                0060       _RL conv_theta2T
                0061       INTEGER k, kc, ki, kp
                0062 c     INTEGER ioUnit
                0063 c     _RS     dummyRS(1)
                0064 c     CHARACTER*40 namFile
                0065 CEOP
                0066 
                0067 C--   latitude and pressure levels
                0068       lat2d(:,:) = yC(1:sNx,1:sNy,bi,bj)*deg2rad
                0069 #ifdef NONLIN_FRSURF
                0070       IF ( nonlinFreeSurf.GT.0 ) THEN
                0071        IF ( staggerTimeStep.AND.select_rStar.GT.0 ) THEN
                0072          DO k=1,Nr
                0073           kc = Nr-k+1
                0074           pFull3d(:,:,k) = rF(Nr+1) + ( rC(kc) - rF(Nr+1) )
                0075      &                               *rStarFacC(1:sNx,1:sNy,bi,bj)
                0076          ENDDO
                0077          DO k=1,Nr+1
                0078           ki = Nr-k+2
                0079           pHalf3d(:,:,k) = rF(Nr+1) + ( rF(ki) - rF(Nr+1) )
                0080      &                               *rStarFacC(1:sNx,1:sNy,bi,bj)
                0081          ENDDO
1023b1ccda Jean*0082        ELSEIF ( select_rStar.GT.0 ) THEN
                0083          DO k=1,Nr
                0084           kc = Nr-k+1
                0085           pFull3d(:,:,k) = rF(Nr+1) + ( rC(kc) - rF(Nr+1) )
                0086      &                               *rStarFacNm1C(1:sNx,1:sNy,bi,bj)
                0087          ENDDO
                0088          DO k=1,Nr+1
                0089           ki = Nr-k+2
                0090           pHalf3d(:,:,k) = rF(Nr+1) + ( rF(ki) - rF(Nr+1) )
                0091      &                               *rStarFacNm1C(1:sNx,1:sNy,bi,bj)
                0092          ENDDO
e259fb67de Jean*0093        ELSE
                0094          STOP 'ATM_PHYS_DYN2PHYS: misssing code - 1 -'
                0095        ENDIF
                0096       ELSE
                0097 #else /* ndef NONLIN_FRSURF */
                0098       IF (.TRUE.) THEN
                0099 #endif /* NONLIN_FRSURF */
                0100        DO k=1,Nr
                0101         kc = Nr-k+1
                0102         pFull3d(:,:,k) = rC(kc)
                0103        ENDDO
                0104        DO k=1,Nr+1
                0105         ki = Nr-k+2
                0106         pHalf3d(:,:,k) = rF(ki)
                0107        ENDDO
                0108       ENDIF
                0109 
                0110 C--   level height and 3-D dynamical fields
                0111       DO k=1,Nr
                0112         kc = Nr-k+1
                0113         zFull3d(:,:,k) = ( phiRef(2*kc)
                0114      &                   + totPhiHyd(1:sNx,1:sNy,kc,bi,bj)
                0115      &                   )*recip_gravity
                0116         conv_theta2T = (rC(kc)/atm_po)**atm_kappa
                0117         t3d(:,:,k) = theta(1:sNx,1:sNy,kc,bi,bj)*conv_theta2T
                0118         q3d(:,:,k) = MAX( salt(1:sNx,1:sNy,kc,bi,bj), 0. _d 0 )
                0119         u3d(:,:,k) = ( uVel(1:sNx,  1:sNy,kc,bi,bj)
                0120      &               + uVel(2:sNx+1,1:sNy,kc,bi,bj) )*0.5 _d 0
                0121         v3d(:,:,k) = ( vVel(1:sNx,1:sNy,  kc,bi,bj)
                0122      &               + vVel(1:sNx,2:sNy+1,kc,bi,bj) )*0.5 _d 0
                0123        IF ( nonlinFreeSurf.LE.0 ) THEN
                0124         zFull3d(:,:,k) = zFull3d(:,:,k)
                0125      &                 - Bo_surf(1:sNx,1:sNy,bi,bj)
                0126      &                     *etaN(1:sNx,1:sNy,bi,bj)
                0127      &                     *recip_gravity
                0128        ENDIF
                0129 #ifdef NONLIN_FRSURF
                0130        IF ( select_rStar.GE.1 ) THEN
                0131           t3d(:,:,k) = t3d(:,:,k)*pStarFacK(1:sNx,1:sNy,bi,bj)
                0132        ENDIF
                0133 #endif /* NONLIN_FRSURF */
                0134       ENDDO
                0135 c       ioUnit = 0
                0136 c       WRITE(namFile,'(A,I10.10)') 'z1_Atm.', myIter
                0137 c       CALL MDS_WRITEVEC_LOC(
                0138 c    I                       namFile, writeBinaryPrec, ioUnit,
                0139 c    I                       'RL', sNx*sNy, zFull3d(1,1,Nr), dummyRS,
                0140 c    I                       bi, bj, 1, myIter, myThid )
                0141       DO k=1,Nr+1
                0142         ki = Nr-k+2
                0143         zHalf3d(:,:,k) = phiRef(2*ki-1)*recip_gravity
                0144       ENDDO
                0145       DO k=1,Nr
                0146         kc = Nr-k+1
                0147         kp = MIN(kc+1,Nr)
                0148         zHalf3d(:,:,k) = zHalf3d(:,:,k)
                0149      &                 + ( totPhiHyd(1:sNx,1:sNy,kp,bi,bj)
                0150      &                    +totPhiHyd(1:sNx,1:sNy,kc,bi,bj) )*0.5
                0151      &                  *recip_gravity
                0152        IF ( nonlinFreeSurf.LE.0 ) THEN
                0153         zHalf3d(:,:,k) = zHalf3d(:,:,k)
                0154      &                 - Bo_surf(1:sNx,1:sNy,bi,bj)
                0155      &                     *etaN(1:sNx,1:sNy,bi,bj)
                0156      &                     *recip_gravity
                0157        ENDIF
                0158       ENDDO
                0159 
                0160       RETURN
                0161       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!