pkg/aim_v23/aim_do_physics.F

C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_physics.F,v 1.7 2004/05/21 17:37:29 jmc Exp $
C $Name:  $

#include "AIM_OPTIONS.h"

CBOP
C     !ROUTINE: AIM_DO_PHYSICS
C     !INTERFACE:
      SUBROUTINE AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid ) 
                                      
C     !DESCRIPTION: \bv
C     *==================================================================*
C     | S/R AIM_DO_PHYSICS
C     *==================================================================*
C     | Interface between atmospheric physics package and the
C     | dynamical model.
C     | Routine calls physics pacakge after setting surface BC.
C     | Package should derive and set tendency terms
C     | which can be included as external forcing terms in the dynamical
C     | tendency routines. Packages should communicate this information
C     | through common blocks.
C     *==================================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

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

C-- MITgcm
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "SURFACE.h"

C-- Physics package
#include "AIM_PARAMS.h"
#include "AIM_FFIELDS.h"
#include "AIM_GRID.h"
#include "com_physvar.h"
#include "com_forcing.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, myIter, myThid
      _RL myTime
CEOP

#ifdef ALLOW_AIM
C     == Local variables ==
C     I,J,K,I2      - Loop counters
C     tYear         - Fraction into year
C     Katm          - Atmospheric K index
C     prcAtm   :: total precip from the atmosphere [kg/m2/s]
C     evpAtm   :: evaporation to the atmosphere [kg/m2/s] (>0 if evaporate)
C     flxSW    :: net Short-Wave heat flux into the ocean (+=down) [W/m2]
      INTEGER I,J,K,I2
c     INTEGER Katm
      _RL     tYear, yearLength
      _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)

C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),
C      ==> move water wapor from the stratos to the surface level.
      DO j = 1-Oly, sNy+Oly
       DO i = 1-Olx, sNx+Olx
        k = ksurfC(i,j,bi,bj)
        IF (k.LE.Nr)
     &    salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
     &                      + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)
     &                  *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)
        salt(i,j,Nr,bi,bj) = 0.
       ENDDO
      ENDDO

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

C-    Physics package needs to know time of year as a fraction
      yearLength = 86400.*360.
      tYear = mod(myTime/yearLength, 1. _d 0)
c     tYear = myTime/(86400.*360.) -
c    &        FLOAT(INT(myTime/(86400.*360.)))

C--   Set surface Boundary Conditions for atmos. physics package:
C     (Albedo, Soil moisture, Surf Temp, Land sea mask)
C     includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)
      CALL AIM_SURF_BC( tYear, myTime, myIter, bi, bj, myThid )

C--   Set surface geopotential: (g * orographic height)
      DO J=1,sNy
       DO I=1,sNx
         I2 = I+(J-1)*sNx
         PHI0(I2) = gravity*topoZ(i,j,bi,bj)
       ENDDO
      ENDDO

C--   Set topographic dependent FOROG var (originally in common SFLFIX);
C      used to compute for wind stress over land

c_FM  IF (IDAY.EQ.0) THEN
c_FM    CALL SFLSET (PHIS0)
        CALL SFLSET (PHI0, fOrogr(1,myThid), bi,bj,myThid)
c_FM  ENDIF
c_FM  CALL SOL_OZ (SOLC,TYEAR)

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

C-    Compute atmospheric-physics tendencies (call the main AIM S/R)
      CALL PHY_DRIVER( tYear, myTime, myIter, bi, bj, myThid )

      CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )

#ifdef ALLOW_LAND
      IF (useLand) THEN
C-    prepare Surface flux over land for land package
        CALL AIM_AIM2LAND( aim_landFr, bi, bj, 
     I                     myTime, myIter, myThid )

C-    Step forward land model
        CALL LAND_STEPFWD( aim_landFr, bi, bj, 
     I                     myTime, myIter, myThid )

C-    Land diagnostics : write snap-shot & cumulate for TimeAve output
      CALL LAND_DIAGNOSTICS( aim_landFr, bi, bj, 
     I                       myTime, myIter, myThid )

      ENDIF
#endif /* ALLOW_LAND */

C-    surface fluxes over ocean (ice-free & ice covered) 
C       used for diagnostics, thsice package and coupler
        CALL AIM_AIM2SIOCE( aim_landFr, fmask1(1,3,myThid),
     O                      prcAtm, evpAtm, flxSW, 
     I                      bi, bj, myTime, myIter, myThid )

#ifdef ALLOW_THSICE
      IF ( useThSIce ) THEN

C-    Step forward sea-ice model
        CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
     I                        prcAtm, 
     U                        evpAtm, flxSW,
     I                        myTime, myIter, myThid )

C-    Slab Ocean : step forward ocean mixed-layer temp. & salinity 
        CALL THSICE_SLAB_OCEAN( 
     O                         dTsurf(1,2,myThid), 
     I                         bi,bj, myThid )

        CALL THSICE_AVE( evpAtm, flxSW,
     I                   bi, bj, myTime, myIter, myThid )

      ENDIF
#endif /* ALLOW_THSICE */

#ifdef COMPONENT_MODULE
      IF ( useCoupler ) THEN
        CALL ATM_STORE_MY_DATA( bi, bj, myIter, myTime, myThid )
      ENDIF
#endif /* COMPONENT_MODULE */

C-    AIM diagnostics : write snap-shot & cumulate for TimeAve output
      CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )

#endif /* ALLOW_AIM */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_physics.F,v 1.7 2004/05/21 17:37:29 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "AIM_OPTIONS.h"
5
6	jmc	1.5	CBOP
7			C !ROUTINE: AIM_DO_PHYSICS
8			C !INTERFACE:
9	jmc	1.1	SUBROUTINE AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid )
10
11	jmc	1.5	C !DESCRIPTION: \bv
12	jmc	1.1	C ==================================================================
13			C \| S/R AIM_DO_PHYSICS
14			C ==================================================================
15			C \| Interface between atmospheric physics package and the
16			C \| dynamical model.
17			C \| Routine calls physics pacakge after setting surface BC.
18			C \| Package should derive and set tendency terms
19			C \| which can be included as external forcing terms in the dynamical
20			C \| tendency routines. Packages should communicate this information
21			C \| through common blocks.
22			C ==================================================================
23	jmc	1.5	C \ev
24
25			C !USES:
26	jmc	1.1	IMPLICIT NONE
27
28			C -------------- Global variables ------------------------------------
29			C-- size for MITgcm & Physics package :
30			#include "AIM_SIZE.h"
31
32			C-- MITgcm
33			#include "EEPARAMS.h"
34			#include "PARAMS.h"
35			#include "DYNVARS.h"
36			#include "GRID.h"
37			#include "SURFACE.h"
38
39			C-- Physics package
40	jmc	1.3	#include "AIM_PARAMS.h"
41	jmc	1.1	#include "AIM_FFIELDS.h"
42			#include "AIM_GRID.h"
43			#include "com_physvar.h"
44			#include "com_forcing.h"
45
46	jmc	1.5	C !INPUT/OUTPUT PARAMETERS:
47	jmc	1.1	C == Routine arguments ==
48			C bi,bj - Tile index
49			C myTime - Current time of simulation ( s )
50			C myIter - Current iteration number in simulation
51			C myThid - Number of this instance of the routine
52			INTEGER bi, bj, myIter, myThid
53			_RL myTime
54	jmc	1.5	CEOP
55	jmc	1.1
56			#ifdef ALLOW_AIM
57			C == Local variables ==
58			C I,J,K,I2 - Loop counters
59			C tYear - Fraction into year
60			C Katm - Atmospheric K index
61	jmc	1.5	C prcAtm :: total precip from the atmosphere [kg/m2/s]
62			C evpAtm :: evaporation to the atmosphere [kg/m2/s] (>0 if evaporate)
63			C flxSW :: net Short-Wave heat flux into the ocean (+=down) [W/m2]
64	jmc	1.1	INTEGER I,J,K,I2
65			c INTEGER Katm
66			_RL tYear, yearLength
67	jmc	1.5	_RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68			_RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69			_RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
70	jmc	1.1
71			C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),
72			C ==> move water wapor from the stratos to the surface level.
73			DO j = 1-Oly, sNy+Oly
74			DO i = 1-Olx, sNx+Olx
75			k = ksurfC(i,j,bi,bj)
76			IF (k.LE.Nr)
77			& salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
78			& + salt(i,j,Nr,bi,bj)drF(Nr)recip_drF(k)
79			& hFacC(i,j,Nr,bi,bj)recip_hFacC(i,j,k,bi,bj)
80			salt(i,j,Nr,bi,bj) = 0.
81			ENDDO
82			ENDDO
83
84			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
85
86			C- Physics package needs to know time of year as a fraction
87			yearLength = 86400.*360.
88			tYear = mod(myTime/yearLength, 1. _d 0)
89			c tYear = myTime/(86400.*360.) -
90			c & FLOAT(INT(myTime/(86400.*360.)))
91
92	jmc	1.2	C-- Set surface Boundary Conditions for atmos. physics package:
93			C (Albedo, Soil moisture, Surf Temp, Land sea mask)
94			C includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)
95			CALL AIM_SURF_BC( tYear, myTime, myIter, bi, bj, myThid )
96	jmc	1.1
97			C-- Set surface geopotential: (g * orographic height)
98			DO J=1,sNy
99			DO I=1,sNx
100			I2 = I+(J-1)*sNx
101			PHI0(I2) = gravity*topoZ(i,j,bi,bj)
102			ENDDO
103			ENDDO
104
105			C-- Set topographic dependent FOROG var (originally in common SFLFIX);
106			C used to compute for wind stress over land
107
108			c_FM IF (IDAY.EQ.0) THEN
109			c_FM CALL SFLSET (PHIS0)
110			CALL SFLSET (PHI0, fOrogr(1,myThid), bi,bj,myThid)
111			c_FM ENDIF
112			c_FM CALL SOL_OZ (SOLC,TYEAR)
113
114			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
115
116			C- Compute atmospheric-physics tendencies (call the main AIM S/R)
117			CALL PHY_DRIVER( tYear, myTime, myIter, bi, bj, myThid )
118
119			CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )
120	jmc	1.3
121			#ifdef ALLOW_LAND
122	jmc	1.4	IF (useLand) THEN
123	jmc	1.3	C- prepare Surface flux over land for land package
124			CALL AIM_AIM2LAND( aim_landFr, bi, bj,
125			I myTime, myIter, myThid )
126
127			C- Step forward land model
128			CALL LAND_STEPFWD( aim_landFr, bi, bj,
129			I myTime, myIter, myThid )
130
131			C- Land diagnostics : write snap-shot & cumulate for TimeAve output
132			CALL LAND_DIAGNOSTICS( aim_landFr, bi, bj,
133			I myTime, myIter, myThid )
134
135			ENDIF
136			#endif /* ALLOW_LAND */
137	jmc	1.5
138	jmc	1.6	C- surface fluxes over ocean (ice-free & ice covered)
139			C used for diagnostics, thsice package and coupler
140	jmc	1.7	CALL AIM_AIM2SIOCE( aim_landFr, fmask1(1,3,myThid),
141	jmc	1.6	O prcAtm, evpAtm, flxSW,
142			I bi, bj, myTime, myIter, myThid )
143
144	jmc	1.5	#ifdef ALLOW_THSICE
145			IF ( useThSIce ) THEN
146
147			C- Step forward sea-ice model
148			CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
149			I prcAtm,
150			U evpAtm, flxSW,
151			I myTime, myIter, myThid )
152
153			C- Slab Ocean : step forward ocean mixed-layer temp. & salinity
154	jmc	1.8	CALL THSICE_SLAB_OCEAN(
155			O dTsurf(1,2,myThid),
156			I bi,bj, myThid )
157	jmc	1.5
158			CALL THSICE_AVE( evpAtm, flxSW,
159			I bi, bj, myTime, myIter, myThid )
160
161			ENDIF
162			#endif /* ALLOW_THSICE */
163	jmc	1.4
164			#ifdef COMPONENT_MODULE
165			IF ( useCoupler ) THEN
166			CALL ATM_STORE_MY_DATA( bi, bj, myIter, myTime, myThid )
167			ENDIF
168			#endif /* COMPONENT_MODULE */
169	jmc	1.1
170	jmc	1.8	C- AIM diagnostics : write snap-shot & cumulate for TimeAve output
171			CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
172
173	jmc	1.1	#endif /* ALLOW_AIM */
174
175			RETURN
176			END