/[MITgcm]/MITgcm/pkg/seaice/seaice_budget_ocean.F
ViewVC logotype

Diff of /MITgcm/pkg/seaice/seaice_budget_ocean.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.6 by dimitri, Wed Dec 5 15:37:12 2007 UTC revision 1.7 by dimitri, Thu Jun 4 17:27:17 2009 UTC
# Line 8  CStartOfInterface Line 8  CStartOfInterface
8       I     UG,       I     UG,
9       U     TSURF,       U     TSURF,
10       O     netHeatFlux, SWHeatFlux,       O     netHeatFlux, SWHeatFlux,
11       I     bi, bj, myThid )       I     bi, bj, myTime, myIter, myThid )
12  C     /================================================================\  C     /================================================================\
13  C     | SUBROUTINE seaice_budget_ocean                                 |  C     | SUBROUTINE seaice_budget_ocean                                 |
14  C     | o Calculate surface heat fluxes over open ocean                |  C     | o Calculate surface heat fluxes over open ocean                |
# Line 31  C     === Global variables === Line 31  C     === Global variables ===
31  # include "EXF_OPTIONS.h"  # include "EXF_OPTIONS.h"
32  # include "EXF_FIELDS.h"  # include "EXF_FIELDS.h"
33  #endif  #endif
34    #ifdef SEAICE_CLIM_AIR
35          COMMON/SEAICE_DYNVARS_1/AREA
36          _RL AREA       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
37    #endif
38    
39  C     === Routine arguments ===  C     === Routine arguments ===
40  C     INPUT:  C     INPUT:
41  C     UG      :: thermal wind of atmosphere  C     UG      :: thermal wind of atmosphere
42  C     TSURF   :: surface temperature of ocean in Kelvin  C     TSURF   :: surface temperature of ocean in Kelvin
43  C     bi,bj   :: loop indices  C     bi,bj   :: loop indices
44    C     myTime  :: Simulation time
45    C     myIter  :: Simulation timestep number
46  C     myThid  :: Thread no. that called this routine.  C     myThid  :: Thread no. that called this routine.
47  C     OUTPUT:  C     OUTPUT:
48  C     netHeatFlux :: net surface heat flux over open water or under ice  C     netHeatFlux :: net surface heat flux over open water or under ice
# Line 45  C     SWHeatFlux  :: short wave heat flu Line 51  C     SWHeatFlux  :: short wave heat flu
51        _RL TSURF      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL TSURF      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
52        _RL netHeatFlux(1:sNx,1:sNy)        _RL netHeatFlux(1:sNx,1:sNy)
53        _RL SWHeatFlux (1:sNx,1:sNy)        _RL SWHeatFlux (1:sNx,1:sNy)
54        INTEGER bi, bj, myThid        _RL myTime
55          INTEGER bi, bj, myIter, myThid
56  CEndOfInterface  CEndOfInterface
57    
58  C     === Local variables ===  C     === Local variables ===
# Line 72  C     coefficients of Hibler (1980), app Line 79  C     coefficients of Hibler (1980), app
79  C     auxiliary variable  C     auxiliary variable
80        _RL B          (1:sNx,1:sNy)        _RL B          (1:sNx,1:sNy)
81    
82    #ifdef SEAICE_CLIM_AIR
83          _RL aqhLoc     (1:sNx,1:sNy)
84          _RL fac
85          logical first, changed
86          integer count0, count1
87    
88    C--   Compute indices and weights for seasonal interpolation
89          call cal_GetMonthsRec(
90         O     fac, first, changed,
91         O     count0, count1,
92         I     mytime, myiter, mythid
93         &     )
94    #endif /* SEAICE_CLIM_AIR */
95    
96  C NOW DEFINE ASSORTED CONSTANTS  C NOW DEFINE ASSORTED CONSTANTS
97  C SATURATION VAPOR PRESSURE CONSTANT  C SATURATION VAPOR PRESSURE CONSTANT
98        QS1=0.622 _d +00/1013.0 _d +00        QS1=0.622 _d +00/1013.0 _d +00
# Line 92  C MELTING TEMPERATURE OF ICE Line 113  C MELTING TEMPERATURE OF ICE
113          SWHeatFlux (I,J) = 0. _d 0          SWHeatFlux (I,J) = 0. _d 0
114  C      C    
115          tsurfLoc (I,J) = MIN(273.16 _d 0+MAX_TICE,TSURF(I,J,bi,bj))          tsurfLoc (I,J) = MIN(273.16 _d 0+MAX_TICE,TSURF(I,J,bi,bj))
116    # ifdef ALLOW_ATM_TEMP
117  C     Is this necessary?  C     Is this necessary?
 #ifdef ALLOW_ATM_TEMP  
118          atempLoc (I,J) = MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))          atempLoc (I,J) = MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))
119  #else /* ALLOW_ATM_TEMP */  # endif
120          STOP 'ABNORMAL END: S/R SEAICE_BUDGET_OCE: ATM_TEMP undef'  #ifdef SEAICE_CLIM_AIR
121  #endif /* ALLOW_ATM_TEMP */          atempLoc (I,J) = AREA(I,J,1,bi,bj) *
122  #ifdef ALLOW_DOWNWARD_RADIATION       &       ( fac * SEAICE_clim_atemp(count0) + (1-fac) *
123         &       SEAICE_clim_atemp(count1) ) +
124         &       (1-AREA(I,J,1,bi,bj)) * atempLoc(I,J)
125            aqhLoc (I,J)   = AREA(I,J,1,bi,bj) *
126         &       ( fac * SEAICE_clim_aqh(count0) + (1-fac) *
127         &       SEAICE_clim_aqh(count1) ) +
128         &       (1-AREA(I,J,1,bi,bj)) * aqh(I,J,bi,bj)
129    #endif /* SEAICE_CLIM_AIR */
130    # ifdef ALLOW_DOWNWARD_RADIATION
131          lwdownLoc(I,J) = MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))          lwdownLoc(I,J) = MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))
132  #else  # endif
         STOP  
      & 'ABNORMAL END: S/R SEAICE_BUDGET_OCE: DOWNWARD_RADIATION undef'  
 #endif  
133         ENDDO         ENDDO
134        ENDDO        ENDDO
135  #endif /* SEAICE_EXTERNAL_FLUXES */  #endif /* SEAICE_EXTERNAL_FLUXES */
# Line 117  C WATER ALBEDO IS ASSUMED TO BE THE CONS Line 143  C WATER ALBEDO IS ASSUMED TO BE THE CONS
143          SWHeatFlux (I,J) =  Qsw(I,J,bi,bj)          SWHeatFlux (I,J) =  Qsw(I,J,bi,bj)
144  #else /* SEAICE_EXTERNAL_FLUXES undefined */  #else /* SEAICE_EXTERNAL_FLUXES undefined */
145          ALB(I,J)=SEAICE_waterAlbedo                                          ALB(I,J)=SEAICE_waterAlbedo                                
146  #if defined(ALLOW_DOWNWARD_RADIATION) && defined(ALLOW_ATM_TEMP)  # ifdef ALLOW_DOWNWARD_RADIATION
147    # ifdef SEAICE_CLIM_AIR
148            A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
149         &       +lwdownLoc(I,J)*0.97 _d 0
150         &       +D1*UG(I,J)*atempLoc(I,J)+D1W*UG(I,J)*aqhLoc (I,J)
151    #else
152          A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)          A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
153       &       +lwdownLoc(I,J)*0.97 _d 0       &       +lwdownLoc(I,J)*0.97 _d 0
154       &       +D1*UG(I,J)*atempLoc(I,J)+D1W*UG(I,J)*AQH(I,J,bi,bj)       &       +D1*UG(I,J)*atempLoc(I,J)+D1W*UG(I,J)*AQH(I,J,bi,bj)
155    #endif /* SEAICE_CLIM_AIR */
156          B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00          B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00
157       &       *(tsurfLoc(I,J)-TMELT)       &       *(tsurfLoc(I,J)-TMELT)
158       &       /(tsurfLoc(I,J)-TMELT+237.3 _d +00))       &       /(tsurfLoc(I,J)-TMELT+237.3 _d +00))
# Line 128  C WATER ALBEDO IS ASSUMED TO BE THE CONS Line 160  C WATER ALBEDO IS ASSUMED TO BE THE CONS
160       &       -D3*(tsurfLoc(I,J)**4)       &       -D3*(tsurfLoc(I,J)**4)
161          netHeatFlux(I,J)=-A1(I,J)-A2(I,J)              netHeatFlux(I,J)=-A1(I,J)-A2(I,J)    
162          SWHeatFlux (I,J)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)          SWHeatFlux (I,J)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
163  #else  # endif /* ALLOW_DOWNWARD_RADIATION */
         STOP  
      & 'ABNORMAL END: S/R SEAICE_BUDGET_OCE: DOWNWARD_RADIATION undef'  
 #endif  
164  #endif /* SEAICE_EXTERNAL_FLUXES */  #endif /* SEAICE_EXTERNAL_FLUXES */
165         ENDDO         ENDDO
166        ENDDO        ENDDO
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22