pkg/thsice/thsice_get_bulkf.F

C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_get_bulkf.F,v 1.6 2010/10/10 20:15:06 jmc Exp $
C $Name:  $

#include "THSICE_OPTIONS.h"
#ifdef ALLOW_BULK_FORCE
#include "BULK_FORCE_OPTIONS.h"
#endif

CBOP
C     !ROUTINE: THSICE_GET_BULKF
C     !INTERFACE:
      SUBROUTINE THSICE_GET_BULKF(
     I                  bi, bj,
     I                  iMin,iMax, jMin,jMax,
     I                  iceFlag, hSnow, Tsf,
     O                  flxExcSw, dFlxdT, evap, dEvdT,
     I                  myTime, myIter, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R  THSICE_GET_BULKF
C     *==========================================================*
C     | Interface S/R : get Surface Fluxes from pkg BULK_FORCE
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#ifdef ALLOW_BULK_FORCE
#include "EEPARAMS.h"
#include "BULKF_PARAMS.h"
#include "BULKF.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     bi,bj       :: tile indices
C     iMin,iMax   :: computation domain: 1rst index range
C     jMin,jMax   :: computation domain: 2nd  index range
C     iceFlag     :: sea-ice fractional mask [0-1]
C     iceFlag     :: True= get fluxes at this location ; False= do nothing
C     hSnow       :: snow height [m]
C     Tsf         :: surface (ice or snow) temperature (oC)
C     flxExcSw    :: net (downward) surface heat flux, except short-wave [W/m2]
C     dFlxdT      :: deriv of flx with respect to Tsf    [W/m/K]
C     evap        :: surface evaporation (>0 if evaporate) [kg/m2/s]
C     dEvdT       :: deriv of evap. with respect to Tsf  [kg/m2/s/K]
C     myThid      :: Thread no. that called this routine.
      INTEGER bi, bj
      INTEGER iMin, iMax
      INTEGER jMin, jMax
      LOGICAL iceFlag (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     hSnow   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     Tsf     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     flxExcSw(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     dFlxdT  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     evap    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     dEvdT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL     myTime
      INTEGER myIter
      INTEGER myThid
CEOP

#ifdef ALLOW_THSICE
#ifdef ALLOW_BULK_FORCE

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C     === Local variables ===
C     iceornot    :: 0=open water, 1=ice cover, 2=ice+snow
      INTEGER iceornot
      INTEGER i, j
      _RL  flwup         ! upward LW at surface (W m-2)
      _RL  flwNet_dwn    ! net (downward) LW at surface (W m-2)
      _RL  fsh           ! surface downward sensible heat (W m-2)
      _RL  flh           ! surface downward latent heat (W m-2)
      _RL  ust, vst, ssq
#ifdef ALLOW_FORMULA_AIM
      _RL     Tsurf(1), SHF(1), EVPloc(1), SLRU(1)
      _RL     dEvp(1), sFlx(0:2)
#endif

      DO j=jMin,jMax
       DO i=iMin,iMax
        IF ( iceFlag(i,j) ) THEN
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

         IF ( hSnow(i,j).GT.3. _d -1 ) THEN
          iceornot=2
         ELSE
          iceornot=1
         ENDIF

#ifdef ALLOW_FORMULA_AIM
         IF ( useFluxFormula_AIM ) THEN

          Tsurf(1) = Tsf(i,j)
          CALL BULKF_FORMULA_AIM(
     I               Tsurf, flwdwn(i,j,bi,bj),
     I               ThAir(i,j,bi,bj), Tair(i,j,bi,bj),
     I               Qair(i,j,bi,bj), wspeed(i,j,bi,bj),
     O               SHF, EVPloc, SLRU,
     O               dEvp, sFlx,
     I               iceornot, myThid )

          flxExcSw(i,j) = sFlx(1)
          dFlxdT(i,j)   = sFlx(2)
C-      convert from [g/m2/s] to [kg/m2/s]
          evap(i,j)  = EVPloc(1) * 1. _d -3
          dEvdT(i,j) = dEvp(1)   * 1. _d -3

         ELSE
#else  /* ALLOW_FORMULA_AIM */
         IF ( .TRUE. ) THEN
#endif /* ALLOW_FORMULA_AIM */

          ust = 0.
          vst = 0.
          ssq = 0.

          IF ( blk_nIter.EQ.0 ) THEN
           CALL BULKF_FORMULA_LANL(
     I          uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
     I          Tair(i,j,bi,bj), Qair(i,j,bi,bj),
     I          cloud(i,j,bi,bj), Tsf(i,j),
     O          flwup, flh, fsh, dFlxdT(i,j), ust, vst,
     O          evap(i,j), ssq, dEvdT(i,j),
     I          iceornot, myThid )
          ELSE
           CALL BULKF_FORMULA_LAY(
     I          uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
     I          Tair(i,j,bi,bj), Qair(i,j,bi,bj), Tsf(i,j),
     O          flwup, flh, fsh, dFlxdT(i,j), ust, vst,
     O          evap(i,j), ssq, dEvdT(i,j),
     I          iceornot, i,j,bi,bj,myThid )
          ENDIF

          flwNet_dwn = flwdwn(i,j,bi,bj) - flwup
          flxExcSw(i,j) = flwNet_dwn + fsh + flh

         ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
        ENDIF
       ENDDO
      ENDDO

#endif /* ALLOW_BULK_FORCE */
#endif /* ALLOW_THSICE */

      RETURN
      END
1	heimbach	1.7	C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_get_bulkf.F,v 1.6 2010/10/10 20:15:06 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	heimbach	1.7	I bi, bj,
14	jmc	1.6	I iMin,iMax, jMin,jMax,
15			I iceFlag, hSnow, Tsf,
16			O flxExcSw, dFlxdT, evap, dEvdT,
17			I myTime, myIter, myThid )
18	jmc	1.2	C !DESCRIPTION: \bv
19	jmc	1.1	C ==========================================================
20	jmc	1.3	C \| S/R THSICE_GET_BULKF
21	jmc	1.1	C ==========================================================
22			C \| Interface S/R : get Surface Fluxes from pkg BULK_FORCE
23			C ==========================================================
24	jmc	1.2	C \ev
25
26			C !USES:
27	jmc	1.1	IMPLICIT NONE
28
29			C == Global data ==
30	jmc	1.6	#include "SIZE.h"
31	jmc	1.1	#ifdef ALLOW_BULK_FORCE
32			#include "EEPARAMS.h"
33	jmc	1.3	#include "BULKF_PARAMS.h"
34	jmc	1.1	#include "BULKF.h"
35			#endif
36
37	jmc	1.2	C !INPUT/OUTPUT PARAMETERS:
38	jmc	1.1	C === Routine arguments ===
39	jmc	1.6	C bi,bj :: tile indices
40			C iMin,iMax :: computation domain: 1rst index range
41			C jMin,jMax :: computation domain: 2nd index range
42			C iceFlag :: sea-ice fractional mask [0-1]
43			C iceFlag :: True= get fluxes at this location ; False= do nothing
44	jmc	1.5	C hSnow :: snow height [m]
45	jmc	1.2	C Tsf :: surface (ice or snow) temperature (oC)
46	jmc	1.6	C flxExcSw :: net (downward) surface heat flux, except short-wave [W/m2]
47			C dFlxdT :: deriv of flx with respect to Tsf [W/m/K]
48	jmc	1.2	C evap :: surface evaporation (>0 if evaporate) [kg/m2/s]
49			C dEvdT :: deriv of evap. with respect to Tsf [kg/m2/s/K]
50	jmc	1.1	C myThid :: Thread no. that called this routine.
51	jmc	1.6	INTEGER bi, bj
52			INTEGER iMin, iMax
53			INTEGER jMin, jMax
54			LOGICAL iceFlag (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55	heimbach	1.7	_RL hSnow (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56	jmc	1.6	_RL Tsf (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57			_RL flxExcSw(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58			_RL dFlxdT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59			_RL evap (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60			_RL dEvdT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61			_RL myTime
62			INTEGER myIter
63	jmc	1.5	INTEGER myThid
64	jmc	1.2	CEOP
65	jmc	1.1
66			#ifdef ALLOW_THSICE
67			#ifdef ALLOW_BULK_FORCE
68
69			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
70			C === Local variables ===
71	jmc	1.5	C iceornot :: 0=open water, 1=ice cover, 2=ice+snow
72			INTEGER iceornot
73	jmc	1.6	INTEGER i, j
74	jmc	1.1	_RL flwup ! upward LW at surface (W m-2)
75			_RL flwNet_dwn ! net (downward) LW at surface (W m-2)
76			_RL fsh ! surface downward sensible heat (W m-2)
77			_RL flh ! surface downward latent heat (W m-2)
78			_RL ust, vst, ssq
79	jmc	1.3	#ifdef ALLOW_FORMULA_AIM
80			_RL Tsurf(1), SHF(1), EVPloc(1), SLRU(1)
81			_RL dEvp(1), sFlx(0:2)
82			#endif
83	jmc	1.1
84	jmc	1.6	DO j=jMin,jMax
85			DO i=iMin,iMax
86			IF ( iceFlag(i,j) ) THEN
87			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
88
89			IF ( hSnow(i,j).GT.3. _d -1 ) THEN
90	jmc	1.5	iceornot=2
91	jmc	1.6	ELSE
92	jmc	1.5	iceornot=1
93	jmc	1.6	ENDIF
94	jmc	1.5
95	jmc	1.3	#ifdef ALLOW_FORMULA_AIM
96	jmc	1.6	IF ( useFluxFormula_AIM ) THEN
97	jmc	1.1
98	jmc	1.6	Tsurf(1) = Tsf(i,j)
99			CALL BULKF_FORMULA_AIM(
100			I Tsurf, flwdwn(i,j,bi,bj),
101			I ThAir(i,j,bi,bj), Tair(i,j,bi,bj),
102			I Qair(i,j,bi,bj), wspeed(i,j,bi,bj),
103			O SHF, EVPloc, SLRU,
104			O dEvp, sFlx,
105			I iceornot, myThid )
106	jmc	1.3
107	jmc	1.6	flxExcSw(i,j) = sFlx(1)
108			dFlxdT(i,j) = sFlx(2)
109	jmc	1.3	C- convert from [g/m2/s] to [kg/m2/s]
110	jmc	1.6	evap(i,j) = EVPloc(1) * 1. _d -3
111			dEvdT(i,j) = dEvp(1) * 1. _d -3
112	jmc	1.3
113	jmc	1.6	ELSE
114	jmc	1.3	#else /* ALLOW_FORMULA_AIM */
115	jmc	1.6	IF ( .TRUE. ) THEN
116	jmc	1.3	#endif /* ALLOW_FORMULA_AIM */
117
118	jmc	1.6	ust = 0.
119			vst = 0.
120			ssq = 0.
121
122			IF ( blk_nIter.EQ.0 ) THEN
123			CALL BULKF_FORMULA_LANL(
124			I uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
125			I Tair(i,j,bi,bj), Qair(i,j,bi,bj),
126			I cloud(i,j,bi,bj), Tsf(i,j),
127			O flwup, flh, fsh, dFlxdT(i,j), ust, vst,
128			O evap(i,j), ssq, dEvdT(i,j),
129			I iceornot, myThid )
130			ELSE
131			CALL BULKF_FORMULA_LAY(
132			I uwind(i,j,bi,bj), vwind(i,j,bi,bj), wspeed(i,j,bi,bj),
133			I Tair(i,j,bi,bj), Qair(i,j,bi,bj), Tsf(i,j),
134			O flwup, flh, fsh, dFlxdT(i,j), ust, vst,
135			O evap(i,j), ssq, dEvdT(i,j),
136			I iceornot, i,j,bi,bj,myThid )
137			ENDIF
138	jmc	1.3
139	jmc	1.6	flwNet_dwn = flwdwn(i,j,bi,bj) - flwup
140			flxExcSw(i,j) = flwNet_dwn + fsh + flh
141	jmc	1.1
142	jmc	1.6	ENDIF
143	jmc	1.1
144			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
145	jmc	1.6	ENDIF
146			ENDDO
147			ENDDO
148	jmc	1.1
149			#endif /* ALLOW_BULK_FORCE */
150			#endif /* ALLOW_THSICE */
151
152			RETURN
153			END