cg/code/parent_override.F

C $Header: /u/gcmpack/MITgcm_contrib/PRM/multi_comp_setup/cg/code/parent_override.F,v 1.4 2007/10/05 15:11:03 jmc Exp $
C $Name:  $

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

CBOP
C     !ROUTINE: PARENT_TENDENCY_APPLY_U
C     !INTERFACE:
      SUBROUTINE PARENT_TENDENCY_APPLY_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R PARENT_TENDENCY_APPLY_U
C     | o Contains problem specific forcing for zonal velocity.
C     *==========================================================*
C     | Adds terms to gU for forcing by external sources
C     | defined as "parent"                        
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "DYNVARS.h"
#include "PARENT_OVERRIDE.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
      INTEGER i, j
CEOP

!     Call routine that applies any  "parent" override for
!     step "tendency_apply_u".
!     I think we will end up with a "parent" or "override"
!     package to provide general support for this.
      IF ( usePO_Tendency_Apply_U) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
     &     + maskW(i,j,kLev,bi,bj) * ( po_gu(i-1,j,kLev,bi,bj)
     &                                +po_gu( i, j,kLev,bi,bj) )
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PARENT_TENDENCY_APPLY_V
C     !INTERFACE:
      SUBROUTINE PARENT_TENDENCY_APPLY_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R PARENT_TENDENCY_APPLY_V
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds terms to gV for forcing by external sources
C     | defined as "parent".                       
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 "PARENT_OVERRIDE.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 ( usePO_Tendency_Apply_V) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
     &     + maskS(i,j,kLev,bi,bj) * ( po_gv(i,j-1,kLev,bi,bj)
     &                                +po_gv(i, j, kLev,bi,bj) )
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_T
C     !INTERFACE:
      SUBROUTINE PARENT_TENDENCY_APPLY_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"
#include "PARENT_OVERRIDE.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 ( usePO_Tendency_Apply_Theta) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj) +
     .       maskC(i,j,kLev,bi,bj) * po_gTheta(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END


      SUBROUTINE SET_DDTVARS( gUVelC,   gVVelC,  gThetaC, 
     I                        cnx, cny, cnr, myThid )

      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "PARENT_OVERRIDE.h"

C     myThid    :: Thread Id number
      INTEGER myThid
      INTEGER cnx, cny, cnr
      REAL*8 gUVelC( cnx, cny, cnr)
      REAL*8 gVVelC( cnx, cny, cnr)
      REAL*8 gThetaC(cnx, cny, cnr)

      INTEGER I,J,K

      IF ( cnx .NE. snx ) THEN
       STOP 'SET_DTTVARS cnx NE snx'
      ENDIF
      IF ( cny .NE. sny ) THEN
       STOP 'SET_DTTVARS cny NE sny'
      ENDIF
      IF ( cnr .NE.  nr ) THEN
       STOP 'SET_DTTVARS cnr NE  nr'
      ENDIF

      DO K=1,nr
       DO J=1,sny
        DO I=1,snx
         po_gu(i,j,k,1,1) = gUVelC(I,J,K)
        ENDDO
       ENDDO
      ENDDO

      DO K=1,nr
       DO J=1,sny
        DO I=1,snx
         po_gv(i,j,k,1,1) = gVVelC(I,J,K)
        ENDDO
       ENDDO
      ENDDO

      DO K=1,nr
       DO J=1,sny
        DO I=1,snx
         po_gTheta(i,j,k,1,1) = gThetaC(I,J,K)
        ENDDO
       ENDDO
      ENDDO
C--   po_gu & po_gv are both on A-grid
      CALL EXCH_3D_RL( po_gu, Nr, myThid )
      CALL EXCH_3D_RL( po_gv, Nr, myThid )

      RETURN
      END

1	jmc	1.5	C $Header: /u/gcmpack/MITgcm_contrib/PRM/multi_comp_setup/cg/code/parent_override.F,v 1.4 2007/10/05 15:11:03 jmc Exp $
2	cnh	1.1	C $Name: $
3
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_OPTIONS.h"
6
7			CBOP
8			C !ROUTINE: PARENT_TENDENCY_APPLY_U
9			C !INTERFACE:
10			SUBROUTINE PARENT_TENDENCY_APPLY_U(
11			I iMin,iMax, jMin,jMax, bi,bj, kLev,
12			I myTime, myThid )
13			C !DESCRIPTION: \bv
14			C ==========================================================
15			C \| S/R PARENT_TENDENCY_APPLY_U
16			C \| o Contains problem specific forcing for zonal velocity.
17			C ==========================================================
18			C \| Adds terms to gU for forcing by external sources
19			C \| defined as "parent"
20			C ==========================================================
21			C \ev
22
23			C !USES:
24			IMPLICIT NONE
25			C == Global data ==
26			#include "SIZE.h"
27			#include "GRID.h"
28			#include "EEPARAMS.h"
29			#include "DYNVARS.h"
30			#include "PARENT_OVERRIDE.h"
31
32			C !INPUT/OUTPUT PARAMETERS:
33			C == Routine arguments ==
34			C iMin,iMax :: Working range of x-index for applying forcing.
35			C jMin,jMax :: Working range of y-index for applying forcing.
36			C bi,bj :: Current tile indices
37			C kLev :: Current vertical level index
38			C myTime :: Current time in simulation
39			C myThid :: Thread Id number
40			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
41			_RL myTime
42			INTEGER myThid
43
44			C !LOCAL VARIABLES:
45			C == Local variables ==
46			C i,j :: Loop counters
47			INTEGER i, j
48			CEOP
49
50			! Call routine that applies any "parent" override for
51			! step "tendency_apply_u".
52			! I think we will end up with a "parent" or "override"
53			! package to provide general support for this.
54			IF ( usePO_Tendency_Apply_U) THEN
55			DO j=jMin,jMax
56			DO i=iMin,iMax
57	jmc	1.5	gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
58			& + maskW(i,j,kLev,bi,bj) * ( po_gu(i-1,j,kLev,bi,bj)
59			& +po_gu( i, j,kLev,bi,bj) )
60	cnh	1.1	ENDDO
61			ENDDO
62			ENDIF
63
64			RETURN
65			END
66
67			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
68			CBOP
69			C !ROUTINE: PARENT_TENDENCY_APPLY_V
70			C !INTERFACE:
71			SUBROUTINE PARENT_TENDENCY_APPLY_V(
72			I iMin,iMax, jMin,jMax, bi,bj, kLev,
73			I myTime, myThid )
74			C !DESCRIPTION: \bv
75			C ==========================================================
76			C \| S/R PARENT_TENDENCY_APPLY_V
77			C \| o Contains problem specific forcing for merid velocity.
78			C ==========================================================
79			C \| Adds terms to gV for forcing by external sources
80			C \| defined as "parent".
81			C ==========================================================
82			C \ev
83
84			C !USES:
85			IMPLICIT NONE
86			C == Global data ==
87			#include "SIZE.h"
88			#include "EEPARAMS.h"
89			#include "PARAMS.h"
90			#include "GRID.h"
91			#include "DYNVARS.h"
92			#include "PARENT_OVERRIDE.h"
93
94			C !INPUT/OUTPUT PARAMETERS:
95			C == Routine arguments ==
96			C iMin,iMax :: Working range of x-index for applying forcing.
97			C jMin,jMax :: Working range of y-index for applying forcing.
98			C bi,bj :: Current tile indices
99			C kLev :: Current vertical level index
100			C myTime :: Current time in simulation
101			C myThid :: Thread Id number
102			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
103			_RL myTime
104			INTEGER myThid
105
106			C !LOCAL VARIABLES:
107			C == Local variables ==
108			C i,j :: Loop counters
109			C kSurface :: index of surface layer
110			INTEGER i, j
111			INTEGER kSurface
112			CEOP
113	cnh	1.2	IF ( usePO_Tendency_Apply_V) THEN
114			DO j=jMin,jMax
115			DO i=iMin,iMax
116	jmc	1.5	gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
117			& + maskS(i,j,kLev,bi,bj) * ( po_gv(i,j-1,kLev,bi,bj)
118			& +po_gv(i, j, kLev,bi,bj) )
119	cnh	1.2	ENDDO
120			ENDDO
121			ENDIF
122	cnh	1.1
123			RETURN
124			END
125
126			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
127			CBOP
128			C !ROUTINE: EXTERNAL_FORCING_T
129			C !INTERFACE:
130			SUBROUTINE PARENT_TENDENCY_APPLY_T(
131			I iMin,iMax, jMin,jMax, bi,bj, kLev,
132			I myTime, myThid )
133			C !DESCRIPTION: \bv
134			C ==========================================================
135			C \| S/R EXTERNAL_FORCING_T
136			C \| o Contains problem specific forcing for temperature.
137			C ==========================================================
138			C \| Adds terms to gT for forcing by external sources
139			C \| e.g. heat flux, climatalogical relaxation, etc ...
140			C ==========================================================
141			C \ev
142
143			C !USES:
144			IMPLICIT NONE
145			C == Global data ==
146			#include "SIZE.h"
147			#include "EEPARAMS.h"
148			#include "PARAMS.h"
149			#include "GRID.h"
150			#include "DYNVARS.h"
151			#include "FFIELDS.h"
152	cnh	1.2	#include "PARENT_OVERRIDE.h"
153	cnh	1.1
154			C !INPUT/OUTPUT PARAMETERS:
155			C == Routine arguments ==
156			C iMin,iMax :: Working range of x-index for applying forcing.
157			C jMin,jMax :: Working range of y-index for applying forcing.
158			C bi,bj :: Current tile indices
159			C kLev :: Current vertical level index
160			C myTime :: Current time in simulation
161			C myThid :: Thread Id number
162			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
163			_RL myTime
164			INTEGER myThid
165
166			C !LOCAL VARIABLES:
167			C == Local variables ==
168			C i,j :: Loop counters
169			C kSurface :: index of surface layer
170			INTEGER i, j
171			INTEGER kSurface
172			CEOP
173
174	cnh	1.2	IF ( usePO_Tendency_Apply_Theta) THEN
175			DO j=jMin,jMax
176			DO i=iMin,iMax
177			gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj) +
178	jmc	1.4	. maskC(i,j,kLev,bi,bj) * po_gTheta(i,j,kLev,bi,bj)
179	cnh	1.2	ENDDO
180			ENDDO
181			ENDIF
182
183			RETURN
184			END
185
186
187	jmc	1.5	SUBROUTINE SET_DDTVARS( gUVelC, gVVelC, gThetaC,
188			I cnx, cny, cnr, myThid )
189	cnh	1.2
190			IMPLICIT NONE
191
192			#include "SIZE.h"
193			#include "EEPARAMS.h"
194			#include "PARAMS.h"
195			#include "PARENT_OVERRIDE.h"
196
197	jmc	1.5	C myThid :: Thread Id number
198			INTEGER myThid
199	cnh	1.2	INTEGER cnx, cny, cnr
200			REAL*8 gUVelC( cnx, cny, cnr)
201			REAL*8 gVVelC( cnx, cny, cnr)
202			REAL*8 gThetaC(cnx, cny, cnr)
203
204			INTEGER I,J,K
205
206			IF ( cnx .NE. snx ) THEN
207			STOP 'SET_DTTVARS cnx NE snx'
208			ENDIF
209			IF ( cny .NE. sny ) THEN
210			STOP 'SET_DTTVARS cny NE sny'
211			ENDIF
212			IF ( cnr .NE. nr ) THEN
213			STOP 'SET_DTTVARS cnr NE nr'
214			ENDIF
215
216			DO K=1,nr
217			DO J=1,sny
218			DO I=1,snx
219			po_gu(i,j,k,1,1) = gUVelC(I,J,K)
220			ENDDO
221			ENDDO
222			ENDDO
223	cnh	1.1
224	cnh	1.3	DO K=1,nr
225			DO J=1,sny
226			DO I=1,snx
227			po_gv(i,j,k,1,1) = gVVelC(I,J,K)
228			ENDDO
229			ENDDO
230			ENDDO
231
232			DO K=1,nr
233			DO J=1,sny
234			DO I=1,snx
235			po_gTheta(i,j,k,1,1) = gThetaC(I,J,K)
236			ENDDO
237			ENDDO
238			ENDDO
239	jmc	1.5	C-- po_gu & po_gv are both on A-grid
240			CALL EXCH_3D_RL( po_gu, Nr, myThid )
241			CALL EXCH_3D_RL( po_gv, Nr, myThid )
242	cnh	1.3
243	cnh	1.1	RETURN
244			END
245	cnh	1.2