/[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.5 - (hide annotations) (download)
Wed Dec 5 07:28:29 2007 UTC (16 years, 6 months ago) by dimitri
Branch: MAIN
Changes since 1.4: +7 -4 lines
o pkg/seaice: removed SEAICE_FFIELDS.h and seaice_get_forcing.F
  seaice forcing fields can now be read only through pkg/exf

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

  ViewVC Help
Powered by ViewVC 1.1.22