Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "BULK_FORCE_OPTIONS.h"
7753507405 Curt*0002 
dd80d278b6 Jean*0003 CBOP
                0004 C     !ROUTINE: BULKF_FORCING
                0005 C     !INTERFACE:
679d149d01 Jean*0006       SUBROUTINE BULKF_FORCING(
dd80d278b6 Jean*0007      I                          myTime, myIter, myThid )
7753507405 Curt*0008 
dd80d278b6 Jean*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE BULKF_FORCING
                0012 C     *==========================================================*
                0013 C     \ev
7753507405 Curt*0014 
dd80d278b6 Jean*0015 C     o Get the surface fluxes used to force ocean model
                0016 C       Output:
                0017 C       ------
                0018 C       ustress, vstress :: wind stress
                0019 C       qnet             :: net heat flux
                0020 C       empmr            :: freshwater flux
                0021 C       ---------
                0022 C
                0023 C       Input:
                0024 C       ------
                0025 C       uwind, vwind  :: mean wind speed (m/s)     at height hu (m)
                0026 C       Tair  :: mean air temperature (K)  at height ht (m)
                0027 C       Qair  :: mean air humidity (kg/kg) at height hq (m)
                0028 C       theta(k=1) :: sea surface temperature (K)
                0029 C       rain   :: precipitation
                0030 C       runoff :: river(ice) runoff
                0031 C
                0032 C     ==================================================================
                0033 C     SUBROUTINE bulkf_forcing
                0034 C     ==================================================================
7753507405 Curt*0035 
dd80d278b6 Jean*0036 C     !USES:
                0037       IMPLICIT NONE
                0038 C     == global variables ==
7753507405 Curt*0039 #include "EEPARAMS.h"
                0040 #include "SIZE.h"
                0041 #include "PARAMS.h"
                0042 #include "DYNVARS.h"
                0043 #include "GRID.h"
                0044 #include "FFIELDS.h"
6a1d3c464b Jean*0045 #include "BULKF_PARAMS.h"
7753507405 Curt*0046 #include "BULKF.h"
f4245d1665 Curt*0047 #include "BULKF_INT.h"
dd80d278b6 Jean*0048 #include "BULKF_TAVE.h"
7753507405 Curt*0049 
dd80d278b6 Jean*0050 C     !INPUT/OUTPUT PARAMETERS:
                0051 C     == routine arguments ==
6a1d3c464b Jean*0052       _RL     myTime
dd80d278b6 Jean*0053       INTEGER myIter
                0054       INTEGER myThid
                0055 CEOP
7753507405 Curt*0056 
6a1d3c464b Jean*0057 #ifdef ALLOW_BULK_FORCE
7753507405 Curt*0058 C     == Local variables ==
679d149d01 Jean*0059       INTEGER bi,bj
e5b783de15 Jean*0060       INTEGER i,j
                0061       INTEGER ks, iceornot
7753507405 Curt*0062 
679d149d01 Jean*0063       _RL     df0dT, hfl, evp, dEvdT
                0064 #ifdef ALLOW_FORMULA_AIM
                0065       _RL     SHF(1), EVPloc(1), SLRU(1)
                0066       _RL     dEvp(1), sFlx(0:2)
                0067 #endif
7753507405 Curt*0068 
e5b783de15 Jean*0069 C-    surface level index:
                0070       ks = 1
7753507405 Curt*0071 
e5b783de15 Jean*0072 C-    Compute surface fluxes over ice-free ocean only:
                0073       iceornot = 0
7753507405 Curt*0074 
6a1d3c464b Jean*0075       DO bj=myByLo(myThid),myByHi(myThid)
                0076        DO bi=myBxLo(myThid),myBxHi(myThid)
e5b783de15 Jean*0077 
70964a532e Jean*0078          DO j = 1-OLy,sNy+OLy
                0079           DO i = 1-OLx,sNx+OLx
e5b783de15 Jean*0080            IF ( maskC(i,j,ks,bi,bj).NE.0. _d 0 ) THEN
f4245d1665 Curt*0081 
679d149d01 Jean*0082 #ifdef ALLOW_FORMULA_AIM
                0083              IF ( useFluxFormula_AIM ) THEN
                0084                CALL BULKF_FORMULA_AIM(
e5b783de15 Jean*0085      I            theta(i,j,ks,bi,bj), flwdwn(i,j,bi,bj),
679d149d01 Jean*0086      I            thAir(i,j,bi,bj), Tair(i,j,bi,bj),
                0087      I            Qair(i,j,bi,bj), wspeed(i,j,bi,bj),
                0088      O            SHF, EVPloc, SLRU,
                0089      O            dEvp, sFlx,
                0090      I            iceornot, myThid )
                0091 
                0092                   flwup(i,j,bi,bj)= ocean_emissivity*SLRU(1)
                0093 C-    reverse sign (AIM convention -> BULKF convention):
                0094                   fsh(i,j,bi,bj) = -SHF(1)
                0095                   flh(i,j,bi,bj) = -Lvap*EVPloc(1)
                0096 C-    Convert from g/m2/s to m/s
f664a6d8bb Jean*0097                   evap(i,j,bi,bj) = EVPloc(1) * 1. _d -3 / rhoFW
679d149d01 Jean*0098                   dEvdT = dEvp(1) * 1. _d -3
                0099                   df0dT = sFlx(2)
e5b783de15 Jean*0100 
                0101              ELSEIF ( blk_nIter.EQ.0 ) THEN
679d149d01 Jean*0102 #else  /* ALLOW_FORMULA_AIM */
e5b783de15 Jean*0103              IF ( blk_nIter.EQ.0 ) THEN
679d149d01 Jean*0104 #endif /* ALLOW_FORMULA_AIM */
548c63e38c Jean*0105                CALL BULKF_FORMULA_LANL(
e5b783de15 Jean*0106      I            uwind(i,j,bi,bj),vwind(i,j,bi,bj),wspeed(i,j,bi,bj),
                0107      I            Tair(i,j,bi,bj), Qair(i,j,bi,bj),
                0108      I            cloud(i,j,bi,bj),theta(i,j,ks,bi,bj),
679d149d01 Jean*0109      O            flwup(i,j,bi,bj), flh(i,j,bi,bj),
                0110      O            fsh(i,j,bi,bj), df0dT,
                0111      O            ustress(i,j,bi,bj), vstress(i,j,bi,bj),
                0112      O            evp, savssq(i,j,bi,bj), dEvdT,
                0113      I            iceornot, myThid )
f4245d1665 Curt*0114 C               Note that the LANL flux conventions are opposite
                0115 C               of what they are in the model.
                0116 
e5b783de15 Jean*0117 C-             Convert from kg/m2/s to m/s
                0118                evap(i,j,bi,bj) = evp/rhoFW
                0119 
                0120              ELSE
f664a6d8bb Jean*0121                CALL BULKF_FORMULA_LAY(
                0122      I            uwind(i,j,bi,bj), vwind(i,j,bi,bj),
                0123      I            wspeed(i,j,bi,bj), Tair(i,j,bi,bj),
e5b783de15 Jean*0124      I            Qair(i,j,bi,bj), theta(i,j,ks,bi,bj),
f664a6d8bb Jean*0125      O            flwup(i,j,bi,bj), flh(i,j,bi,bj),
                0126      O            fsh(i,j,bi,bj), df0dT,
                0127      O            ustress(i,j,bi,bj), vstress(i,j,bi,bj),
                0128      O            evp, savssq(i,j,bi,bj), dEvdT,
                0129      I            iceornot, i,j,bi,bj,myThid )
                0130 
548c63e38c Jean*0131 C-             Convert from kg/m2/s to m/s
f664a6d8bb Jean*0132                evap(i,j,bi,bj) = evp/rhoFW
548c63e38c Jean*0133 
679d149d01 Jean*0134              ENDIF
                0135 
e5b783de15 Jean*0136 C- use down long wave data
                0137              flwupnet(i,j,bi,bj)=flwup(i,j,bi,bj)-flwdwn(i,j,bi,bj)
                0138 C- using down solar, need to have water albedo -- .1
                0139              fswnet(i,j,bi,bj) = solar(i,j,bi,bj)
                0140      &                         *( 1. _d 0 - ocean_albedo )
679d149d01 Jean*0141            ElSE
                0142              ustress(i,j,bi,bj) = 0. _d 0
                0143              vstress(i,j,bi,bj) = 0. _d 0
                0144              fsh(i,j,bi,bj)     = 0. _d 0
                0145              flh(i,j,bi,bj)     = 0. _d 0
                0146              flwup(i,j,bi,bj)   = 0. _d 0
                0147              evap(i,j,bi,bj)    = 0. _d 0
                0148              fswnet(i,j,bi,bj)  = 0. _d 0
                0149              savssq(i,j,bi,bj)  = 0. _d 0
                0150            ENDIF
                0151           ENDDO
                0152          ENDDO
                0153 
                0154          IF ( calcWindStress ) THEN
e5b783de15 Jean*0155 C-  move wind stresses to u and v points
70964a532e Jean*0156            DO j = 1-OLy,sNy+OLy
                0157             DO i = 1-OLx+1,sNx+OLx
6a1d3c464b Jean*0158               fu(i,j,bi,bj) = maskW(i,j,1,bi,bj)
                0159      &          *(ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))*0.5 _d 0
                0160             ENDDO
                0161            ENDDO
70964a532e Jean*0162            DO j = 1-OLy+1,sNy+OLy
                0163             DO i = 1-OLx,sNx+OLx
6a1d3c464b Jean*0164               fv(i,j,bi,bj) = maskS(i,j,1,bi,bj)
                0165      &          *(vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))*0.5 _d 0
                0166             ENDDO
                0167            ENDDO
679d149d01 Jean*0168          ENDIF
6a1d3c464b Jean*0169 
e5b783de15 Jean*0170 C-    Add all contributions.
70964a532e Jean*0171          DO j = 1-OLy,sNy+OLy
                0172           DO i = 1-OLx,sNx+OLx
e5b783de15 Jean*0173             IF ( maskC(i,j,ks,bi,bj).NE.0. _d 0 ) THEN
                0174 C-       Net downward surface heat flux :
7753507405 Curt*0175               hfl = 0. _d 0
f4245d1665 Curt*0176               hfl = hfl + fsh(i,j,bi,bj)
                0177               hfl = hfl + flh(i,j,bi,bj)
6a1d3c464b Jean*0178               hfl = hfl - flwupnet(i,j,bi,bj)
                0179               hfl = hfl + fswnet(i,j,bi,bj)
e5b783de15 Jean*0180 C- Heat flux:
6a1d3c464b Jean*0181               Qnet(i,j,bi,bj) = -hfl
e96c64fcd5 Jean*0182               Qsw (i,j,bi,bj) = -fswnet(i,j,bi,bj)
7753507405 Curt*0183 #ifdef COUPLE_MODEL
                0184               dFdT(i,j,bi,bj) = df0dT
                0185 #endif
e5b783de15 Jean*0186 C- Fresh-water flux from Precipitation and Evaporation.
6a1d3c464b Jean*0187               EmPmR(i,j,bi,bj) = (evap(i,j,bi,bj)-rain(i,j,bi,bj)
a5003302cb Jean*0188      &                           - runoff(i,j,bi,bj))*rhoConstFresh
e5b783de15 Jean*0189 C---- cheating: now done in S/R BULKF_FLUX_ADJUST, over ice-free ocean only
7753507405 Curt*0190 c            Qnet(i,j,bi,bj) = Qnetch(i,j,bi,bj)
                0191 c            EmPmR(i,j,bi,bj) = EmPch(i,j,bi,bj)
e5b783de15 Jean*0192 C----
679d149d01 Jean*0193             ELSE
6a1d3c464b Jean*0194               Qnet(i,j,bi,bj) = 0. _d 0
e96c64fcd5 Jean*0195               Qsw (i,j,bi,bj) = 0. _d 0
6a1d3c464b Jean*0196               EmPmR(i,j,bi,bj)= 0. _d 0
7753507405 Curt*0197 #ifdef COUPLE_MODEL
6a1d3c464b Jean*0198               dFdT(i,j,bi,bj) = 0. _d 0
7753507405 Curt*0199 #endif
679d149d01 Jean*0200             ENDIF
6a1d3c464b Jean*0201           ENDDO
                0202          ENDDO
7753507405 Curt*0203 
70964a532e Jean*0204          IF ( temp_EvPrRn .NE. UNSET_RL ) THEN
                0205 C--   Account for energy content of Precip + RunOff & Evap. Assumes:
                0206 C     1) Rain has same temp as Air
                0207 C     2) Snow has no heat capacity (consistent with seaice & thsice pkgs)
                0208 C     3) No distinction between sea-water Cp and fresh-water Cp
                0209 C     4) Run-Off comes at the temp of surface water (with same Cp)
                0210 C     5) Evap is released to the Atmos @ surf-temp (=SST); should be using
                0211 C        the water-vapor heat capacity here and consistently in Bulk-Formulae;
                0212 C        Could also be put directly into Latent Heat flux.
                0213 c         IF ( SnowFile .NE. ' ' ) THEN
                0214 C--   Melt snow (if provided) into the ocean and account for rain-temp
                0215 c          DO j = 1-OLy,sNy+OLy
                0216 c           DO i = 1-OLx,sNx+OLx
                0217 c             Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0218 c    &              + Lfresh*snowPrecip(i,j,bi,bj)*rhoConstFresh
                0219 c    &              - HeatCapacity_Cp
                0220 c    &               *( Tair(i,j,bi,bj) - Tf0kel - temp_EvPrRn )
                0221 c    &               *( rain(i,j,bi,bj)- snowPrecip(i,j,bi,bj) )
                0222 c    &               *rhoConstFresh
                0223 c           ENDDO
                0224 c          ENDDO
                0225 c         ELSE
                0226 C--   Make snow (according to Air Temp) and melt it in the ocean
                0227 C     note: here we just use the same criteria as over seaice but would be
                0228 C           better to consider a higher altitude air temp, e.g., 850.mb
                0229            DO j = 1-OLy,sNy+OLy
                0230             DO i = 1-OLx,sNx+OLx
                0231              IF ( Tair(i,j,bi,bj).LE.Tf0kel ) THEN
                0232                Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0233      &              + Lfresh*rain(i,j,bi,bj)*rhoConstFresh
                0234               ELSE
                0235 C--   Account for rain-temp
                0236                Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0237      &              - HeatCapacity_Cp
                0238      &               *( Tair(i,j,bi,bj) - Tf0kel - temp_EvPrRn )
                0239      &               *rain(i,j,bi,bj)*rhoConstFresh
                0240               ENDIF
                0241             ENDDO
                0242            ENDDO
                0243 c         ENDIF
                0244 C--   Account for energy content of Evap and RunOff:
                0245           DO j = 1-OLy,sNy+OLy
                0246             DO i = 1-OLx,sNx+OLx
                0247 c             Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0248 c    &              + ( theta(i,j,ks,bi,bj) - temp_EvPrRn )
                0249 c    &               *( evap(i,j,bi,bj)*cpwv
                0250 c    &                - runoff(i,j,bi,bj)*HeatCapacity_Cp
                0251 c    &                )*rhoConstFresh
                0252               Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0253      &              + ( theta(i,j,ks,bi,bj) - temp_EvPrRn )
                0254      &               *( evap(i,j,bi,bj) - runoff(i,j,bi,bj) )
                0255      &               *HeatCapacity_Cp*rhoConstFresh
                0256               Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)*maskC(i,j,ks,bi,bj)
                0257             ENDDO
                0258           ENDDO
                0259          ENDIF
                0260 
679d149d01 Jean*0261          IF ( blk_taveFreq.GT.0. _d 0 )
70964a532e Jean*0262      &     CALL BULKF_AVE( bi, bj, myThid )
7753507405 Curt*0263 
6a1d3c464b Jean*0264 C--   end bi,bj loops
                0265        ENDDO
                0266       ENDDO
7753507405 Curt*0267 
6a1d3c464b Jean*0268 C--   Update the tile edges.
                0269 C jmc: Is it necessary ?
12ffad7671 Jean*0270 c     _EXCH_XY_RS(Qnet,   myThid)
                0271 c     _EXCH_XY_RS(EmPmR,   myThid)
6a1d3c464b Jean*0272 c     CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
7753507405 Curt*0273 
                0274 #endif  /*ALLOW_BULK_FORCE*/
                0275 
6a1d3c464b Jean*0276       RETURN
                0277       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!