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

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

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

Revision 1.5 - (hide annotations) (download)
Tue Feb 18 05:33:55 2003 UTC (21 years, 4 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint48f_post, checkpoint48g_post
Changes since 1.4: +13 -13 lines 
Merging from release1_p12:
o Modifications for using pkg/exf with pkg/seaice
  - improved description of the various forcing configurations
  - added basic radiation bulk formulae to pkg/exf
  - units/sign fix for evap computation in exf_getffields.F
  - updated verification/global_with_exf/results/output.txt
o Added pkg/sbo for computing IERS Special Bureau for the Oceans
  (SBO) core products, including oceanic mass, center-of-mass,
  angular, and bottom pressure (see pkg/sbo/README.sbo).
o Lower bound for viscosity/diffusivity in pkg/kpp/kpp_routines.F
  to avoid negative values in shallow regions.
  - updated verification/natl_box/results/output.txt
  - updated verification/lab_sea/results/output.txt
o MPI gather, scatter: eesupp/src/gather_2d.F and scatter_2d.F
o Added useSingleCpuIO option (see PARAMS.h).
o Updated useSingleCpuIO option in mdsio_writefield.F to
  work with multi-field files, e.g., for single-file pickup.
o pkg/seaice:
  - bug fix in growth.F: QNET for no shortwave case
  - added HeffFile for specifying initial sea-ice thickness
  - changed SEAICE_EXTERNAL_FLUXES wind stress implementation
o Added missing /* */ to CPP comments in pkg/seaice, pkg/exf,
  kpp_transport_t.F, forward_step.F, and the_main_loop.F
o pkg/seaice:
  - adjoint-friendly modifications
  - added a SEAICE_WRITE_PICKUP at end of the_model_main.F
1 heimbach 1.2 C $Header:
2    
3     #include "SEAICE_OPTIONS.h"
4 dimitri 1.5
5 heimbach 1.2 CStartOfInterface
6     SUBROUTINE BUDGET(UG, TICE, HICE1, FICE1, KOPEN, bi, bj)
7     C /==========================================================\
8     C | SUBROUTINE budget |
9     C | o Calculate ice growth rate |
10     C |==========================================================|
11     C \==========================================================/
12     IMPLICIT NONE
13 dimitri 1.5
14 heimbach 1.2 C === Global variables ===
15     #include "SIZE.h"
16     #include "EEPARAMS.h"
17 dimitri 1.4 #include "FFIELDS.h"
18 heimbach 1.2 #include "SEAICE_PARAMS.h"
19     #include "SEAICE_FFIELDS.h"
20    
21     C Subset of variables from SEAICE.h
22     _RL HEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
23     _RL HSNOW (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
24     _RL QNETO (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
25     _RL QNETI (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
26     _RL QSWO (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
27     _RL QSWI (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
28     COMMON/TRANS/HEFF,HSNOW
29     COMMON/QFLUX/QNETO,QNETI,QSWO,QSWI
30    
31     C === Routine arguments ===
32     _RL UG (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
33     _RL TICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx,nSy)
34     _RL HICE1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
35     _RL FICE1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx,nSy)
36     INTEGER KOPEN
37     INTEGER bi, bj
38     CEndOfInterface
39 dimitri 1.5
40 heimbach 1.2 #ifdef ALLOW_SEAICE
41    
42     C === Local variables ===
43     C i,j,k,bi,bj - Loop counters
44    
45     INTEGER i, j
46     INTEGER ITER
47     _RL QS1, C1, C2, C3, C4, C5, TB, D1, D1W, D1I, D3
48     _RL TMELT, TMELTP, XKI, XKS, HCUT, ASNOW, XIO
49    
50     _RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
51     _RL ALB (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
52     _RL A1 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
53     _RL A2 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
54     _RL A3 (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
55     _RL B (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
56    
57 dimitri 1.4 C IF KOPEN LT 0, THEN DO OPEN WATER BUDGET
58 heimbach 1.2 C NOW DEFINE ASSORTED CONSTANTS
59     C SATURATION VAPOR PRESSURE CONSTANT
60 dimitri 1.3 QS1=0.622 _d +00/1013.0 _d +00
61 heimbach 1.2 C MAYKUTS CONSTANTS FOR SAT. VAP. PRESSURE TEMP. POLYNOMIAL
62 dimitri 1.3 C1=2.7798202 _d -06
63     C2=-2.6913393 _d -03
64     C3=0.97920849 _d +00
65     C4=-158.63779 _d +00
66     C5=9653.1925 _d +00
67 heimbach 1.2 C FREEZING TEMPERATURE OF SEAWATER
68 dimitri 1.3 TB=271.2 _d +00
69 heimbach 1.2 C SENSIBLE HEAT CONSTANT
70     D1=SEAICE_sensHeat
71     C WATER LATENT HEAT CONSTANT
72     D1W=SEAICE_latentWater
73     C ICE LATENT HEAT CONSTANT
74     D1I=SEAICE_latentIce
75     C STEFAN BOLTZMAN CONSTANT TIMES 0.97 EMISSIVITY
76     D3=SEAICE_emissivity
77     C MELTING TEMPERATURE OF ICE
78 dimitri 1.3 TMELT=273.16 _d +00
79     TMELTP=273.159 _d +00
80 heimbach 1.2 C ICE CONDUCTIVITY
81     XKI=SEAICE_iceConduct
82     C SNOW CONDUCTIVITY
83     XKS=SEAICE_snowConduct
84     C CUTOFF SNOW THICKNESS
85     HCUT=SEAICE_snowThick
86     C PENETRATION SHORTWAVE RADIATION FACTOR
87     XIO=SEAICE_shortwave
88    
89     DO J=1,sNy
90     DO I=1,sNx
91 dimitri 1.3 TICE(I,J,bi,bj)=MIN(273.16 _d 0+MAX_TICE,TICE(I,J,bi,bj))
92 dimitri 1.4 ATEMP(I,J,bi,bj)=MAX(273.16 _d 0+MIN_ATEMP,ATEMP(I,J,bi,bj))
93 dimitri 1.5 LWDOWN(I,J,bi,bj)=MAX(MIN_LWDOWN,LWDOWN(I,J,bi,bj))
94 heimbach 1.2 ENDDO
95     ENDDO
96    
97     C NOW DECIDE IF OPEN WATER OR ICE
98     IF(KOPEN.LE.0) THEN
99    
100     C NOW DETERMINE OPEN WATER HEAT BUD. ASSUMING TICE=WATER TEMP.
101 dimitri 1.4 C WATER ALBEDO IS ASSUMED TO BE THE CONSTANT SEAICE_waterAlbedo
102 heimbach 1.2 DO J=1,sNy
103     DO I=1,sNx
104 dimitri 1.4 #ifdef SEAICE_EXTERNAL_FLUXES
105     FICE1(I,J,bi,bj)=QNET(I,J,bi,bj)+Qsw(I,J,bi,bj)
106     QSWO(I,J,bi,bj)=Qsw(I,J,bi,bj)
107 dimitri 1.5 #else /* SEAICE_EXTERNAL_FLUXES undefined */
108 heimbach 1.2 ALB(I,J)=SEAICE_waterAlbedo
109 dimitri 1.5 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)+LWDOWN(I,J,bi,bj)
110 dimitri 1.4 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1W*UG(I,J)*AQH(I,J,bi,bj)
111 dimitri 1.3 B(I,J)=QS1*6.11 _d +00*EXP(17.2694 _d +00
112     & *(TICE(I,J,bi,bj)-TMELT)
113     & /(TICE(I,J,bi,bj)-TMELT+237.3 _d +00))
114 heimbach 1.2 A2(I,J)=-D1*UG(I,J)*TICE(I,J,bi,bj)-D1W*UG(I,J)*B(I,J)
115 dimitri 1.3 & -D3*(TICE(I,J,bi,bj)**4)
116 heimbach 1.2 FICE1(I,J,bi,bj)=-A1(I,J)-A2(I,J)
117 dimitri 1.5 QSWO(I,J,bi,bj)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
118     #endif /* SEAICE_EXTERNAL_FLUXES */
119 heimbach 1.2 QNETO(I,J,bi,bj)=FICE1(I,J,bi,bj)-QSWO(I,J,bi,bj)
120     ENDDO
121     ENDDO
122    
123     ELSE
124    
125     C COME HERE IF ICE COVER
126     C FIRST PUT MINIMUM ON ICE THICKNESS
127     DO J=1,sNy
128     DO I=1,sNx
129 dimitri 1.3 HICE(I,J)=MAX(HICE1(I,J),0.05 _d +00)
130     HICE(I,J)=MIN(HICE(I,J),9.0 _d +00)
131 heimbach 1.2 ENDDO
132     ENDDO
133     C NOW DECIDE ON ALBEDO
134     DO J=1,sNy
135     DO I=1,sNx
136 dimitri 1.3 ALB(I,J)=0.75 _d +00
137 heimbach 1.2 IF(TICE(I,J,bi,bj).GT.TMELTP) ALB(I,J)=SEAICE_albedo
138     ASNOW=SEAICE_drySnowAlb
139     IF(TICE(I,J,bi,bj).GT.TMELTP) ASNOW=SEAICE_wetSnowAlb
140     IF(HSNOW(I,J,bi,bj).GT.HCUT) THEN
141     ALB(I,J)=ASNOW
142     ELSE
143     ALB(I,J)=ALB(I,J)+(HSNOW(I,J,bi,bj)/HCUT)*(ASNOW-ALB(I,J))
144     IF(ALB(I,J).GT.ASNOW) ALB(I,J)=ASNOW
145     END IF
146     ENDDO
147     ENDDO
148     C NOW DETERMINE FIXED FORCING TERM IN HEAT BUDGET
149     DO J=1,sNy
150     DO I=1,sNx
151     IF(HSNOW(I,J,bi,bj).GT.0.0) THEN
152     C NO SW PENETRATION WITH SNOW
153 dimitri 1.5 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)+LWDOWN(I,J,bi,bj)
154 dimitri 1.4 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1I*UG(I,J)*AQH(I,J,bi,bj)
155 heimbach 1.2 ELSE
156     C SW PENETRATION UNDER ICE
157 dimitri 1.5 A1(I,J)=(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
158     & *(ONE-XIO*EXP(-1.5 _d 0*HICE(I,J)))+LWDOWN(I,J,bi,bj)
159 dimitri 1.4 & +D1*UG(I,J)*ATEMP(I,J,bi,bj)+D1I*UG(I,J)*AQH(I,J,bi,bj)
160 heimbach 1.2 ENDIF
161     ENDDO
162     ENDDO
163     C NOW COMPUTE OTHER TERMS IN HEAT BUDGET
164 dimitri 1.3 C COME HERE AT START OF ITERATION
165    
166     crg check wether a2 is needed in the list of variables
167     c$taf loop = iteration TICE,A2
168 heimbach 1.2 DO ITER=1,IMAX_TICE
169    
170     DO J=1,sNy
171     DO I=1,sNx
172     B(I,J)=QS1*(C1*TICE(I,J,bi,bj)**4+C2*TICE(I,J,bi,bj)**3
173     ? +C3*TICE(I,J,bi,bj)**2+C4*TICE(I,J,bi,bj)+C5)
174     A2(I,J)=-D1*UG(I,J)*TICE(I,J,bi,bj)-D1I*UG(I,J)*B(I,J)
175     ? -D3*(TICE(I,J,bi,bj)**4)
176     B(I,J)=XKS/(HSNOW(I,J,bi,bj)/HICE(I,J)+XKS/XKI)/HICE(I,J)
177 dimitri 1.3 A3(I,J)=4.0 _d +00*D3*(TICE(I,J,bi,bj)**3)+B(I,J)+D1*UG(I,J)
178 heimbach 1.2 B(I,J)=B(I,J)*(TB-TICE(I,J,bi,bj))
179     cdm
180     cdm if(TICE(I,J,bi,bj).le.206.)
181     cdm & print '(A,3i4,f12.2)','### ITER,I,J,TICE',
182     cdm & ITER,I,J,TICE(I,J,bi,bj)
183     cdm
184     ENDDO
185     ENDDO
186     C NOW DECIDE IF IT IS TIME TO ESTIMATE GROWTH RATES
187     C NOW DETERMINE NEW ICE TEMPERATURE
188     DO J=1,sNy
189     DO I=1,sNx
190     TICE(I,J,bi,bj)=TICE(I,J,bi,bj)
191     & +(A1(I,J)+A2(I,J)+B(I,J))/A3(I,J)
192 dimitri 1.3 TICE(I,J,bi,bj)=MAX(273.16 _d 0+MIN_TICE,TICE(I,J,bi,bj))
193 heimbach 1.2 ENDDO
194     ENDDO
195     C NOW DECIDE IF ITERATIONS ARE COMPLETE
196     C NOW SET ICE TEMP TO MIN OF TMELT/ITERATION RESULT
197     c IF(ITER.EQ.IMAX_TICE) THEN
198     DO J=1,sNy
199     DO I=1,sNx
200     TICE(I,J,bi,bj)=MIN(TICE(I,J,bi,bj),TMELT)
201     ENDDO
202     ENDDO
203     c ENDIF
204    
205 dimitri 1.3 C END OF ITERATION
206 heimbach 1.2 ENDDO
207    
208     DO J=1,sNy
209     DO I=1,sNx
210     FICE1(I,J,bi,bj)=-A1(I,J)-A2(I,J)
211     IF(HSNOW(I,J,bi,bj).GT.0.0) THEN
212     C NO SW PENETRATION WITH SNOW
213 dimitri 1.3 QSWI(I,J,bi,bj)=ZERO
214 heimbach 1.2 ELSE
215     C SW PENETRATION UNDER ICE
216 dimitri 1.5 QSWI(I,J,bi,bj)=-(ONE-ALB(I,J))*SWDOWN(I,J,bi,bj)
217 dimitri 1.3 & *XIO*EXP(-1.5 _d 0*HICE(I,J))
218 heimbach 1.2 ENDIF
219     ENDDO
220     ENDDO
221    
222     END IF
223    
224 dimitri 1.5 #endif /* ALLOW_SEAICE */
225 heimbach 1.2
226     RETURN
227     END
  ViewVC Help
Powered by ViewVC 1.1.22