/[MITgcm]/MITgcm/pkg/thsice/thsice_get_bulkf.F
ViewVC logotype

Annotation of /MITgcm/pkg/thsice/thsice_get_bulkf.F

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

Revision 1.4 - (hide annotations) (download)
Thu May 25 17:36:44 2006 UTC (18 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint60, checkpoint61, checkpoint62, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58m_post
Changes since 1.3: +10 -2 lines 
add new Bulk-Formulae from Large and Yeager, 2004, NCAR/TN-460+STR
1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_get_bulkf.F,v 1.3 2006/01/22 15:58:59 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "THSICE_OPTIONS.h"
5 jmc 1.3 #ifdef ALLOW_BULK_FORCE
6     #include "BULK_FORCE_OPTIONS.h"
7     #endif
8 jmc 1.1
9 jmc 1.2 CBOP
10     C !ROUTINE: THSICE_GET_BULKF
11     C !INTERFACE:
12 jmc 1.1 SUBROUTINE THSICE_GET_BULKF(
13 jmc 1.3 I iceornot, Tsf,
14 jmc 1.2 O flxExceptSw, df0dT, evap, dEvdT,
15 jmc 1.1 I i,j,bi,bj,myThid )
16 jmc 1.2 C !DESCRIPTION: \bv
17 jmc 1.1 C *==========================================================*
18 jmc 1.3 C | S/R THSICE_GET_BULKF
19 jmc 1.1 C *==========================================================*
20     C | Interface S/R : get Surface Fluxes from pkg BULK_FORCE
21     C *==========================================================*
22 jmc 1.2 C \ev
23    
24     C !USES:
25 jmc 1.1 IMPLICIT NONE
26    
27     C == Global data ==
28     #ifdef ALLOW_BULK_FORCE
29     #include "SIZE.h"
30     #include "EEPARAMS.h"
31 jmc 1.3 #include "BULKF_PARAMS.h"
32 jmc 1.1 #include "BULKF.h"
33     #endif
34    
35 jmc 1.2 C !INPUT/OUTPUT PARAMETERS:
36 jmc 1.1 C === Routine arguments ===
37     C iceornot :: 0=open water, 1=ice cover
38 jmc 1.2 C Tsf :: surface (ice or snow) temperature (oC)
39     C flxExceptSw :: net (downward) surface heat flux, except short-wave [W/m2]
40     C df0dT :: deriv of flx with respect to Tsf [W/m/K]
41     C evap :: surface evaporation (>0 if evaporate) [kg/m2/s]
42     C dEvdT :: deriv of evap. with respect to Tsf [kg/m2/s/K]
43 jmc 1.1 C i,j, bi,bj :: current grid point indices
44     C myThid :: Thread no. that called this routine.
45     INTEGER i,j, bi,bj
46     INTEGER myThid
47     INTEGER iceornot
48     _RL Tsf
49     _RL flxExceptSw
50     _RL df0dT
51     _RL evap
52 jmc 1.2 _RL dEvdT
53     CEOP
54 jmc 1.1
55     #ifdef ALLOW_THSICE
56     #ifdef ALLOW_BULK_FORCE
57    
58     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
59     C === Local variables ===
60    
61     _RL flwup ! upward LW at surface (W m-2)
62     _RL flwNet_dwn ! net (downward) LW at surface (W m-2)
63     _RL fsh ! surface downward sensible heat (W m-2)
64     _RL flh ! surface downward latent heat (W m-2)
65     _RL ust, vst, ssq
66 jmc 1.3 #ifdef ALLOW_FORMULA_AIM
67     _RL Tsurf(1), SHF(1), EVPloc(1), SLRU(1)
68     _RL dEvp(1), sFlx(0:2)
69     #endif
70 jmc 1.1
71 jmc 1.3 #ifdef ALLOW_FORMULA_AIM
72     IF ( useFluxFormula_AIM ) THEN
73 jmc 1.1
74 jmc 1.3 Tsurf(1) = Tsf
75     CALL BULKF_FORMULA_AIM(
76     I Tsurf, flwdwn(i,j,bi,bj),
77     I ThAir(i,j,bi,bj), Tair(i,j,bi,bj),
78     I Qair(i,j,bi,bj), wspeed(i,j,bi,bj),
79     O SHF, EVPloc, SLRU,
80     O dEvp, sFlx,
81     I iceornot, myThid )
82    
83     flxExceptSw = sFlx(1)
84     df0dT = sFlx(2)
85     C- convert from [g/m2/s] to [kg/m2/s]
86     evap = EVPloc(1) * 1. _d -3
87     dEvdT = dEvp(1) * 1. _d -3
88    
89     ELSE
90     #else /* ALLOW_FORMULA_AIM */
91     IF ( .TRUE. ) THEN
92     #endif /* ALLOW_FORMULA_AIM */
93    
94     ust = 0.
95     vst = 0.
96     ssq = 0.
97    
98 jmc 1.4 IF ( blk_nIter.EQ.0 ) THEN
99     CALL BULKF_FORMULA_LANL(
100 jmc 1.2 I uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
101     I Tair(i,j,bi,bj), Qair(i,j,bi,bj), cloud(i,j,bi,bj), Tsf,
102     O flwup, flh, fsh, df0dT, ust, vst, evap, ssq, dEvdT,
103 jmc 1.3 I iceornot, myThid )
104 jmc 1.4 ELSE
105     CALL BULKF_FORMULA_LAY(
106     I uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
107     I Tair(i,j,bi,bj), Qair(i,j,bi,bj), Tsf,
108     O flwup, flh, fsh, df0dT, ust, vst, evap, ssq, dEvdT,
109     I iceornot, i,j,bi,bj,myThid )
110     ENDIF
111 jmc 1.3
112     flwNet_dwn = flwdwn(i,j,bi,bj) - flwup
113     flxExceptSw = flwNet_dwn + fsh + flh
114 jmc 1.1
115 jmc 1.3 ENDIF
116 jmc 1.1
117     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
118    
119     #endif /* ALLOW_BULK_FORCE */
120     #endif /* ALLOW_THSICE */
121    
122     RETURN
123     END
  ViewVC Help
Powered by ViewVC 1.1.22