pkg/aim_v23/aim_aim2dyn.F

C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_aim2dyn.F,v 1.7 2010/01/21 00:11:16 jmc Exp $
C $Name:  $

#include "AIM_OPTIONS.h"

CBOP
C     !ROUTINE: AIM_AIM2DYN
C     !INTERFACE:
      SUBROUTINE AIM_AIM2DYN(
     I                        bi, bj, myTime, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R AIM_AIM2DYN
C     | o Remap AIM outputs to dynamics conforming arrays.
C     |==========================================================*
C     | Currently AIM exports to the dynmaics
C     |  - PBL drag coefficient
C     |  - Net tendency for temperature
C     |  - Net tendency for water vapor
C     | Exporting drag has the nice property that it is a scalar.
C     | This means that the exchanges on the AIM exported fields
C     | do not need special piaring on the cube. It may not be
C     | a good idea in the long term as it makes assumptions
C     | about the momentum schemes within AIM.
C     *==========================================================*
C     \ev
C-------
C  Note: Except LSC tendency, all others need to be /dpFac.
C-------

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
C-- size for MITgcm & Physics package :
#include "AIM_SIZE.h"

#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"

#include "AIM2DYN.h"
#include "com_physvar.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     bi,bj  :: Tile index
C     myTime :: Current time of simulation ( s )
C     myIter :: Current iteration number in simulation
C     myThid :: Number of this instance of the routine
      INTEGER bi, bj
      _RL     myTime
      INTEGER myIter, myThid
CEOP

#ifdef ALLOW_AIM
C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j,k        :: loop counters
C     I2,Katm      :: loop counters
C     conv_T2theta :: conversion factor from (absolute) Temp. to Pot.Temp.
      _RL conv_T2theta
      INTEGER i,j,k
      INTEGER I2, Katm
#ifdef ALLOW_DIAGNOSTICS
      LOGICAL  physTendDiag
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL DIAGNOSTICS_IS_ON
#endif

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

C--   Physics tendency term

#ifdef ALLOW_DIAGNOSTICS
      physTendDiag = .FALSE.
      IF (useDiagnostics) THEN
        physTendDiag = DIAGNOSTICS_IS_ON( 'DIABT   ', myThid )
     &            .OR. DIAGNOSTICS_IS_ON( 'DIABQ   ', myThid )
      ENDIF
#endif

C-    Planetary boundary layer drag coeff.
      DO j=1,sNy
        DO i=1,sNx
         I2 = i+(j-1)*sNx
         aim_drag(i,j,bi,bj) = DRAG(I2,0,myThid)
        ENDDO
      ENDDO
#ifdef COMPONENT_MODULE
      IF ( useCoupler ) THEN
C-    Near surface wind speed
       DO j=1,sNy
        DO i=1,sNx
         I2 = i+(j-1)*sNx
         aim_surfWind(i,j,bi,bj) = SPEED0(I2,myThid)
        ENDDO
       ENDDO
      ENDIF
#endif /* COMPONENT_MODULE */

      DO k=1,Nr
       Katm = _KD2KA( k )
       conv_T2theta = (atm_po/rC(k))**atm_kappa

C-     Add all tendencies (ignoring partial cell factor) for T & Q
C          and convert Temp. tendency to Pot.Temp. tendency
       DO j=1,sNy
        DO i=1,sNx
         I2 = i+(j-1)*sNx
C        temperature tendency
         aim_dTdt(i,j,k,bi,bj) = ( TT_CNV(I2,Katm,myThid)
     &                            +TT_PBL(I2,Katm,myThid)
     &                            +TT_RSW(I2,Katm,myThid)
     &                            +TT_RLW(I2,Katm,myThid)
     &                            +TT_LSC(I2,Katm,myThid)
     &                           )*conv_T2theta
C        water vapor tendency
         aim_dSdt(i,j,k,bi,bj) =   QT_CNV(I2,Katm,myThid)
     &                            +QT_PBL(I2,Katm,myThid)
     &                            +QT_LSC(I2,Katm,myThid)
        ENDDO
       ENDDO

#ifdef ALLOW_DIAGNOSTICS
       IF ( physTendDiag ) THEN
         CALL DIAGNOSTICS_FILL( aim_dTdt, 'DIABT   ',
     &                          k, Nr, 1,bi,bj, myThid )
         CALL DIAGNOSTICS_FILL( aim_dSdt, 'DIABQ   ',
     &                          k, Nr, 1,bi,bj, myThid )
       ENDIF
#endif /* ALLOW_DIAGNOSTICS */

C-     Account for partial cell filling:
#ifdef NONLIN_FRSURF
       IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
        IF ( select_rStar.GT.0 ) THEN
         DO j=1,sNy
          DO i=1,sNx
           aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
     &                             /rStarExpC(i,j,bi,bj)
           aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
     &                             /rStarExpC(i,j,bi,bj)
          ENDDO
         ENDDO
        ELSE
         DO j=1,sNy
         DO i=1,sNx
          IF ( k.EQ.kSurfC(i,j,bi,bj) ) THEN
           aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
     &                            /hFac_surfC(i,j,bi,bj)
           aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
     &                            /hFac_surfC(i,j,bi,bj)
          ELSE
           aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
           aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
          ENDIF
         ENDDO
         ENDDO
        ENDIF
       ELSE
#else /* ndef NONLIN_FRSURF */
       IF (.TRUE.) THEN
#endif /* NONLIN_FRSURF */
        DO j=1,sNy
         DO i=1,sNx
          aim_dTdt(i,j,k,bi,bj) =  aim_dTdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
          aim_dSdt(i,j,k,bi,bj) =  aim_dSdt(i,j,k,bi,bj)
     &                         *recip_hFacC(i,j,k,bi,bj)
         ENDDO
        ENDDO
       ENDIF

C--- end of k loop.
      ENDDO

#endif /* ALLOW_AIM */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_aim2dyn.F,v 1.7 2010/01/21 00:11:16 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "AIM_OPTIONS.h"
5
6	jmc	1.7	CBOP
7			C !ROUTINE: AIM_AIM2DYN
8			C !INTERFACE:
9	jmc	1.1	SUBROUTINE AIM_AIM2DYN(
10	jmc	1.7	I bi, bj, myTime, myIter, myThid )
11
12			C !DESCRIPTION: \bv
13	jmc	1.1	C ==========================================================
14	jmc	1.7	C \| S/R AIM_AIM2DYN
15			C \| o Remap AIM outputs to dynamics conforming arrays.
16	jmc	1.1	C \|==========================================================*
17	jmc	1.7	C \| Currently AIM exports to the dynmaics
18			C \| - PBL drag coefficient
19			C \| - Net tendency for temperature
20			C \| - Net tendency for water vapor
21			C \| Exporting drag has the nice property that it is a scalar.
22			C \| This means that the exchanges on the AIM exported fields
23			C \| do not need special piaring on the cube. It may not be
24			C \| a good idea in the long term as it makes assumptions
25			C \| about the momentum schemes within AIM.
26	jmc	1.1	C ==========================================================
27	jmc	1.7	C \ev
28	jmc	1.1	C-------
29			C Note: Except LSC tendency, all others need to be /dpFac.
30			C-------
31	jmc	1.7
32			C !USES:
33	jmc	1.1	IMPLICIT NONE
34
35	jmc	1.7	C == Global variables ===
36	jmc	1.1	C-- size for MITgcm & Physics package :
37	jmc	1.6	#include "AIM_SIZE.h"
38	jmc	1.1
39			#include "EEPARAMS.h"
40			#include "PARAMS.h"
41			#include "GRID.h"
42	jmc	1.5	#include "SURFACE.h"
43	jmc	1.1
44			#include "AIM2DYN.h"
45			#include "com_physvar.h"
46
47	jmc	1.7	C !INPUT/OUTPUT PARAMETERS:
48	jmc	1.1	C == Routine arguments ==
49	jmc	1.7	C bi,bj :: Tile index
50			C myTime :: Current time of simulation ( s )
51			C myIter :: Current iteration number in simulation
52			C myThid :: Number of this instance of the routine
53			INTEGER bi, bj
54			_RL myTime
55			INTEGER myIter, myThid
56			CEOP
57	jmc	1.1
58			#ifdef ALLOW_AIM
59	jmc	1.7	C !LOCAL VARIABLES:
60	jmc	1.1	C == Local variables ==
61			C i,j,k :: loop counters
62			C I2,Katm :: loop counters
63			C conv_T2theta :: conversion factor from (absolute) Temp. to Pot.Temp.
64			_RL conv_T2theta
65			INTEGER i,j,k
66			INTEGER I2, Katm
67	jmc	1.6	#ifdef ALLOW_DIAGNOSTICS
68			LOGICAL physTendDiag
69			LOGICAL DIAGNOSTICS_IS_ON
70			EXTERNAL DIAGNOSTICS_IS_ON
71			#endif
72	jmc	1.1
73	jmc	1.7	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
74
75	jmc	1.1	C-- Physics tendency term
76
77	jmc	1.6	#ifdef ALLOW_DIAGNOSTICS
78			physTendDiag = .FALSE.
79			IF (useDiagnostics) THEN
80			physTendDiag = DIAGNOSTICS_IS_ON( 'DIABT ', myThid )
81			& .OR. DIAGNOSTICS_IS_ON( 'DIABQ ', myThid )
82			ENDIF
83			#endif
84
85	jmc	1.5	C- Planetary boundary layer drag coeff.
86			DO j=1,sNy
87			DO i=1,sNx
88			I2 = i+(j-1)*sNx
89			aim_drag(i,j,bi,bj) = DRAG(I2,0,myThid)
90			ENDDO
91			ENDDO
92	jmc	1.8	#ifdef COMPONENT_MODULE
93			IF ( useCoupler ) THEN
94			C- Near surface wind speed
95			DO j=1,sNy
96			DO i=1,sNx
97			I2 = i+(j-1)*sNx
98			aim_surfWind(i,j,bi,bj) = SPEED0(I2,myThid)
99			ENDDO
100			ENDDO
101			ENDIF
102			#endif /* COMPONENT_MODULE */
103	jmc	1.5
104	jmc	1.1	DO k=1,Nr
105	jmc	1.5	Katm = _KD2KA( k )
106	jmc	1.1	conv_T2theta = (atm_po/rC(k))**atm_kappa
107	jmc	1.5
108	jmc	1.6	C- Add all tendencies (ignoring partial cell factor) for T & Q
109			C and convert Temp. tendency to Pot.Temp. tendency
110	jmc	1.1	DO j=1,sNy
111			DO i=1,sNx
112			I2 = i+(j-1)*sNx
113	jmc	1.6	C temperature tendency
114			aim_dTdt(i,j,k,bi,bj) = ( TT_CNV(I2,Katm,myThid)
115	jmc	1.1	& +TT_PBL(I2,Katm,myThid)
116			& +TT_RSW(I2,Katm,myThid)
117			& +TT_RLW(I2,Katm,myThid)
118	jmc	1.6	& +TT_LSC(I2,Katm,myThid)
119			& )*conv_T2theta
120			C water vapor tendency
121	jmc	1.5	aim_dSdt(i,j,k,bi,bj) = QT_CNV(I2,Katm,myThid)
122	jmc	1.1	& +QT_PBL(I2,Katm,myThid)
123	jmc	1.6	& +QT_LSC(I2,Katm,myThid)
124	jmc	1.5	ENDDO
125			ENDDO
126	jmc	1.1
127	jmc	1.6	#ifdef ALLOW_DIAGNOSTICS
128			IF ( physTendDiag ) THEN
129			CALL DIAGNOSTICS_FILL( aim_dTdt, 'DIABT ',
130			& k, Nr, 1,bi,bj, myThid )
131			CALL DIAGNOSTICS_FILL( aim_dSdt, 'DIABQ ',
132			& k, Nr, 1,bi,bj, myThid )
133			ENDIF
134			#endif /* ALLOW_DIAGNOSTICS */
135
136	jmc	1.5	C- Account for partial cell filling:
137			#ifdef NONLIN_FRSURF
138			IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
139			IF ( select_rStar.GT.0 ) THEN
140			DO j=1,sNy
141			DO i=1,sNx
142			aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
143			& *recip_hFacC(i,j,k,bi,bj)
144			& /rStarExpC(i,j,bi,bj)
145			aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
146			& *recip_hFacC(i,j,k,bi,bj)
147			& /rStarExpC(i,j,bi,bj)
148			ENDDO
149			ENDDO
150			ELSE
151			DO j=1,sNy
152			DO i=1,sNx
153	jmc	1.8	IF ( k.EQ.kSurfC(i,j,bi,bj) ) THEN
154	jmc	1.5	aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
155			& /hFac_surfC(i,j,bi,bj)
156			aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
157			& /hFac_surfC(i,j,bi,bj)
158			ELSE
159			aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
160			& *recip_hFacC(i,j,k,bi,bj)
161			aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
162			& *recip_hFacC(i,j,k,bi,bj)
163			ENDIF
164			ENDDO
165			ENDDO
166			ENDIF
167			ELSE
168			#else /* ndef NONLIN_FRSURF */
169			IF (.TRUE.) THEN
170			#endif /* NONLIN_FRSURF */
171			DO j=1,sNy
172			DO i=1,sNx
173			aim_dTdt(i,j,k,bi,bj) = aim_dTdt(i,j,k,bi,bj)
174			& *recip_hFacC(i,j,k,bi,bj)
175			aim_dSdt(i,j,k,bi,bj) = aim_dSdt(i,j,k,bi,bj)
176			& *recip_hFacC(i,j,k,bi,bj)
177			ENDDO
178			ENDDO
179			ENDIF
180
181			C--- end of k loop.
182	jmc	1.1	ENDDO
183
184			#endif /* ALLOW_AIM */
185
186			RETURN
187			END