/[MITgcm]/MITgcm/pkg/aim_v23/aim_do_physics.F
ViewVC logotype

Diff of /MITgcm/pkg/aim_v23/aim_do_physics.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.17 by dfer, Mon Jun 15 13:40:03 2009 UTC revision 1.19 by jmc, Mon Jan 21 23:07:50 2013 UTC
# Line 42  C-- Physics package Line 42  C-- Physics package
42  #include "AIM_GRID.h"  #include "AIM_GRID.h"
43  #include "com_physvar.h"  #include "com_physvar.h"
44  #include "com_forcing.h"  #include "com_forcing.h"
45    #include "AIM2DYN.h"
46    
47  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
48  C     == Routine arguments ==  C     == Routine arguments ==
# Line 54  C     myThid    :: My Thread Id. number Line 55  C     myThid    :: My Thread Id. number
55  CEOP  CEOP
56    
57  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
58    C     !FUNCTIONS:
59    C     !LOCAL VARIABLES:
60    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
61    C--   Local Variables originally (Speedy) in common bloc (com_forcing.h):
62    C--   COMMON /FORFIX/ Time invariant forcing fields (initialise in INFORC)
63    C     phi0       :: surface geopotential
64          _RL     phi0   (NGP)
65    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66  C     == Local variables ==  C     == Local variables ==
67  C     bi,bj      :: Tile indices  C     bi,bj      :: Tile indices
68  C     i,j,k,I2   :: Loop counters  C     i,j,k,I2   :: Loop counters
# Line 67  C     prcAtm     :: total precip from th Line 76  C     prcAtm     :: total precip from th
76        _RL     aim_sWght0, aim_sWght1        _RL     aim_sWght0, aim_sWght1
77        _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
78    
79    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80    
81  #ifdef ALLOW_AIM_CO2  #ifdef ALLOW_AIM_CO2
82        CALL AIM_DO_CO2( myTime, myIter, myThid )        CALL AIM_DO_CO2( myTime, myIter, myThid )
83  #endif  #endif
# Line 77  C--   Start loops on tile indices Line 88  C--   Start loops on tile indices
88    
89  C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),  C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),
90  C      ==> move water wapor from the stratos to the surface level.  C      ==> move water wapor from the stratos to the surface level.
91        DO j = 1-Oly, sNy+Oly          DO j = 1-OLy, sNy+OLy
92         DO i = 1-Olx, sNx+Olx           DO i = 1-OLx, sNx+OLx
93          k = ksurfC(i,j,bi,bj)            k = kSurfC(i,j,bi,bj)
94          IF (k.LE.Nr)            IF (k.LE.Nr)
95       &    salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)       &    salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
96       &                      + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)       &                      + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)
97       &                  *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)       &                  *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)
98          salt(i,j,Nr,bi,bj) = 0.            salt(i,j,Nr,bi,bj) = 0.
99         ENDDO           ENDDO
100        ENDDO          ENDDO
101    
102    #ifdef OLD_THSICE_CALL_SEQUENCE
103  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
104        IF ( useThSIce ) THEN          IF ( useThSIce ) THEN
105  C-    do sea-ice advection before setting any surface BC.  C-    do sea-ice advection before setting any surface BC.
106          CALL THSICE_DO_ADVECT(            CALL THSICE_DO_ADVECT(
107       I                         bi, bj, myTime, myIter, myThid )       I                           bi, bj, myTime, myIter, myThid )
108        ENDIF          ENDIF
109  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
110    #endif /* OLD_THSICE_CALL_SEQUENCE */
111    
112  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
113    
114  C-    Physics package needs to know time of year as a fraction  C-    Physics package needs to know time of year as a fraction
115        yearLength = 86400.*360.          yearLength = 86400.*360.
116        tYear = MOD(myTime/yearLength, 1. _d 0)          tYear = MOD(myTime/yearLength, 1. _d 0)
117    
118  C--   Set surface Boundary Conditions for atmos. physics package:  C--   Set surface Boundary Conditions for atmos. physics package:
119  C     (Albedo, Soil moisture, Surf Temp, Land sea mask)  C     (Albedo, Soil moisture, Surf Temp, Land sea mask)
120  C     includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)  C     includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)
121        CALL AIM_SURF_BC(          CALL AIM_SURF_BC(
122       U                  tYear,       U                    tYear,
123       O                  aim_sWght0, aim_sWght1,       O                    aim_sWght0, aim_sWght1,
124       I                  bi, bj, myTime, myIter, myThid )       I                    bi, bj, myTime, myIter, myThid )
125    
126  C--   Set surface geopotential: (g * orographic height)  C--   Set surface geopotential: (g * orographic height)
127        DO j=1,sNy          DO j=1,sNy
128         DO i=1,sNx           DO i=1,sNx
129           I2 = i+(j-1)*sNx             I2 = i+(j-1)*sNx
130           PHI0(I2) = gravity*topoZ(i,j,bi,bj)             PHI0(I2) = gravity*topoZ(i,j,bi,bj)
131         ENDDO           ENDDO
132        ENDDO          ENDDO
133    
134  C--   Set topographic dependent FOROG var (originally in common SFLFIX);  C--   Set topographic dependent FOROG var (originally in common SFLFIX);
135  C      used to compute for wind stress over land  C      used to compute for wind stress over land
# Line 130  c_FM  CALL SOL_OZ (SOLC,TYEAR) Line 143  c_FM  CALL SOL_OZ (SOLC,TYEAR)
143  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
144    
145  C-    Compute atmospheric-physics tendencies (call the main AIM S/R)  C-    Compute atmospheric-physics tendencies (call the main AIM S/R)
146        CALL PHY_DRIVER( tYear, useDiagnostics,          CALL PHY_DRIVER( tYear, useDiagnostics,
147       I                  bi, bj, myTime, myIter, myThid )       I                    bi, bj, myTime, myIter, myThid )
148    
149        CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )          CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )
150    
151  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
152        IF (useLand) THEN          IF (useLand) THEN
153  C-    prepare Surface flux over land for land package  C-    prepare Surface flux over land for land package
154          CALL AIM_AIM2LAND( aim_landFr, bi, bj,            CALL AIM_AIM2LAND( aim_landFr, bi, bj,
155       I                     myTime, myIter, myThid )       I                       myTime, myIter, myThid )
156    
157  C-    Step forward land model  C-    Step forward land model
158          CALL LAND_STEPFWD( aim_landFr, bi, bj,            CALL LAND_STEPFWD( aim_landFr, bi, bj,
159       I                     myTime, myIter, myThid )       I                       myTime, myIter, myThid )
160    
161  C-    Land diagnostics : write snap-shot & cumulate for TimeAve output  C-    Land diagnostics : write snap-shot & cumulate for TimeAve output
162        CALL LAND_DO_DIAGS(  aim_landFr, bi, bj,            CALL LAND_DO_DIAGS( aim_landFr, bi, bj,
163       I                     myTime, myIter, myThid )       I                        myTime, myIter, myThid )
164    
165        ENDIF          ENDIF
166  #endif /* ALLOW_LAND */  #endif /* ALLOW_LAND */
167    
168  C-    surface fluxes over ocean (ice-free & ice covered)  C-    surface fluxes over ocean (ice-free & ice covered)
# Line 159  C       used for diagnostics, thsice pac Line 172  C       used for diagnostics, thsice pac
172       I                      bi, bj, myTime, myIter, myThid )       I                      bi, bj, myTime, myIter, myThid )
173    
174  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
175        IF ( useThSIce ) THEN          IF ( useThSIce ) THEN
   
176  C-    Step forward sea-ice model  C-    Step forward sea-ice model
177          CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,            CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
178       I                        prcAtm,       I                          prcAtm,
179       I                        myTime, myIter, myThid )       I                          myTime, myIter, myThid )
180            ENDIF
181    #endif /* ALLOW_THSICE */
182    
183  C-    Slab Ocean : step forward ocean mixed-layer temp. & salinity  C-    AIM diagnostics : write snap-shot & cumulate for TimeAve output
184          CALL THSICE_SLAB_OCEAN(          CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
      I                      aim_sWght0, aim_sWght1,  
      O                      dTsurf(1,2,myThid),  
      I                      bi, bj, myTime, myIter, myThid )  
185    
186          CALL THSICE_AVE(  C--   end bi,bj loops.
187       I                   bi, bj, myTime, myIter, myThid )         ENDDO
188          ENDDO
189    
190    #ifndef OLD_THSICE_CALL_SEQUENCE
191    #ifdef ALLOW_THSICE
192          IF ( useThSIce ) THEN
193    C--   Exchange fields that are advected by seaice dynamics
194            CALL THSICE_DO_EXCH( myThid )
195    C-    do sea-ice advection after sea-ice thermodynamics
196            CALL THSICE_DO_ADVECT(
197         I                         0, 0, myTime, myIter, myThid )
198        ENDIF        ENDIF
199  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
200    #endif /* ndef OLD_THSICE_CALL_SEQUENCE */
201    
202          DO bj=myByLo(myThid),myByHi(myThid)
203           DO bi=myBxLo(myThid),myBxHi(myThid)
204    
205    #ifdef ALLOW_THSICE
206            IF ( useThSIce ) THEN
207    C-    Slab Ocean : step forward ocean mixed-layer temp. & salinity
208              CALL THSICE_SLAB_OCEAN(
209         I                        aim_sWght0, aim_sWght1,
210         O                        dTsurf(1,2,myThid),
211         I                        bi, bj, myTime, myIter, myThid )
212              CALL THSICE_AVE(
213         I                     bi, bj, myTime, myIter, myThid )
214            ENDIF
215    #endif /* ALLOW_THSICE */
216    
217  #ifdef COMPONENT_MODULE  #ifdef COMPONENT_MODULE
218        IF ( useCoupler ) THEN          IF ( useCoupler ) THEN
219          CALL ATM_STORE_MY_DATA( bi, bj, myTime, myIter, myThid )            CALL ATM_STORE_MY_DATA( bi, bj, myTime, myIter, myThid )
220        ENDIF          ENDIF
221  #endif /* COMPONENT_MODULE */  #endif /* COMPONENT_MODULE */
222    
 C-    AIM diagnostics : write snap-shot & cumulate for TimeAve output  
       CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )  
   
223  C--   end bi,bj loops.  C--   end bi,bj loops.
224         ENDDO         ENDDO
225        ENDDO        ENDDO
226    
227    C--   do exchanges for AIM related quantities:
228          _EXCH_XY_RL( aim_drag, myThid )
229    
230    #ifdef OLD_THSICE_CALL_SEQUENCE
231    #ifdef ALLOW_THSICE
232          IF (useThSIce) THEN
233    C--   Exchange fields that are advected by seaice dynamics
234            CALL THSICE_DO_EXCH( myThid )
235          ENDIF
236    #endif
237    #endif /* OLD_THSICE_CALL_SEQUENCE */
238    
239    #ifdef COMPONENT_MODULE
240          IF ( useCoupler ) THEN
241           DO bj=myByLo(myThid),myByHi(myThid)
242            DO bi=myBxLo(myThid),myBxHi(myThid)
243              CALL ATM_STORE_TAUX( bi,bj, myTime, myIter, myThid )
244              CALL ATM_STORE_TAUY( bi,bj, myTime, myIter, myThid )
245            ENDDO
246           ENDDO
247          ENDIF
248    #endif /* COMPONENT_MODULE */
249    
250  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
251    
252        RETURN        RETURN
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22