model/src/external_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.37 2006/02/07 11:47:48 mlosch Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: EXTERNAL_FORCING_U
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_U
C     | o Contains problem specific forcing for zonal velocity.
C     *==========================================================*
C     | Adds terms to gU for forcing by external sources
C     | e.g. wind stress, bottom friction etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
c      DO j=1,sNy
C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
       DO j=0,sNy+1
        DO i=1,sNx+1
         gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceForcingU(i,j,bi,bj)
     &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#if (defined (ALLOW_TAU_EDDY))
       CALL TAUEDDY_EXTERNAL_FORCING_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_V
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_V
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds terms to gV for forcing by external sources
C     | e.g. wind stress, bottom friction etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy+1
c       DO i=1,sNx
C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
        DO i=0,sNx+1
         gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceForcingV(i,j,bi,bj)
     &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#if (defined (ALLOW_TAU_EDDY))
       CALL TAUEDDY_EXTERNAL_FORCING_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_T
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_T(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_T
C     | o Contains problem specific forcing for temperature.
C     *==========================================================*
C     | Adds terms to gT for forcing by external sources
C     | e.g. heat flux, climatalogical relaxation, etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP
#ifdef SHORTWAVE_HEATING
      integer two
      _RL minusone
      parameter (two=2,minusone=-1.)
      _RL swfracb(two)
      INTEGER kp1
#endif

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add heat in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy
        DO i=1,sNx
         gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
     &     +surfaceForcingT(i,j,bi,bj)
     &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_SHELFICE
      IF ( useShelfIce )
     &     CALL SHELFICE_FORCING_T(
     I     iMin,iMax, jMin,jMax, bi,bj, kLev,
     I     myTime, myThid )
#endif /* ALLOW_SHELFICE */

#ifdef SHORTWAVE_HEATING
C Penetrating SW radiation
c     IF ( usePenetratingSW ) THEN
       swfracb(1)=abs(rF(klev))
       swfracb(2)=abs(rF(klev+1))
       CALL SWFRAC(
     I     two,minusone,
     I     myTime,myThid,
     U     swfracb)
       kp1 = klev+1
       IF (klev.EQ.Nr) THEN
        kp1 = klev
        swfracb(2)=0. _d 0
       ENDIF
       DO j=1,sNy
        DO i=1,sNx
         gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
     &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
     &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
     &    *recip_Cp*recip_rhoConst
     &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
c     ENDIF
#endif

#ifdef ALLOW_RBCS
       if (useRBCS) then
          call RBCS_ADD_TENDENCY(bi,bj,klev, 1,
     &                            myTime, myThid )
       endif
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_T(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_S
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_S(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_S
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds terms to gS for forcing by external sources
C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add fresh-water in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy
        DO i=1,sNx
         gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
     &     +surfaceForcingS(i,j,bi,bj)
     &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_SHELFICE
      IF ( useShelfIce )
     &     CALL SHELFICE_FORCING_S(
     I     iMin,iMax, jMin,jMax, bi,bj, kLev,
     I     myTime, myThid )
#endif /* ALLOW_SHELFICE */

#ifdef ALLOW_RBCS
       if (useRBCS) then
          call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
     &                            myTime, myThid )
       endif
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_S(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

      RETURN
      END
1	heimbach	1.38	C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.37 2006/02/07 11:47:48 mlosch Exp $
2	adcroft	1.12	C $Name: $
3	cnh	1.1
4	edhill	1.20	#include "PACKAGES_CONFIG.h"
5	cnh	1.1	#include "CPP_OPTIONS.h"
6
7	cnh	1.13	CBOP
8			C !ROUTINE: EXTERNAL_FORCING_U
9			C !INTERFACE:
10	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_U(
11	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
12			I myTime, myThid )
13	cnh	1.13	C !DESCRIPTION: \bv
14			C ==========================================================
15	jmc	1.31	C \| S/R EXTERNAL_FORCING_U
16			C \| o Contains problem specific forcing for zonal velocity.
17	cnh	1.13	C ==========================================================
18	jmc	1.31	C \| Adds terms to gU for forcing by external sources
19			C \| e.g. wind stress, bottom friction etc ...
20	cnh	1.13	C ==========================================================
21			C \ev
22
23			C !USES:
24	cnh	1.2	IMPLICIT NONE
25	cnh	1.1	C == Global data ==
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "PARAMS.h"
29			#include "GRID.h"
30			#include "DYNVARS.h"
31	cnh	1.2	#include "FFIELDS.h"
32	cnh	1.13
33			C !INPUT/OUTPUT PARAMETERS:
34	cnh	1.1	C == Routine arguments ==
35	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
36			C jMin,jMax :: Working range of y-index for applying forcing.
37			C bi,bj :: Current tile indices
38			C kLev :: Current vertical level index
39			C myTime :: Current time in simulation
40			C myThid :: Thread Id number
41	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
42	jmc	1.31	_RL myTime
43	adcroft	1.4	INTEGER myThid
44	cnh	1.1
45	cnh	1.13	C !LOCAL VARIABLES:
46	cnh	1.2	C == Local variables ==
47	jmc	1.31	C i,j :: Loop counters
48			C kSurface :: index of surface layer
49			INTEGER i, j
50	mlosch	1.17	INTEGER kSurface
51	cnh	1.13	CEOP
52	cnh	1.2
53	jmc	1.28	IF ( fluidIsAir ) THEN
54	jmc	1.21	kSurface = 0
55	jmc	1.28	ELSEIF ( usingPCoords ) THEN
56	mlosch	1.17	kSurface = Nr
57	jmc	1.28	ELSE
58	mlosch	1.17	kSurface = 1
59	jmc	1.28	ENDIF
60	mlosch	1.17
61	cnh	1.2	C-- Forcing term
62	jmc	1.21	#ifdef ALLOW_AIM
63			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
64			& iMin,iMax, jMin,jMax, bi,bj, kLev,
65	jmc	1.31	& myTime, myThid )
66	jmc	1.21	#endif /* ALLOW_AIM */
67	jmc	1.31
68	molod	1.23	#ifdef ALLOW_FIZHI
69			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
70			& iMin,iMax, jMin,jMax, bi,bj, kLev,
71	jmc	1.31	& myTime, myThid )
72	molod	1.23	#endif /* ALLOW_FIZHI */
73	jmc	1.21
74	cnh	1.2	C Add windstress momentum impulse into the top-layer
75	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
76	jmc	1.32	c DO j=1,sNy
77			C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
78			DO j=0,sNy+1
79	jmc	1.31	DO i=1,sNx+1
80	cnh	1.2	gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81	jmc	1.26	& +foFacMom*surfaceForcingU(i,j,bi,bj)
82	heimbach	1.38	& recip_drF(kLev)_recip_hFacW(i,j,kLev,bi,bj)
83	cnh	1.2	ENDDO
84			ENDDO
85			ENDIF
86
87	heimbach	1.30	#if (defined (ALLOW_TAU_EDDY))
88	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_U(
89	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
90			I myTime, myThid )
91	heimbach	1.29	#endif
92
93	jmc	1.31	#ifdef ALLOW_OBCS
94	heimbach	1.16	IF (useOBCS) THEN
95			CALL OBCS_SPONGE_U(
96	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
97			I myTime, myThid )
98	heimbach	1.16	ENDIF
99	heimbach	1.14	#endif
100
101	cnh	1.1	RETURN
102			END
103	jmc	1.31
104			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
105	cnh	1.13	CBOP
106			C !ROUTINE: EXTERNAL_FORCING_V
107			C !INTERFACE:
108	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_V(
109	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
110			I myTime, myThid )
111	cnh	1.13	C !DESCRIPTION: \bv
112			C ==========================================================
113	jmc	1.31	C \| S/R EXTERNAL_FORCING_V
114			C \| o Contains problem specific forcing for merid velocity.
115	cnh	1.13	C ==========================================================
116	jmc	1.31	C \| Adds terms to gV for forcing by external sources
117			C \| e.g. wind stress, bottom friction etc ...
118	cnh	1.13	C ==========================================================
119			C \ev
120
121			C !USES:
122	cnh	1.2	IMPLICIT NONE
123	cnh	1.1	C == Global data ==
124			#include "SIZE.h"
125			#include "EEPARAMS.h"
126			#include "PARAMS.h"
127			#include "GRID.h"
128			#include "DYNVARS.h"
129	cnh	1.2	#include "FFIELDS.h"
130
131	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
132	cnh	1.1	C == Routine arguments ==
133	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
134			C jMin,jMax :: Working range of y-index for applying forcing.
135			C bi,bj :: Current tile indices
136			C kLev :: Current vertical level index
137			C myTime :: Current time in simulation
138			C myThid :: Thread Id number
139	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
140	jmc	1.31	_RL myTime
141	adcroft	1.4	INTEGER myThid
142	cnh	1.13
143			C !LOCAL VARIABLES:
144	cnh	1.2	C == Local variables ==
145	jmc	1.31	C i,j :: Loop counters
146			C kSurface :: index of surface layer
147			INTEGER i, j
148	mlosch	1.17	INTEGER kSurface
149	cnh	1.13	CEOP
150	cnh	1.2
151	jmc	1.28	IF ( fluidIsAir ) THEN
152	jmc	1.21	kSurface = 0
153	jmc	1.28	ELSEIF ( usingPCoords ) THEN
154	mlosch	1.17	kSurface = Nr
155	jmc	1.28	ELSE
156	mlosch	1.17	kSurface = 1
157	jmc	1.28	ENDIF
158	mlosch	1.17
159	cnh	1.2	C-- Forcing term
160	jmc	1.21	#ifdef ALLOW_AIM
161			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
162			& iMin,iMax, jMin,jMax, bi,bj, kLev,
163	jmc	1.31	& myTime, myThid )
164	jmc	1.21	#endif /* ALLOW_AIM */
165
166	molod	1.23	#ifdef ALLOW_FIZHI
167			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
168			& iMin,iMax, jMin,jMax, bi,bj, kLev,
169	jmc	1.31	& myTime, myThid )
170	molod	1.23	#endif /* ALLOW_FIZHI */
171	jmc	1.31
172	cnh	1.2	C Add windstress momentum impulse into the top-layer
173	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
174	jmc	1.31	DO j=1,sNy+1
175	jmc	1.32	c DO i=1,sNx
176			C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
177			DO i=0,sNx+1
178	cnh	1.2	gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
179	jmc	1.26	& +foFacMom*surfaceForcingV(i,j,bi,bj)
180	heimbach	1.38	& recip_drF(kLev)_recip_hFacS(i,j,kLev,bi,bj)
181	cnh	1.2	ENDDO
182			ENDDO
183			ENDIF
184	cnh	1.1
185	heimbach	1.30	#if (defined (ALLOW_TAU_EDDY))
186	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_V(
187	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
188			I myTime, myThid )
189	heimbach	1.29	#endif
190
191	jmc	1.31	#ifdef ALLOW_OBCS
192	heimbach	1.16	IF (useOBCS) THEN
193			CALL OBCS_SPONGE_V(
194	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
195			I myTime, myThid )
196	heimbach	1.16	ENDIF
197	heimbach	1.14	#endif
198
199	cnh	1.1	RETURN
200			END
201	jmc	1.31
202			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
203	cnh	1.13	CBOP
204			C !ROUTINE: EXTERNAL_FORCING_T
205			C !INTERFACE:
206	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_T(
207	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
208			I myTime, myThid )
209	cnh	1.13	C !DESCRIPTION: \bv
210			C ==========================================================
211	jmc	1.31	C \| S/R EXTERNAL_FORCING_T
212			C \| o Contains problem specific forcing for temperature.
213	cnh	1.13	C ==========================================================
214	jmc	1.31	C \| Adds terms to gT for forcing by external sources
215			C \| e.g. heat flux, climatalogical relaxation, etc ...
216	cnh	1.13	C ==========================================================
217			C \ev
218
219			C !USES:
220	cnh	1.2	IMPLICIT NONE
221	cnh	1.1	C == Global data ==
222			#include "SIZE.h"
223			#include "EEPARAMS.h"
224			#include "PARAMS.h"
225			#include "GRID.h"
226			#include "DYNVARS.h"
227			#include "FFIELDS.h"
228	heimbach	1.7
229	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
230	cnh	1.1	C == Routine arguments ==
231	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
232			C jMin,jMax :: Working range of y-index for applying forcing.
233			C bi,bj :: Current tile indices
234			C kLev :: Current vertical level index
235			C myTime :: Current time in simulation
236			C myThid :: Thread Id number
237	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
238	jmc	1.31	_RL myTime
239	adcroft	1.4	INTEGER myThid
240	cnh	1.1
241	cnh	1.13	C !LOCAL VARIABLES:
242	cnh	1.2	C == Local variables ==
243	jmc	1.31	C i,j :: Loop counters
244			C kSurface :: index of surface layer
245			INTEGER i, j
246	mlosch	1.17	INTEGER kSurface
247	jmc	1.31	CEOP
248	jmc	1.24	#ifdef SHORTWAVE_HEATING
249			integer two
250			_RL minusone
251			parameter (two=2,minusone=-1.)
252			_RL swfracb(two)
253			INTEGER kp1
254			#endif
255	cnh	1.2
256	jmc	1.28	IF ( fluidIsAir ) THEN
257	jmc	1.21	kSurface = 0
258	jmc	1.28	ELSEIF ( usingPCoords ) THEN
259	mlosch	1.17	kSurface = Nr
260	jmc	1.28	ELSE
261	mlosch	1.17	kSurface = 1
262	jmc	1.28	ENDIF
263	mlosch	1.17
264	cnh	1.2	C-- Forcing term
265	jmc	1.21	#ifdef ALLOW_AIM
266			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
267			& iMin,iMax, jMin,jMax, bi,bj, kLev,
268	jmc	1.31	& myTime, myThid )
269	jmc	1.21	#endif /* ALLOW_AIM */
270
271	molod	1.23	#ifdef ALLOW_FIZHI
272			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
273			& iMin,iMax, jMin,jMax, bi,bj, kLev,
274	jmc	1.31	& myTime, myThid )
275	molod	1.23	#endif /* ALLOW_FIZHI */
276	heimbach	1.25
277	cnh	1.2	C Add heat in top-layer
278	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
279	jmc	1.31	DO j=1,sNy
280			DO i=1,sNx
281	cnh	1.2	gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
282	jmc	1.26	& +surfaceForcingT(i,j,bi,bj)
283	heimbach	1.38	& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
284	cnh	1.2	ENDDO
285			ENDDO
286			ENDIF
287	adcroft	1.5
288	mlosch	1.37	#ifdef ALLOW_SHELFICE
289			IF ( useShelfIce )
290			& CALL SHELFICE_FORCING_T(
291			I iMin,iMax, jMin,jMax, bi,bj, kLev,
292			I myTime, myThid )
293			#endif /* ALLOW_SHELFICE */
294
295	adcroft	1.5	#ifdef SHORTWAVE_HEATING
296			C Penetrating SW radiation
297	jmc	1.31	c IF ( usePenetratingSW ) THEN
298			swfracb(1)=abs(rF(klev))
299			swfracb(2)=abs(rF(klev+1))
300			CALL SWFRAC(
301	heimbach	1.8	I two,minusone,
302	jmc	1.31	I myTime,myThid,
303	dimitri	1.18	U swfracb)
304	jmc	1.31	kp1 = klev+1
305			IF (klev.EQ.Nr) THEN
306	jmc	1.24	kp1 = klev
307			swfracb(2)=0. _d 0
308	jmc	1.31	ENDIF
309			DO j=1,sNy
310			DO i=1,sNx
311			gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
312	jmc	1.24	& -Qsw(i,j,bi,bj)(swfracb(1)maskC(i,j,klev,bi,bj)
313			& -swfracb(2)*maskC(i,j,kp1, bi,bj))
314	jmc	1.27	& recip_Cprecip_rhoConst
315	heimbach	1.38	& recip_drF(klev)_recip_hFacC(i,j,kLev,bi,bj)
316	jmc	1.31	ENDDO
317	adcroft	1.5	ENDDO
318	jmc	1.31	c ENDIF
319	adcroft	1.5	#endif
320	heimbach	1.14
321	stephd	1.35	#ifdef ALLOW_RBCS
322			if (useRBCS) then
323			call RBCS_ADD_TENDENCY(bi,bj,klev, 1,
324			& myTime, myThid )
325			endif
326			#endif
327
328	jmc	1.31	#ifdef ALLOW_OBCS
329	heimbach	1.16	IF (useOBCS) THEN
330			CALL OBCS_SPONGE_T(
331	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
332			I myTime, myThid )
333	heimbach	1.16	ENDIF
334	heimbach	1.14	#endif
335
336	cnh	1.1	RETURN
337			END
338	jmc	1.31
339			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
340	cnh	1.13	CBOP
341			C !ROUTINE: EXTERNAL_FORCING_S
342			C !INTERFACE:
343	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_S(
344	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
345			I myTime, myThid )
346	cnh	1.13
347			C !DESCRIPTION: \bv
348			C ==========================================================
349	jmc	1.31	C \| S/R EXTERNAL_FORCING_S
350			C \| o Contains problem specific forcing for merid velocity.
351	cnh	1.13	C ==========================================================
352	jmc	1.31	C \| Adds terms to gS for forcing by external sources
353			C \| e.g. fresh-water flux, climatalogical relaxation, etc ...
354	cnh	1.13	C ==========================================================
355			C \ev
356
357			C !USES:
358	cnh	1.2	IMPLICIT NONE
359	cnh	1.1	C == Global data ==
360			#include "SIZE.h"
361			#include "EEPARAMS.h"
362			#include "PARAMS.h"
363			#include "GRID.h"
364			#include "DYNVARS.h"
365	cnh	1.2	#include "FFIELDS.h"
366	cnh	1.1
367	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
368	cnh	1.1	C == Routine arguments ==
369	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
370			C jMin,jMax :: Working range of y-index for applying forcing.
371			C bi,bj :: Current tile indices
372			C kLev :: Current vertical level index
373			C myTime :: Current time in simulation
374			C myThid :: Thread Id number
375	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
376	jmc	1.31	_RL myTime
377	adcroft	1.4	INTEGER myThid
378	cnh	1.2
379	cnh	1.13	C !LOCAL VARIABLES:
380	cnh	1.2	C == Local variables ==
381	jmc	1.31	C i,j :: Loop counters
382			C kSurface :: index of surface layer
383			INTEGER i, j
384	mlosch	1.17	INTEGER kSurface
385	cnh	1.13	CEOP
386	cnh	1.2
387	jmc	1.28	IF ( fluidIsAir ) THEN
388	jmc	1.21	kSurface = 0
389	jmc	1.28	ELSEIF ( usingPCoords ) THEN
390	mlosch	1.17	kSurface = Nr
391	jmc	1.28	ELSE
392	mlosch	1.17	kSurface = 1
393	jmc	1.28	ENDIF
394	mlosch	1.17
395	cnh	1.2	C-- Forcing term
396	jmc	1.21	#ifdef ALLOW_AIM
397			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
398			& iMin,iMax, jMin,jMax, bi,bj, kLev,
399	jmc	1.31	& myTime, myThid )
400	jmc	1.21	#endif /* ALLOW_AIM */
401
402	molod	1.23	#ifdef ALLOW_FIZHI
403			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
404			& iMin,iMax, jMin,jMax, bi,bj, kLev,
405	jmc	1.31	& myTime, myThid )
406	molod	1.23	#endif /* ALLOW_FIZHI */
407	heimbach	1.25
408	cnh	1.2	C Add fresh-water in top-layer
409	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
410	jmc	1.31	DO j=1,sNy
411			DO i=1,sNx
412	cnh	1.2	gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
413	jmc	1.26	& +surfaceForcingS(i,j,bi,bj)
414	heimbach	1.38	& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
415	cnh	1.2	ENDDO
416			ENDDO
417			ENDIF
418	heimbach	1.14
419	mlosch	1.37	#ifdef ALLOW_SHELFICE
420			IF ( useShelfIce )
421			& CALL SHELFICE_FORCING_S(
422			I iMin,iMax, jMin,jMax, bi,bj, kLev,
423			I myTime, myThid )
424			#endif /* ALLOW_SHELFICE */
425
426	stephd	1.35	#ifdef ALLOW_RBCS
427			if (useRBCS) then
428			call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
429			& myTime, myThid )
430			endif
431			#endif
432
433	jmc	1.31	#ifdef ALLOW_OBCS
434	heimbach	1.16	IF (useOBCS) THEN
435			CALL OBCS_SPONGE_S(
436	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
437			I myTime, myThid )
438	heimbach	1.16	ENDIF
439	heimbach	1.14	#endif
440	cnh	1.1
441			RETURN
442			END