cg/code/parent_override.F

C $Header: /u/gcmpack/MITgcm_contrib/PRM/multi_comp_setup/cg/code/parent_override.F,v 1.1.1.1 2006/10/10 18:17:27 cnh 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,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,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) +
     .       maskS(i,j,kLev,bi,bj) * po_gTheta(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END


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

      IMPLICIT NONE

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

      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

      RETURN
      END

1	cnh	1.2	C $Header: /u/gcmpack/MITgcm_contrib/PRM/multi_comp_setup/cg/code/parent_override.F,v 1.1.1.1 2006/10/10 18:17:27 cnh 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			gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj) +
58			. maskW(i,j,kLev,bi,bj) * po_gu(i,j,kLev,bi,bj)
59			ENDDO
60			ENDDO
61			ENDIF
62
63			RETURN
64			END
65
66			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
67			CBOP
68			C !ROUTINE: PARENT_TENDENCY_APPLY_V
69			C !INTERFACE:
70			SUBROUTINE PARENT_TENDENCY_APPLY_V(
71			I iMin,iMax, jMin,jMax, bi,bj, kLev,
72			I myTime, myThid )
73			C !DESCRIPTION: \bv
74			C ==========================================================
75			C \| S/R PARENT_TENDENCY_APPLY_V
76			C \| o Contains problem specific forcing for merid velocity.
77			C ==========================================================
78			C \| Adds terms to gV for forcing by external sources
79			C \| defined as "parent".
80			C ==========================================================
81			C \ev
82
83			C !USES:
84			IMPLICIT NONE
85			C == Global data ==
86			#include "SIZE.h"
87			#include "EEPARAMS.h"
88			#include "PARAMS.h"
89			#include "GRID.h"
90			#include "DYNVARS.h"
91			#include "PARENT_OVERRIDE.h"
92
93			C !INPUT/OUTPUT PARAMETERS:
94			C == Routine arguments ==
95			C iMin,iMax :: Working range of x-index for applying forcing.
96			C jMin,jMax :: Working range of y-index for applying forcing.
97			C bi,bj :: Current tile indices
98			C kLev :: Current vertical level index
99			C myTime :: Current time in simulation
100			C myThid :: Thread Id number
101			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
102			_RL myTime
103			INTEGER myThid
104
105			C !LOCAL VARIABLES:
106			C == Local variables ==
107			C i,j :: Loop counters
108			C kSurface :: index of surface layer
109			INTEGER i, j
110			INTEGER kSurface
111			CEOP
112	cnh	1.2	IF ( usePO_Tendency_Apply_V) THEN
113			DO j=jMin,jMax
114			DO i=iMin,iMax
115			gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj) +
116			. maskS(i,j,kLev,bi,bj) * po_gv(i,j,kLev,bi,bj)
117			ENDDO
118			ENDDO
119			ENDIF
120	cnh	1.1
121			RETURN
122			END
123
124			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
125			CBOP
126			C !ROUTINE: EXTERNAL_FORCING_T
127			C !INTERFACE:
128			SUBROUTINE PARENT_TENDENCY_APPLY_T(
129			I iMin,iMax, jMin,jMax, bi,bj, kLev,
130			I myTime, myThid )
131			C !DESCRIPTION: \bv
132			C ==========================================================
133			C \| S/R EXTERNAL_FORCING_T
134			C \| o Contains problem specific forcing for temperature.
135			C ==========================================================
136			C \| Adds terms to gT for forcing by external sources
137			C \| e.g. heat flux, climatalogical relaxation, etc ...
138			C ==========================================================
139			C \ev
140
141			C !USES:
142			IMPLICIT NONE
143			C == Global data ==
144			#include "SIZE.h"
145			#include "EEPARAMS.h"
146			#include "PARAMS.h"
147			#include "GRID.h"
148			#include "DYNVARS.h"
149			#include "FFIELDS.h"
150	cnh	1.2	#include "PARENT_OVERRIDE.h"
151	cnh	1.1
152			C !INPUT/OUTPUT PARAMETERS:
153			C == Routine arguments ==
154			C iMin,iMax :: Working range of x-index for applying forcing.
155			C jMin,jMax :: Working range of y-index for applying forcing.
156			C bi,bj :: Current tile indices
157			C kLev :: Current vertical level index
158			C myTime :: Current time in simulation
159			C myThid :: Thread Id number
160			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
161			_RL myTime
162			INTEGER myThid
163
164			C !LOCAL VARIABLES:
165			C == Local variables ==
166			C i,j :: Loop counters
167			C kSurface :: index of surface layer
168			INTEGER i, j
169			INTEGER kSurface
170			CEOP
171
172	cnh	1.2	IF ( usePO_Tendency_Apply_Theta) THEN
173			DO j=jMin,jMax
174			DO i=iMin,iMax
175			gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj) +
176			. maskS(i,j,kLev,bi,bj) * po_gTheta(i,j,kLev,bi,bj)
177			ENDDO
178			ENDDO
179			ENDIF
180
181			RETURN
182			END
183
184
185			SUBROUTINE SET_DDTVARS( gUVelC, gVVelC, gThetaC, cnx, cny,cnr)
186
187			IMPLICIT NONE
188
189			#include "SIZE.h"
190			#include "EEPARAMS.h"
191			#include "PARAMS.h"
192			#include "PARENT_OVERRIDE.h"
193
194			INTEGER cnx, cny, cnr
195			REAL*8 gUVelC( cnx, cny, cnr)
196			REAL*8 gVVelC( cnx, cny, cnr)
197			REAL*8 gThetaC(cnx, cny, cnr)
198
199			INTEGER I,J,K
200
201			IF ( cnx .NE. snx ) THEN
202			STOP 'SET_DTTVARS cnx NE snx'
203			ENDIF
204			IF ( cny .NE. sny ) THEN
205			STOP 'SET_DTTVARS cny NE sny'
206			ENDIF
207			IF ( cnr .NE. nr ) THEN
208			STOP 'SET_DTTVARS cnr NE nr'
209			ENDIF
210
211			DO K=1,nr
212			DO J=1,sny
213			DO I=1,snx
214			po_gu(i,j,k,1,1) = gUVelC(I,J,K)
215			ENDDO
216			ENDDO
217			ENDDO
218	cnh	1.1
219			RETURN
220			END
221	cnh	1.2