Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002 
90299b0597 Jean*0003 CBOP
                0004 C     !ROUTINE: AIM_AIM2DYN
                0005 C     !INTERFACE:
d676f916b2 Jean*0006       SUBROUTINE AIM_AIM2DYN(
90299b0597 Jean*0007      I                        bi, bj, myTime, myIter, myThid )
                0008 
                0009 C     !DESCRIPTION: \bv
d676f916b2 Jean*0010 C     *==========================================================*
90299b0597 Jean*0011 C     | S/R AIM_AIM2DYN
                0012 C     | o Remap AIM outputs to dynamics conforming arrays.
d676f916b2 Jean*0013 C     |==========================================================*
90299b0597 Jean*0014 C     | Currently AIM exports to the dynmaics
                0015 C     |  - PBL drag coefficient
                0016 C     |  - Net tendency for temperature
                0017 C     |  - Net tendency for water vapor
                0018 C     | Exporting drag has the nice property that it is a scalar.
                0019 C     | This means that the exchanges on the AIM exported fields
                0020 C     | do not need special piaring on the cube. It may not be
                0021 C     | a good idea in the long term as it makes assumptions
                0022 C     | about the momentum schemes within AIM.
d676f916b2 Jean*0023 C     *==========================================================*
90299b0597 Jean*0024 C     \ev
d676f916b2 Jean*0025 C-------
                0026 C  Note: Except LSC tendency, all others need to be /dpFac.
                0027 C-------
90299b0597 Jean*0028 
                0029 C     !USES:
d676f916b2 Jean*0030       IMPLICIT NONE
                0031 
90299b0597 Jean*0032 C     == Global variables ===
d676f916b2 Jean*0033 C-- size for MITgcm & Physics package :
1a72cb671e Jean*0034 #include "AIM_SIZE.h"
d676f916b2 Jean*0035 
                0036 #include "EEPARAMS.h"
                0037 #include "PARAMS.h"
                0038 #include "GRID.h"
26494fa735 Jean*0039 #include "SURFACE.h"
d676f916b2 Jean*0040 
                0041 #include "AIM2DYN.h"
                0042 #include "com_physvar.h"
                0043 
90299b0597 Jean*0044 C     !INPUT/OUTPUT PARAMETERS:
d676f916b2 Jean*0045 C     == Routine arguments ==
90299b0597 Jean*0046 C     bi,bj  :: Tile index
                0047 C     myTime :: Current time of simulation ( s )
                0048 C     myIter :: Current iteration number in simulation
                0049 C     myThid :: Number of this instance of the routine
                0050       INTEGER bi, bj
                0051       _RL     myTime
                0052       INTEGER myIter, myThid
                0053 CEOP
d676f916b2 Jean*0054 
                0055 #ifdef ALLOW_AIM
90299b0597 Jean*0056 C     !LOCAL VARIABLES:
d676f916b2 Jean*0057 C     == Local variables ==
                0058 C     i,j,k        :: loop counters
                0059 C     I2,Katm      :: loop counters
                0060 C     conv_T2theta :: conversion factor from (absolute) Temp. to Pot.Temp.
                0061       _RL conv_T2theta
                0062       INTEGER i,j,k
                0063       INTEGER I2, Katm
1a72cb671e Jean*0064 #ifdef ALLOW_DIAGNOSTICS
                0065       LOGICAL  physTendDiag
                0066       LOGICAL  DIAGNOSTICS_IS_ON
                0067       EXTERNAL DIAGNOSTICS_IS_ON
                0068 #endif
d676f916b2 Jean*0069 
90299b0597 Jean*0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 
d676f916b2 Jean*0072 C--   Physics tendency term
                0073 
1a72cb671e Jean*0074 #ifdef ALLOW_DIAGNOSTICS
                0075       physTendDiag = .FALSE.
                0076       IF (useDiagnostics) THEN
                0077         physTendDiag = DIAGNOSTICS_IS_ON( 'DIABT   ', myThid )
                0078      &            .OR. DIAGNOSTICS_IS_ON( 'DIABQ   ', myThid )
                0079       ENDIF
                0080 #endif
                0081 
26494fa735 Jean*0082 C-    Planetary boundary layer drag coeff.
                0083       DO j=1,sNy
                0084         DO i=1,sNx
                0085          I2 = i+(j-1)*sNx
                0086          aim_drag(i,j,bi,bj) = DRAG(I2,0,myThid)
                0087         ENDDO
                0088       ENDDO
07f2439e50 Jean*0089 #ifdef COMPONENT_MODULE
                0090       IF ( useCoupler ) THEN
                0091 C-    Near surface wind speed
                0092        DO j=1,sNy
                0093         DO i=1,sNx
                0094          I2 = i+(j-1)*sNx
                0095          aim_surfWind(i,j,bi,bj) = SPEED0(I2,myThid)
                0096         ENDDO
                0097        ENDDO
                0098       ENDIF
                0099 #endif /* COMPONENT_MODULE */
26494fa735 Jean*0100 
d676f916b2 Jean*0101       DO k=1,Nr
26494fa735 Jean*0102        Katm = _KD2KA( k )
54052ec14b Jean*0103        conv_T2theta = (atm_Po/rC(k))**atm_kappa
26494fa735 Jean*0104 
1a72cb671e Jean*0105 C-     Add all tendencies (ignoring partial cell factor) for T & Q
                0106 C          and convert Temp. tendency to Pot.Temp. tendency
d676f916b2 Jean*0107        DO j=1,sNy
                0108         DO i=1,sNx
                0109          I2 = i+(j-1)*sNx
1a72cb671e Jean*0110 C        temperature tendency
                0111          aim_dTdt(i,j,k,bi,bj) = ( TT_CNV(I2,Katm,myThid)
d676f916b2 Jean*0112      &                            +TT_PBL(I2,Katm,myThid)
                0113      &                            +TT_RSW(I2,Katm,myThid)
                0114      &                            +TT_RLW(I2,Katm,myThid)
1a72cb671e Jean*0115      &                            +TT_LSC(I2,Katm,myThid)
                0116      &                           )*conv_T2theta
                0117 C        water vapor tendency
26494fa735 Jean*0118          aim_dSdt(i,j,k,bi,bj) =   QT_CNV(I2,Katm,myThid)
d676f916b2 Jean*0119      &                            +QT_PBL(I2,Katm,myThid)
1a72cb671e Jean*0120      &                            +QT_LSC(I2,Katm,myThid)
26494fa735 Jean*0121         ENDDO
                0122        ENDDO
54052ec14b Jean*0123 #ifdef NONLIN_FRSURF
                0124        IF ( select_rStar.GE.1 ) THEN
                0125          DO j=1,sNy
                0126           DO i=1,sNx
                0127             aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
                0128      &                            / pStarFacK(i,j,bi,bj)
                0129           ENDDO
                0130          ENDDO
                0131        ENDIF
                0132 #endif /* NONLIN_FRSURF */
d676f916b2 Jean*0133 
1a72cb671e Jean*0134 #ifdef ALLOW_DIAGNOSTICS
                0135        IF ( physTendDiag ) THEN
                0136          CALL DIAGNOSTICS_FILL( aim_dTdt, 'DIABT   ',
                0137      &                          k, Nr, 1,bi,bj, myThid )
                0138          CALL DIAGNOSTICS_FILL( aim_dSdt, 'DIABQ   ',
                0139      &                          k, Nr, 1,bi,bj, myThid )
                0140        ENDIF
                0141 #endif /* ALLOW_DIAGNOSTICS */
                0142 
26494fa735 Jean*0143 C-     Account for partial cell filling:
                0144 #ifdef NONLIN_FRSURF
                0145        IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
                0146         IF ( select_rStar.GT.0 ) THEN
                0147          DO j=1,sNy
                0148           DO i=1,sNx
54052ec14b Jean*0149             aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
                0150      &                          *recip_hFacC(i,j,k,bi,bj)
                0151      &                              /rStarExpC(i,j,bi,bj)
                0152             aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
                0153      &                          *recip_hFacC(i,j,k,bi,bj)
                0154      &                              /rStarExpC(i,j,bi,bj)
26494fa735 Jean*0155           ENDDO
                0156          ENDDO
                0157         ELSE
                0158          DO j=1,sNy
54052ec14b Jean*0159           DO i=1,sNx
                0160            IF ( k.EQ.kSurfC(i,j,bi,bj) ) THEN
                0161             aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
                0162      &                             /hFac_surfC(i,j,bi,bj)
                0163             aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
                0164      &                             /hFac_surfC(i,j,bi,bj)
                0165            ELSE
                0166             aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
                0167      &                          *recip_hFacC(i,j,k,bi,bj)
                0168             aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
                0169      &                          *recip_hFacC(i,j,k,bi,bj)
                0170            ENDIF
                0171           ENDDO
26494fa735 Jean*0172          ENDDO
                0173         ENDIF
                0174        ELSE
                0175 #else /* ndef NONLIN_FRSURF */
                0176        IF (.TRUE.) THEN
                0177 #endif /* NONLIN_FRSURF */
54052ec14b Jean*0178          DO j=1,sNy
                0179           DO i=1,sNx
                0180             aim_dTdt(i,j,k,bi,bj) =  aim_dTdt(i,j,k,bi,bj)
                0181      &                           *recip_hFacC(i,j,k,bi,bj)
                0182             aim_dSdt(i,j,k,bi,bj) =  aim_dSdt(i,j,k,bi,bj)
                0183      &                           *recip_hFacC(i,j,k,bi,bj)
                0184           ENDDO
26494fa735 Jean*0185          ENDDO
                0186        ENDIF
                0187 
                0188 C--- end of k loop.
d676f916b2 Jean*0189       ENDDO
                0190 
                0191 #endif /* ALLOW_AIM */
                0192 
                0193       RETURN
                0194       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!