Back to home page

MITgcm
 
 

    

File indexing completed on 2023-02-03 06:09:56 UTC

view on githubraw file Latest commit edb66560 on 2023-02-02 23:32:31 UTC
d8206d87ee Patr*0001 #include "EBM_OPTIONS.h"
4e4ad91a39 Jean*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
d8206d87ee Patr*0005 
dc08631bb4 Jean*0006 CBOP 0
                0007 C !ROUTINE: EBM_ATMOSPHERE
d8206d87ee Patr*0008 
dc08631bb4 Jean*0009 C !INTERFACE:
                0010       SUBROUTINE EBM_ATMOSPHERE ( myTime, myIter, myThid )
                0011 
                0012 C     !DESCRIPTION:
                0013 C     *==========================================================*
                0014 C     | S/R CALCULATE FORCING FROM ENERGY AND MOISTURE
                0015 C     | BALANCE ATMOSPHERE
                0016 C     *==========================================================*
d8206d87ee Patr*0017 C      References:
                0018 C      * X. Wang, P. Stone and J. Marotzke, 1999:
                0019 C        Global thermohaline circulation. Part I:
                0020 C        Sensitivity to atmospheric moisture transport.
                0021 C        J. Climate 12(1), 71-82
                0022 C      * X. Wang, P. Stone and J. Marotzke, 1999:
                0023 C        Global thermohaline circulation. Part II:
                0024 C        Sensitivity with interactive transport.
                0025 C        J. Climate 12(1), 83-91
                0026 C      * M. Nakamura, P. Stone and J. Marotzke, 1994:
                0027 C        Destabilization of the thermohaline circulation
                0028 C        by atmospheric eddy transports.
                0029 C        J. Climate 7(12), 1870-1882
                0030 
dc08631bb4 Jean*0031 C     !USES:
d8206d87ee Patr*0032       IMPLICIT NONE
                0033 C     === Global variables ===
                0034 #include "SIZE.h"
                0035 #include "EEPARAMS.h"
                0036 #include "PARAMS.h"
                0037 #include "FFIELDS.h"
                0038 #include "GRID.h"
6206cdb986 Jean*0039 #include "EBM.h"
b08554040b Patr*0040 #ifdef ALLOW_AUTODIFF_TAMC
                0041 # include "tamc.h"
                0042 #endif
d8206d87ee Patr*0043 
dc08631bb4 Jean*0044 C     !INPUT PARAMETERS:
d8206d87ee Patr*0045 C     === Routine arguments ===
dc08631bb4 Jean*0046 C     myThid  :: my Thread Id number
d8206d87ee Patr*0047       _RL myTime
dc08631bb4 Jean*0048       INTEGER myIter
                0049       INTEGER myThid
                0050 CEOP
d8206d87ee Patr*0051 
                0052 #ifdef ALLOW_EBM
dc08631bb4 Jean*0053 C     !LOCAL VARIABLES:
2c03616886 Jean*0054       INTEGER i, j, bi, bj
d8206d87ee Patr*0055       INTEGER no_so
dc08631bb4 Jean*0056 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0057 C     ikey :: tape key (tile dependent)
                0058       INTEGER ikey
dc08631bb4 Jean*0059 #endif /* ALLOW_AUTODIFF_TAMC */
2c03616886 Jean*0060       _RL ReCountX(1-OLy:sNy+OLy,nSy)
                0061 
                0062 C--   Local arrays used for EBM computation (previously declared in EBM.h)
                0063 C-    sin(lat) and Legendre polynomials
                0064 cph We will make these three (i,j) arrays to
                0065 cph avoid AD recomputations
                0066       _RL S(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSy)
                0067       _RL P2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSy)
                0068       _RL P4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSy)
                0069 C-    Shortwave and albedo parameters
                0070       _RL SW(1-OLy:sNy+OLy,nSy)
                0071 C-    Longwave parameters
                0072       _RL LW(1-OLy:sNy+OLy,nSy)
                0073 C-    Heat transport parameters
                0074       _RL Hd(1-OLy:sNy+OLy,nSy), Hd35(2)
                0075 C-    Freshwater flux parameters
                0076       _RL Fw(1-OLy:sNy+OLy,nSy), Fw35(2)
                0077 C-    Temperature parameterization
                0078       _RL T(1-OLy:sNy+OLy,nSy)
                0079       _RL T_var(4), T0(2), T2(2), T35(2), DTDy35(2)
                0080 C-    Parameters used to calculate the transport efficiency
                0081       _RL Cl, Cf, Cs, C
                0082       _RL gamma, kappa, De
                0083 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8831cd24b3 Jean*0084 
d8206d87ee Patr*0085       DO bj=myByLo(myThid),myByHi(myThid)
                0086        DO bi=myBxLo(myThid),myBxHi(myThid)
                0087 
b08554040b Patr*0088 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0089         ikey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
b08554040b Patr*0090 #endif /* ALLOW_AUTODIFF_TAMC */
                0091 
4e4ad91a39 Jean*0092         DO j=1-OLy,sNy+OLy
                0093          DO i=1-OLx,sNx+OLx
b08554040b Patr*0094           S(i,j,bj) = 0.0
                0095           P2(i,j,bj) = 0.0
                0096           P4(i,j,bj) = 0.0
                0097          ENDDO
4e8c9bded2 Patr*0098          SW(j,bj) = 0.0
                0099          LW(j,bj) = 0.0
                0100          Hd(j,bj) = 0.0
                0101          Fw(j,bj) = 0.0
                0102          T(j,bj) = 0.0
                0103          ReCountX(j,bj) = 0.0
d8206d87ee Patr*0104         ENDDO
                0105 
                0106         print *, 'SH', TmlS-t_mlt, TtS-t_mlt
                0107         print *, 'NH', TmlN-t_mlt, TtN-t_mlt
                0108 
                0109 C--   account for ice (can absorb heat on an annual averaged basis)
                0110 C--   Greenland in Northern Hemisphere, Antarctica in Southern
4e8c9bded2 Patr*0111         DO j = 1,sNy
                0112          ReCountX(j,bj) = CountX(j,bj)
d8206d87ee Patr*0113          IF (yC(1,j,bi,bj) .LE. -62.0) THEN
4e8c9bded2 Patr*0114             ReCountX(j,bj) = 90.
d8206d87ee Patr*0115          ELSE IF (yC(1,j,bi,bj) .EQ. 74.0) THEN
4e8c9bded2 Patr*0116             ReCountX(j,bj) = CountX(j,bj) + 9.0
d8206d87ee Patr*0117          ELSE IF (yC(1,j,bi,bj) .EQ. 70.0) THEN
4e8c9bded2 Patr*0118             ReCountX(j,bj) = CountX(j,bj) + 8.0
d8206d87ee Patr*0119          ELSE IF (yC(1,j,bi,bj) .EQ. 66.0) THEN
4e8c9bded2 Patr*0120             ReCountX(j,bj) = CountX(j,bj) + 5.0
d8206d87ee Patr*0121          ELSE IF (yC(1,j,bi,bj) .EQ. 62.0) THEN
4e8c9bded2 Patr*0122             ReCountX(j,bj) = CountX(j,bj) + 1.0
d8206d87ee Patr*0123          ENDIF
                0124         ENDDO
b08554040b Patr*0125 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0126 CADJ STORE ReCountX(:,bj) = comlev1_bibj, key=ikey, byte=isbyte
b08554040b Patr*0127 #endif
d8206d87ee Patr*0128 
                0129 c=====================================================
                0130 c     Fit area-weighed  averaged SST north/south of 34
                0131 c     degree  to second  Legendre polynomial:
                0132 c=======================================================
2c03616886 Jean*0133         T_var(1) = SIN(latBnd(2)*deg2rad) - SIN(latBnd(1)*deg2rad)
                0134         T_var(2) = SIN(latBnd(3)*deg2rad) - SIN(latBnd(2)*deg2rad)
                0135         T_var(3) = SIN(latBnd(2)*deg2rad)**3 - SIN(latBnd(1)*deg2rad)**3
                0136         T_var(4) = SIN(latBnd(3)*deg2rad)**3 - SIN(latBnd(2)*deg2rad)**3
b08554040b Patr*0137 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0138 CADJ STORE T_var(:) = comlev1_bibj, key=ikey, byte=isbyte
b08554040b Patr*0139 #endif
d8206d87ee Patr*0140 
                0141 c----------------------------------------
                0142 c     Southern hemisphere:
                0143 c----------------------------------------
                0144         T2(1) =  2.*(TtS - TmlS)*T_var(1)*T_var(2)/
8831cd24b3 Jean*0145      &     (T_var(3)*T_var(2) - T_var(4)*T_var(1))
d8206d87ee Patr*0146         T0(1) = TtS - 0.5*T2(1)*((T_var(3)/T_var(1)) - 1.)
                0147 c----------------------------------------
fae6796590 Jean*0148 c     Northern hemisphere
d8206d87ee Patr*0149 c----------------------------------------
                0150         T2(2) =  2.*(TtN - TmlN)*T_var(1)*T_var(2)/
8831cd24b3 Jean*0151      &     (T_var(3)*T_var(2) - T_var(4)*T_var(1))
d8206d87ee Patr*0152         T0(2) = TtN - 0.5*T2(2)*((T_var(3)/T_var(1)) - 1.)
                0153 c-----------------------------------------
                0154 c     Temperature  at 35 N/S
                0155 c-----------------------------------------
                0156         DO no_so = 1,2
8831cd24b3 Jean*0157          T35(no_so)= T0(no_so) +
                0158      &        T2(no_so)*0.5*
2c03616886 Jean*0159      &        ( 3.*SIN(latBnd(2)*deg2rad)**2 - 1. )
d8206d87ee Patr*0160         ENDDO
                0161 c-----------------------------------------
                0162 c     Temperature gradient at 35 N/S
                0163 c-----------------------------------------
                0164         DO no_so = 1, 2
                0165          DTDy35(no_so) = 3.*T2(no_so)*
2c03616886 Jean*0166      &        SIN(latBnd(2)*deg2rad)/rSphere
d8206d87ee Patr*0167         ENDDO
                0168 c-----------------------------------------------------------
                0169 c     Magnitude of the heat and moisture transport at 35 N/S
                0170 c-----------------------------------------------------------
                0171 
b08554040b Patr*0172 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0173 CADJ STORE T35(:)    = comlev1_bibj, key=ikey, byte=isbyte
                0174 CADJ STORE DTDy35(:) = comlev1_bibj, key=ikey, byte=isbyte
b08554040b Patr*0175 #endif
d8206d87ee Patr*0176         DO no_so = 1, 2
d4a46b1cd8 Patr*0177          IF ( DTDy35(no_so).NE.0. .AND. T35(no_so).NE.0. ) THEN
                0178           gamma = -T35(no_so)*beta*Hw*Nw*Nw/
8831cd24b3 Jean*0179      &        (gravity*f0*DTDy35(no_so))
                0180           kappa = Hw/(1. _d 0 + gamma)
                0181           De = Hw/(0.48 _d 0 + 1.48 _d 0 *gamma)
                0182           C = 0.6 _d 0 *gravity*kappa*kappa*Nw/
                0183      &        (Tw*f0*f0)
d4a46b1cd8 Patr*0184           Cs = rho_air*cp*C*
8831cd24b3 Jean*0185      &        ( 1. _d 0 /(1. _d 0 /Hw + 1. _d 0 /De)
                0186      &         -1. _d 0 /(1. _d 0 /Hw+1. _d 0 /De+1. _d 0 /dz) )
                0187           Cf = htil*2.97 _d 12*C/(T35(no_so)**3)*(
                0188      &        1. _d 0/(1. _d 0/De + (5420. _d 0*tau /(T35(no_so)**2)))
                0189      &        -1. _d 0/(1. _d 0/De+5420. _d 0*tau/(T35(no_so)**2)
                0190      &        +1. _d 0/dz))
d4a46b1cd8 Patr*0191           Cl = Cf*lv
2c03616886 Jean*0192           Hd35(no_so) = 2.*PI*rSphere*COS(latBnd(2)*deg2rad)
8831cd24b3 Jean*0193      &        *(Cs + Cl*exp(-5420./T35(no_so)))
                0194      &        *(abs(DTDy35(no_so))**trans_eff)
2c03616886 Jean*0195           Fw35(no_so) = 2.*PI*rSphere*COS(latBnd(2)*deg2rad)
8831cd24b3 Jean*0196      &        *(abs(DTDy35(no_so))**trans_eff)
                0197      &        *Cf*exp(-5420./T35(no_so))
d4a46b1cd8 Patr*0198          ELSE
                0199           Hd35(no_so) = 0.
                0200           Fw35(no_so) = 0.
                0201          ENDIF
d8206d87ee Patr*0202         ENDDO
d4a46b1cd8 Patr*0203 c
d8206d87ee Patr*0204         Fw35(1) = 929944128.
                0205         Fw35(2) = 678148032.
d4a46b1cd8 Patr*0206 c
d8206d87ee Patr*0207 #ifdef EBM_VERSION_1BASIN
                0208 c      Fw35(2) = 0.7*Fw35(2)
                0209 #else
8831cd24b3 Jean*0210         Hd35(2) = 1.6 _d 0*Hd35(2)
d8206d87ee Patr*0211 #endif
                0212 c======================================================
                0213 c     Calculation of latitudinal profiles
                0214 c======================================================
8831cd24b3 Jean*0215 c
4e8c9bded2 Patr*0216         DO j=1,sNy
                0217          DO i=1,sNx
b08554040b Patr*0218 C     sin(lat)
2c03616886 Jean*0219           S(i,j,bj) = SIN(yC(i,j,bi,bj)*deg2rad)
b08554040b Patr*0220 C     setup Legendre polynomials and  derivatives
                0221           P2(i,j,bj) = 0.5*(3.*S(i,j,bj)**2 - 1.)
8831cd24b3 Jean*0222           P4(i,j,bj) = 0.12 _d 0 *
                0223      &                (35.*S(i,j,bj)**4 - 30.*S(i,j,bj)**2 + 3.)
b08554040b Patr*0224          ENDDO
                0225         ENDDO
                0226 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0227 CADJ STORE S(:,:,bj)    = comlev1_bibj, key=ikey, byte=isbyte
                0228 CADJ STORE P2(:,:,bj)   = comlev1_bibj, key=ikey, byte=isbyte
                0229 CADJ STORE P4(:,:,bj)   = comlev1_bibj, key=ikey, byte=isbyte
b08554040b Patr*0230 #endif
8831cd24b3 Jean*0231 c
b08554040b Patr*0232         DO j=1,sNy
                0233          DO i=1,sNx
d8206d87ee Patr*0234 
                0235           IF (yC(i,j,bi,bj) .LT. 0.) THEN
                0236              no_so = 1
                0237           ELSE
                0238              no_so = 2
                0239           ENDIF
                0240 c     net shortwave
8831cd24b3 Jean*0241           SW(j,bj) = 0.25 _d 0 *Q0*(1. _d 0 + Q2*P2(i,j,bj))*
                0242      &         (1. _d 0 - A0 - A2*P2(i,j,bj) - A4*P4(i,j,bj) )
d8206d87ee Patr*0243 c     temperature
b08554040b Patr*0244           T(j,bj) = T0(no_so) + T2(no_so)*P2(i,j,bj)
d8206d87ee Patr*0245 c     net longwave
4e8c9bded2 Patr*0246           LW(j,bj) = LW0 + LW1*(T(j,bj)-t_mlt)
d8206d87ee Patr*0247 c     climate change run, the parameter to change is DLW
                0248 #ifdef EBM_CLIMATE_CHANGE
8831cd24b3 Jean*0249              LW(j,bj) = LW(j,bj) -
                0250      &            (myTime-startTime)*3.215 _d -8*DLW
d8206d87ee Patr*0251 c     <            - 6.0
                0252 c     <            *75.0*0.0474*
8831cd24b3 Jean*0253 c     <            (-2.62*S(i,j,bj)**8 + 0.73*S(i,j,bj)**7 +
                0254 c     <            4.82*S(i,j,bj)**6 -
                0255 c     <            1.12*S(i,j,bj)**5 - 2.69*S(i,j,bj)**4 + 0.47*S(i,j,bj)**3 +
b08554040b Patr*0256 c     <            0.51*S(i,j,bj)**2 - 0.05*S(i,j,bj)**1 + 0.17)
d8206d87ee Patr*0257 #endif
                0258 c     fluxes at ocean/atmosphere interface
                0259 c     Heat Flux = -Div(atmospheric heat transport) + SW - LW
                0260 #ifdef EBM_VERSION_1BASIN
8831cd24b3 Jean*0261          Qnet(i,j,bi,bj) = -1.0 _d 0 *( SW(j,bj) - LW(j,bj) -
                0262      &        Hd35(no_so)*(
                0263      &        0.000728 _d 4      - 0.00678 _d 4*S(i,j,bj) +
                0264      &        0.0955 _d 4*S(i,j,bj)**2 + 0.0769 _d 4*S(i,j,bj)**3 -
                0265      &        0.8508 _d 4*S(i,j,bj)**4 - 0.3581 _d 4*S(i,j,bj)**5 +
                0266      &        2.9240 _d 4*S(i,j,bj)**6 + 0.8311 _d 4*S(i,j,bj)**7 -
                0267      &        4.9548 _d 4*S(i,j,bj)**8 - 0.8808 _d 4*S(i,j,bj)**9 +
                0268      &        4.0644 _d 4*S(i,j,bj)**10 +0.3409 _d 4*S(i,j,bj)**11 -
                0269      &        1.2893 _d 4*S(i,j,bj)**12 )
                0270      &        /(2.*PI*rSphere*rSphere*25.) )
                0271 c             Qnet(i,j,bi,bj) = -1.0*( SW(j,bj) - LW(j,bj) -
                0272 c     <            0.5*Hd35(no_so)*(3.054e1 - 3.763e1*S(i,j,bj) +
                0273 c     <        1.892e2*S(i,j,bj)**2 + 3.041e2*S(i,j,bj)**3 -
                0274 c     <        1.540e3*S(i,j,bj)**4 - 9.586e2*S(i,j,bj)**5 +
                0275 c     <        2.939e3*S(i,j,bj)**6 + 1.219e3*S(i,j,bj)**7 -
                0276 c     <        2.550e3*S(i,j,bj)**8 - 5.396e2*S(i,j,bj)**9 +
b08554040b Patr*0277 c     <        8.119e2*S(i,j,bj)**10)
d8206d87ee Patr*0278 c     <            /(2*PI*rSphere*rSphere*22.3) )
                0279 #else
4e8c9bded2 Patr*0280           IF (ReCountX(j,bj) .GT. 0.) THEN
8831cd24b3 Jean*0281              Qnet(i,j,bi,bj) = (-90. _d 0 /ReCountX(j,bj))*
                0282      &            ( SW(j,bj) - LW(j,bj) -
                0283      &            Hd35(no_so)*(3.054 _d 1 - 3.763 _d 1*S(i,j,bj) +
                0284      &        1.892 _d 2*S(i,j,bj)**2 + 3.041 _d 2*S(i,j,bj)**3 -
                0285      &        1.540 _d 3*S(i,j,bj)**4 - 9.586 _d 2*S(i,j,bj)**5 +
                0286      &        2.939 _d 3*S(i,j,bj)**6 + 1.219 _d 3*S(i,j,bj)**7 -
                0287      &        2.550 _d 3*S(i,j,bj)**8 - 5.396 _d 2*S(i,j,bj)**9 +
                0288      &        8.119 _d 2*S(i,j,bj)**10)
                0289      &            /(2.*PI*rSphere*rSphere*22.3 _d 0) )
d8206d87ee Patr*0290           ELSE
                0291              Qnet(i,j,bi,bj) = 0.
                0292           ENDIF
                0293 #endif
                0294 c     Freshwater Flux = Div(atmospheric moisture transport)
ba0b047096 Mart*0295 c---  conversion of E-P from kg/(s m^2) -> m/s -> g/kg/s: 1e-3*35/delZ(1)
d8206d87ee Patr*0296 #ifdef EBM_VERSION_1BASIN
8831cd24b3 Jean*0297           EmPmR(i,j,bi,bj) = -1. _d -3*Fw35(no_so)
                0298      &    *(-0.8454 _d 5*S(i,j,bj)**14 + 0.5367 _d 5*S(i,j,bj)**13
                0299      &    +3.3173 _d 5*S(i,j,bj)**12 - 1.8965 _d 5*S(i,j,bj)**11
                0300      &    -5.1701 _d 5*S(i,j,bj)**10
                0301      &    +2.6240 _d 5*S(i,j,bj)**9 + 4.077 _d 5*S(i,j,bj)**8
                0302      &    -1.791 _d 5*S(i,j,bj)**7
                0303      &    -1.7231 _d 5*S(i,j,bj)**6 + 0.6229 _d 5*S(i,j,bj)**5
                0304      &    +0.3824 _d 5*S(i,j,bj)**4
                0305      &    -0.1017 _d 5*S(i,j,bj)**3 - 0.0387 _d 5*S(i,j,bj)**2
                0306      &    +0.00562 _d 5*S(i,j,bj)  + 0.0007743 _d 5)
                0307      &    /(2.0*12.0*PI*rSphere*rSphere)
d8206d87ee Patr*0308 c             EmPmR(i,j,bi,bj) = 1.e-3*Fw35(no_so)
8831cd24b3 Jean*0309 c     <            *(50.0 + 228.0*S(i,j,bj) -1.593e3*S(i,j,bj)**2
                0310 c     <            - 2.127e3*S(i,j,bj)**3 + 7.3e3*S(i,j,bj)**4
                0311 c     <            + 5.799e3*S(i,j,bj)**5 - 1.232e4*S(i,j,bj)**6
                0312 c     <            - 6.389e3*S(i,j,bj)**7 + 9.123e3*S(i,j,bj)**8
b08554040b Patr*0313 c     <            + 2.495e3*S(i,j,bj)**9 - 2.567e3*S(i,j,bj)**10)
8831cd24b3 Jean*0314 c     <            /(2*PI*rSphere*rSphere*15.0)
d8206d87ee Patr*0315 #else
                0316           IF (yC(i,j,bi,bj) .LT. -40.) THEN
                0317 c--   Southern Hemisphere
8831cd24b3 Jean*0318            EmPmR(i,j,bi,bj) = -1. _d -3*(Fw35(no_so)*
                0319      &            (-6.5 _d 0 + 35.3 _d 0 + 71.7 _d 0*S(i,j,bj)
                0320      &           - 1336.3 _d 0*S(i,j,bj)**2 - 425.8 _d 0*S(i,j,bj)**3
                0321      &           + 5434.8 _d 0*S(i,j,bj)**4 + 707.9 _d 0*S(i,j,bj)**5
                0322      &           - 6987.7 _d 0*S(i,j,bj)**6 - 360.4 _d 0*S(i,j,bj)**7
                0323      &           + 2855.0 _d 0*S(i,j,bj)**8)
                0324      &            /(2.*PI*rSphere*rSphere*18.0))
d8206d87ee Patr*0325           ELSE
                0326 c--   Atlantic
8831cd24b3 Jean*0327            IF (xC(i,j,bi,bj) .GT. 284.
                0328      &      .OR. xC(i,j,bi,bj) .LT. 28.) THEN
                0329               EmPmR(i,j,bi,bj) = -1. _d -3*(Fw35(no_so)*
                0330      &             (-6.5 _d 0 -2.878 _d 0 + 3.157 _d 2*S(i,j,bj) -
                0331      &             2.388 _d 3*S(i,j,bj)**2 - 4.101 _d 3*S(i,j,bj)**3 +
                0332      &             1.963 _d 4*S(i,j,bj)**4 + 1.534 _d 4*S(i,j,bj)**5 -
                0333      &             6.556 _d 4*S(i,j,bj)**6 - 2.478 _d 4*S(i,j,bj)**7 +
                0334      &             1.083 _d 5*S(i,j,bj)**8 + 1.85 _d 4*S(i,j,bj)**9 -
                0335      &             8.703 _d 4*S(i,j,bj)**10 - 5.276 _d 3*S(i,j,bj)**11 +
                0336      &             2.703 _d 4*S(i,j,bj)**12)
                0337      &             /(2.*PI*rSphere*rSphere*12.0))
d8206d87ee Patr*0338            ELSE
                0339 c--   Pacific
8831cd24b3 Jean*0340               EmPmR(i,j,bi,bj) = -1. _d -3*(Fw35(no_so)
                0341      &             *(-6.5 _d 0 +51.89 _d 0 + 4.916 _d 2*S(i,j,bj) -
                0342      &             1.041 _d 3*S(i,j,bj)**2 - 7.546 _d 3*S(i,j,bj)**3 +
                0343      &             2.335 _d 3*S(i,j,bj)**4 + 3.449 _d 4*S(i,j,bj)**5 +
                0344      &             6.702 _d 3*S(i,j,bj)**6 - 6.601 _d 4*S(i,j,bj)**7 -
                0345      &             2.594 _d 4*S(i,j,bj)**8 + 5.652 _d 4*S(i,j,bj)**9 +
                0346      &             2.738 _d 4*S(i,j,bj)**10 - 1.795 _d 4*S(i,j,bj)**11 -
                0347      &             9.486 _d 3*S(i,j,bj)**12)
                0348      &             /(2.*PI*rSphere*rSphere*12.0))
d8206d87ee Patr*0349            ENDIF
                0350           ENDIF
                0351 #endif
dc08631bb4 Jean*0352           EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)
                0353      &                     - Run(i,j,bi,bj)*scale_runoff
6206cdb986 Jean*0354           EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)*rhoConstFresh
d8206d87ee Patr*0355          ENDDO
                0356         ENDDO
                0357        ENDDO
                0358       ENDDO
                0359 
6637358eea Jean*0360       _EXCH_XY_RS(Qnet , myThid )
                0361       _EXCH_XY_RS(EmPmR , myThid )
8831cd24b3 Jean*0362 
d8206d87ee Patr*0363 C      CALL PLOT_FIELD_XYRS( Qnet, 'Qnet' , 1, myThid )
                0364 C      CALL PLOT_FIELD_XYRS( EmPmR, 'EmPmR' , 1, myThid )
                0365 
                0366 #endif /* ALLOW_EBM */
                0367 
6206cdb986 Jean*0368       RETURN
d8206d87ee Patr*0369       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!