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

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

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


Revision 1.2 - (hide annotations) (download)
Fri Dec 15 14:36:05 2006 UTC (17 years, 4 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58u_post, checkpoint58w_post, checkpoint58x_post, checkpoint58t_post, checkpoint58y_post, checkpoint58v_post
Changes since 1.1: +3 -21 lines
continue clean up: remove a few unused variable ("constants")

1 mlosch 1.2 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_budget_ocean.F,v 1.1 2006/12/14 08:36:20 mlosch Exp $
2     C $Name: $
3 mlosch 1.1
4     #include "SEAICE_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE SEAICE_BUDGET_OCEAN(
8     I UG,
9     U TSURF,
10     O netHeatFlux, SWHeatFlux,
11     I bi, bj )
12     C /================================================================\
13     C | SUBROUTINE seaice_budget_ocean |
14     C | o Calculate surface heat fluxes over open ocean |
15     C | see Hibler, MWR, 108, 1943-1973, 1980 |
16     C | If SEAICE_EXTERNAL_FLUXES is defined this routine simply |
17     C | simply copies the global fields to the seaice-local fields. |
18     C |================================================================|
19     C \================================================================/
20     IMPLICIT NONE
21    
22     C === Global variables ===
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "FFIELDS.h"
26     #include "SEAICE_PARAMS.h"
27     #include "SEAICE_FFIELDS.h"
28     #ifdef SEAICE_VARIABLE_FREEZING_POINT
29     #include "DYNVARS.h"
30     #endif /* SEAICE_VARIABLE_FREEZING_POINT */
31    
32     C === Routine arguments ===
33     C INPUT:
34     C UG :: thermal wind of atmosphere
35     C TSURF :: surface temperature of ocean in Kelvin
36     C bi,bj :: loop indices
37     C OUTPUT:
38     C netHeatFlux :: net surface heat flux over open water or under ice
39     C SWHeatFlux :: short wave heat flux over open water or under ice
40     _RL UG (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
41     _RL TSURF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
42     _RL netHeatFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43     _RL SWHeatFlux (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
44     INTEGER bi, bj
45     CEndOfInterface
46    
47     C === Local variables ===
48     C i,j - Loop counters
49     INTEGER i, j
50     #ifndef SEAICE_EXTERNAL_FLUXES
51     INTEGER ITER
52 mlosch 1.2 _RL QS1, TB, D1, D1W, D3, TMELT
53 mlosch 1.1 C effective conductivity of combined ice and snow
54     _RL effConduct
55     C specific humidity at ice surface
56     _RL qhIce
57     C powers of temperature
58     _RL t1, t2, t3, t4
59    
60     C local copies of global variables
61     _RL tsurfLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62     _RL atempLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63     _RL lwdownLoc (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64     _RL ALB (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65     C coefficients of Hibler (1980), appendix B
66     _RL A1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67     _RL A2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL A3 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69     C auxiliary variable
70     _RL B (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71    
72     C NOW DEFINE ASSORTED CONSTANTS
73     C SATURATION VAPOR PRESSURE CONSTANT
74     QS1=0.622 _d +00/1013.0 _d +00
75     C FREEZING TEMPERATURE OF SEAWATER
76     TB=271.2 _d +00
77     C SENSIBLE HEAT CONSTANT
78     D1=SEAICE_sensHeat
79     C WATER LATENT HEAT CONSTANT
80     D1W=SEAICE_latentWater
81     C STEFAN BOLTZMAN CONSTANT TIMES 0.97 EMISSIVITY
82     D3=SEAICE_emissivity
83     C MELTING TEMPERATURE OF ICE
84     TMELT=273.16 _d +00
85    
86     DO J=1,sNy
87     DO I=1,sNx
88     netHeatFlux(I,J) = 0. _d 0
89     SWHeatFlux (I,J) = 0. _d 0
90     C
91     tsurfLoc (I,J) = MIN(273.16 _d 0+MAX_TICE,TSURF(I,J,bi,bj))
92     C Is this necessary?
93     atempLoc (I,J) = MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))
94     lwdownLoc(I,J) = MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))
95     ENDDO
96     ENDDO
97     #endif /* SEAICE_EXTERNAL_FLUXES */
98    
99     C NOW DETERMINE OPEN WATER HEAT BUD. ASSUMING TSURF=WATER TEMP.
100     C WATER ALBEDO IS ASSUMED TO BE THE CONSTANT SEAICE_waterAlbedo
101     DO J=1,sNy
102     DO I=1,sNx
103     #ifdef SEAICE_EXTERNAL_FLUXES
104     netHeatFlux(I,J) = Qnet(I,J,bi,bj)
105     SWHeatFlux (I,J) = Qsw(I,J,bi,bj)
106     #else /* SEAICE_EXTERNAL_FLUXES undefined */
107     ALB(I,J)=SEAICE_waterAlbedo
108     A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
109     & +lwdownLoc(I,J)*0.97 _d 0
110     & +D1*UG(I,J)*atempLoc(I,J)+D1W*UG(I,J)*AQH(I,J,bi,bj)
111     B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00
112     & *(tsurfLoc(I,J)-TMELT)
113     & /(tsurfLoc(I,J)-TMELT+237.3 _d +00))
114     A2(I,J)=-D1*UG(I,J)*tsurfLoc(I,J)-D1W*UG(I,J)*B(I,J)
115     & -D3*(tsurfLoc(I,J)**4)
116     netHeatFlux(I,J)=-A1(I,J)-A2(I,J)
117     SWHeatFlux (I,J)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
118     #endif /* SEAICE_EXTERNAL_FLUXES */
119     ENDDO
120     ENDDO
121    
122     RETURN
123     END

  ViewVC Help
Powered by ViewVC 1.1.22