/[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.9 - (hide annotations) (download)
Fri Jul 31 03:09:05 2009 UTC (14 years, 9 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62a, checkpoint61v, checkpoint61w, checkpoint61u, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.8: +1 -35 lines
removing climatological forcing option and comments from pkg/seaice

1 dimitri 1.9 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_budget_ocean.F,v 1.8 2009/06/24 08:25:05 mlosch Exp $
2 mlosch 1.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 dimitri 1.7 I bi, bj, myTime, myIter, myThid )
12 mlosch 1.1 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     #ifdef SEAICE_VARIABLE_FREEZING_POINT
28 dimitri 1.5 # include "DYNVARS.h"
29     #endif
30     #ifdef ALLOW_EXF
31     # include "EXF_OPTIONS.h"
32     # include "EXF_FIELDS.h"
33     #endif
34 mlosch 1.1
35     C === Routine arguments ===
36     C INPUT:
37     C UG :: thermal wind of atmosphere
38     C TSURF :: surface temperature of ocean in Kelvin
39     C bi,bj :: loop indices
40 dimitri 1.7 C myTime :: Simulation time
41     C myIter :: Simulation timestep number
42 mlosch 1.3 C myThid :: Thread no. that called this routine.
43 mlosch 1.1 C OUTPUT:
44     C netHeatFlux :: net surface heat flux over open water or under ice
45     C SWHeatFlux :: short wave heat flux over open water or under ice
46 dimitri 1.6 _RL UG (1:sNx,1:sNy)
47 mlosch 1.1 _RL TSURF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
48 dimitri 1.6 _RL netHeatFlux(1:sNx,1:sNy)
49     _RL SWHeatFlux (1:sNx,1:sNy)
50 dimitri 1.7 _RL myTime
51     INTEGER bi, bj, myIter, myThid
52 mlosch 1.1 CEndOfInterface
53    
54     C === Local variables ===
55     C i,j - Loop counters
56     INTEGER i, j
57     #ifndef SEAICE_EXTERNAL_FLUXES
58     INTEGER ITER
59 mlosch 1.2 _RL QS1, TB, D1, D1W, D3, TMELT
60 mlosch 1.1 C effective conductivity of combined ice and snow
61     _RL effConduct
62     C specific humidity at ice surface
63     _RL qhIce
64     C powers of temperature
65     _RL t1, t2, t3, t4
66    
67     C local copies of global variables
68 dimitri 1.6 _RL tsurfLoc (1:sNx,1:sNy)
69     _RL atempLoc (1:sNx,1:sNy)
70     _RL lwdownLoc (1:sNx,1:sNy)
71     _RL ALB (1:sNx,1:sNy)
72 mlosch 1.1 C coefficients of Hibler (1980), appendix B
73 dimitri 1.6 _RL A1 (1:sNx,1:sNy)
74     _RL A2 (1:sNx,1:sNy)
75 mlosch 1.1 C auxiliary variable
76 dimitri 1.6 _RL B (1:sNx,1:sNy)
77 mlosch 1.1
78     C NOW DEFINE ASSORTED CONSTANTS
79     C SATURATION VAPOR PRESSURE CONSTANT
80     QS1=0.622 _d +00/1013.0 _d +00
81     C FREEZING TEMPERATURE OF SEAWATER
82     TB=271.2 _d +00
83     C SENSIBLE HEAT CONSTANT
84     D1=SEAICE_sensHeat
85     C WATER LATENT HEAT CONSTANT
86     D1W=SEAICE_latentWater
87     C STEFAN BOLTZMAN CONSTANT TIMES 0.97 EMISSIVITY
88     D3=SEAICE_emissivity
89     C MELTING TEMPERATURE OF ICE
90     TMELT=273.16 _d +00
91    
92     DO J=1,sNy
93     DO I=1,sNx
94     netHeatFlux(I,J) = 0. _d 0
95     SWHeatFlux (I,J) = 0. _d 0
96     C
97     tsurfLoc (I,J) = MIN(273.16 _d 0+MAX_TICE,TSURF(I,J,bi,bj))
98 dimitri 1.7 # ifdef ALLOW_ATM_TEMP
99 mlosch 1.1 C Is this necessary?
100     atempLoc (I,J) = MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))
101 dimitri 1.7 # endif
102     # ifdef ALLOW_DOWNWARD_RADIATION
103 mlosch 1.1 lwdownLoc(I,J) = MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))
104 dimitri 1.7 # endif
105 mlosch 1.1 ENDDO
106     ENDDO
107     #endif /* SEAICE_EXTERNAL_FLUXES */
108    
109     C NOW DETERMINE OPEN WATER HEAT BUD. ASSUMING TSURF=WATER TEMP.
110     C WATER ALBEDO IS ASSUMED TO BE THE CONSTANT SEAICE_waterAlbedo
111     DO J=1,sNy
112     DO I=1,sNx
113     #ifdef SEAICE_EXTERNAL_FLUXES
114     netHeatFlux(I,J) = Qnet(I,J,bi,bj)
115     SWHeatFlux (I,J) = Qsw(I,J,bi,bj)
116     #else /* SEAICE_EXTERNAL_FLUXES undefined */
117     ALB(I,J)=SEAICE_waterAlbedo
118 dimitri 1.7 # ifdef ALLOW_DOWNWARD_RADIATION
119 mlosch 1.1 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
120     & +lwdownLoc(I,J)*0.97 _d 0
121     & +D1*UG(I,J)*atempLoc(I,J)+D1W*UG(I,J)*AQH(I,J,bi,bj)
122     B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00
123     & *(tsurfLoc(I,J)-TMELT)
124     & /(tsurfLoc(I,J)-TMELT+237.3 _d +00))
125     A2(I,J)=-D1*UG(I,J)*tsurfLoc(I,J)-D1W*UG(I,J)*B(I,J)
126     & -D3*(tsurfLoc(I,J)**4)
127     netHeatFlux(I,J)=-A1(I,J)-A2(I,J)
128     SWHeatFlux (I,J)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
129 dimitri 1.7 # endif /* ALLOW_DOWNWARD_RADIATION */
130 mlosch 1.1 #endif /* SEAICE_EXTERNAL_FLUXES */
131     ENDDO
132     ENDDO
133    
134     RETURN
135     END

  ViewVC Help
Powered by ViewVC 1.1.22