/[MITgcm]/MITgcm/pkg/aim/aim_external_forcing.F
ViewVC logotype

Diff of /MITgcm/pkg/aim/aim_external_forcing.F

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

revision 1.2 by adcroft, Fri Feb 2 21:36:29 2001 UTC revision 1.5 by jmc, Tue Sep 25 19:53:57 2001 UTC
# Line 11  C     /================================= Line 11  C     /=================================
11  C     | S/R AIM_EXTERNAL_FORCING_U                               |  C     | S/R AIM_EXTERNAL_FORCING_U                               |
12  C     | o Add AIM tendency terms to U tendency.                  |  C     | o Add AIM tendency terms to U tendency.                  |
13  C     \==========================================================/  C     \==========================================================/
14          IMPLICIT rEAL*8 (A-H,O-Z)
15    
16  C     == Global data ==  C     == Global data ==
17  #include "SIZE.h"  #include "SIZE.h"
# Line 20  C     == Global data == Line 21  C     == Global data ==
21  #include "DYNVARS.h"  #include "DYNVARS.h"
22    
23  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
24  #include "atparam0.h"  #include "AIM2DYN.h"
25  #include "atparam1.h"  #include "AIM_DIAGS.h"
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
26  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
27    
28  C     == Routine arguments ==  C     == Routine arguments ==
# Line 43  CEndOfInterface Line 38  CEndOfInterface
38    
39  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
40  C     == Local variables ==  C     == Local variables ==
41  C     Loop counters  C     i,j  - Loop counters
42        INTEGER I, J        INTEGER i, j
43        INTEGER I2, I3, kAtm        _RL DDTT, uStr_tmp
44    
45        DO J=1,sNy        DDTT = deltaTclock
46         DO I=1,sNx  
47          I2 = sNx*(J-1)+I  #ifdef OLD_AIM_INTERFACE
48          I3 = sNx*(J-1)+mod(I+sNx-2,sNx)+1  c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49           Katm = _KD2KA( Klev )  C - to reproduce old results (coupled run, summer 2000) :
50           gU(i,j,kLev,bi,bj) =        IF (kLev.eq.1) THEN
51       &   gU(i,j,kLev,bi,bj) + 0.5*(UT_PBL(I2,katm)+UT_PBL(I3,katm))         DO j=jMin,jMax
52            DO i=iMin,iMax
53              uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
54              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
55         &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)
56    #ifdef ALLOW_TIMEAVE
57              USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
58    #endif
59            ENDDO
60         ENDDO         ENDDO
61        ENDDO        ELSE
62           DO j=jMin,jMax
63        _EXCH_XYZ_R8( gU , myThid)          DO i=iMin,iMax
64             IF ( maskW(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
65              uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
66    #ifdef ALLOW_TIMEAVE
67              USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
68    #endif
69    C - put the same bug as in the old setup :
70              IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) uStr_tmp = 0.
71              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
72         &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)
73             ENDIF
74            ENDDO
75           ENDDO
76          ENDIF
77    #else  /* OLD_AIM_INTERFACE */
78    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
79          IF (kLev.eq.1) THEN
80           DO j=jMin,jMax
81            DO i=iMin,iMax
82             IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
83              uStr_tmp =
84         &     -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
85         &       * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
86              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
87         &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)
88    #ifdef ALLOW_TIMEAVE
89              USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
90    #endif
91             ENDIF
92            ENDDO
93           ENDDO
94          ELSE
95           DO j=jMin,jMax
96            DO i=iMin,iMax
97             IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
98              uStr_tmp =
99         &      -( (1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
100         &        +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
101         &       )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
102              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
103         &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)
104    #ifdef ALLOW_TIMEAVE
105              USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
106    #endif
107             ENDIF
108            ENDDO
109           ENDDO
110          ENDIF
111    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
112    #endif /* OLD_AIM_INTERFACE */
113    
114  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
115    
# Line 79  C     == Global data == Line 131  C     == Global data ==
131  #include "PARAMS.h"  #include "PARAMS.h"
132  #include "GRID.h"  #include "GRID.h"
133  #include "DYNVARS.h"  #include "DYNVARS.h"
 #include "FFIELDS.h"  
134    
135  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
136  #include "atparam0.h"  #include "AIM2DYN.h"
137  #include "atparam1.h"  #include "AIM_DIAGS.h"
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
138  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
139    
140  C     == Routine arguments ==  C     == Routine arguments ==
# Line 106  CEndOfInterface Line 151  CEndOfInterface
151  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
152  C     == Local variables ==  C     == Local variables ==
153  C     Loop counters  C     Loop counters
154        INTEGER I, J        INTEGER i, j
155        INTEGER I2, I3, JN, kAtm        _RL DDTT, vStr_tmp
156    
157        DO J=1,sNy        DDTT = deltaTclock
        DO I=1,sNx  
         I2 = sNx*(J-1)+I  
         JN = J  
         IF ( JN .EQ. sNy ) JN = sNy-1  
         I3 = sNx*(JN )+I  
          Katm = _KD2KA( Klev )  
          gV(i,j,kLev,bi,bj) =  
      &   gV(i,j,kLev,bi,bj) + 0.5*(VT_PBL(I2,katm)+VT_PBL(I3,katm))  
        ENDDO  
       ENDDO  
158    
159        _EXCH_XYZ_R8( gV , myThid)  C     call CHKSUM_TILED( ' drag AAA ',aim_drag,1,bi,bj,myThid )
160    
161    #ifdef OLD_AIM_INTERFACE
162    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
163    C - to reproduce old results (coupled run, summer 2000) :
164          IF (kLev.eq.1) THEN
165           DO j=jMin,jMax
166            DO i=iMin,iMax
167              vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
168              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
169         &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)
170    #ifdef ALLOW_TIMEAVE
171              VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
172    #endif
173            ENDDO
174           ENDDO
175          ELSE
176           DO j=jMin,jMax
177            DO i=iMin,iMax
178             IF ( maskS(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
179              vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
180    #ifdef ALLOW_TIMEAVE
181              VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
182    #endif
183    C - put the same bug as in the old setup :
184              IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) vStr_tmp = 0.
185              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
186         &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)
187             ENDIF
188            ENDDO
189           ENDDO
190          ENDIF
191    #else  /* OLD_AIM_INTERFACE */
192    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
193          IF (kLev.eq.1) THEN
194           DO j=jMin,jMax
195            DO i=iMin,iMax
196             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
197              vStr_tmp =
198         &     -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
199         &       * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
200              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
201         &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)
202    #ifdef ALLOW_TIMEAVE
203              VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
204    #endif
205             ENDIF
206            ENDDO
207           ENDDO
208          ELSE
209           DO j=jMin,jMax
210            DO i=iMin,iMax
211             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
212              vStr_tmp =
213         &     -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
214         &       +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
215         &      )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
216              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
217         &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)
218    #ifdef ALLOW_TIMEAVE
219              VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
220    #endif
221             ENDIF
222            ENDDO
223           ENDDO
224          ENDIF
225    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
226    #endif /* OLD_AIM_INTERFACE */
227    
228  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
229    
# Line 135  C     /================================= Line 237  C     /=================================
237  C     | S/R AIM_EXTERNAL_FORCING_T                               |  C     | S/R AIM_EXTERNAL_FORCING_T                               |
238  C     | o Add AIM tendency to T                                  |  C     | o Add AIM tendency to T                                  |
239  C     \==========================================================/  C     \==========================================================/
240          IMPLICIT rEAL*8 (A-H,O-Z)
241    
242  C     == Global data ==  C     == Global data ==
243  #include "SIZE.h"  #include "SIZE.h"
# Line 152  C     == Global data == Line 255  C     == Global data ==
255        INTEGER NLEV        INTEGER NLEV
256        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
257  #include "com_physvar.h"  #include "com_physvar.h"
258    #include "AIM2DYN.h"
259  #endif  #endif
260    
261  C     == Routine arguments ==  C     == Routine arguments ==
# Line 168  CEndOfInterface Line 272  CEndOfInterface
272  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
273  C     == Local variables ==  C     == Local variables ==
274  C     Loop counters  C     Loop counters
275        INTEGER I, J        INTEGER I, J, I2, katm
276          _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
277    
278  C--   Forcing term  C--   Forcing term
       _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf  
279        _RL pGround        _RL pGround
280          _RL convert_fact
281    
282  C--   Forcing term  
283    C--   Forcing:
284    C-    AIM heating/cooling tendencies terms: Convert to Pot.Temp and Add to gT
285        pGround = 1. _d 5        pGround = 1. _d 5
286        RD      = 287. _d 0        RD      = 287. _d 0
287        CPAIR   = 1004. _d 0        CPAIR   = 1004. _d 0
288        DO J=1,sNy        katm = _KD2KA( Klev )
289         DO I=1,sNx        convert_fact = ((pGround/rC(kLev))**(RD/CPAIR))
290          I2 = sNx*(J-1)+I        DO J=1-OLy,sNy+OLy
291          katm = _KD2KA( Klev )         DO I=1-OLx,sNx+OLx
292          gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj) +(  C       I2 = sNx*(J-1)+I
293       &                           TT_PBL(I2,katm)  C       phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
294       &                          +TT_CNV(I2,katm)  C    &        +convert_fact*(
295       &                          +TT_LSC(I2,katm)  C    &                        TT_PBL(I2,katm)
296       &                          +TT_RSW(I2,katm)  C    &                       +TT_CNV(I2,katm)
297       &                          +TT_RLW(I2,katm)  C    &                       +TT_LSC(I2,katm)
298       &        )*((pGround/rC(kLev))**(RD/CPAIR))  C    &                       +TT_RSW(I2,katm)
299    C    &                       +TT_RLW(I2,katm)
300    C    &                       )
301            phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
302         &                      +aim_dTdt(i,j,kLev,bi,bj)
303         ENDDO         ENDDO
304        ENDDO        ENDDO
305    
306        _EXCH_XYZ_R8( gT , myThid)  C     This can't stay here
307    C     _EXCH_XY_R8( phiTemp , myThid)
308    
309          DO J=1-OLy,sNy+OLy
310           DO I=1-OLx,sNx+OLx
311            gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
312           ENDDO
313          ENDDO
314    
315  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
316    
# Line 206  C     /================================= Line 324  C     /=================================
324  C     | S/R AIM_EXTERNAL_FORCING_S                               |  C     | S/R AIM_EXTERNAL_FORCING_S                               |
325  C     | o Add AIM tendency to S.                                 |  C     | o Add AIM tendency to S.                                 |
326  C     \==========================================================/  C     \==========================================================/
327          IMPLICIT rEAL*8 (A-H,O-Z)
328    
329  C     == Global data ==  C     == Global data ==
330  #include "SIZE.h"  #include "SIZE.h"
# Line 223  C     == Global data == Line 342  C     == Global data ==
342        INTEGER NLEV        INTEGER NLEV
343        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
344  #include "com_physvar.h"  #include "com_physvar.h"
345    #include "AIM2DYN.h"
346  #endif  #endif
347    
348    
# Line 237  C     kLev Line 357  C     kLev
357        INTEGER myThid        INTEGER myThid
358  CEndOfInterface  CEndOfInterface
359    
360    
361  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
362  C     == Local variables ==  C     == Local variables ==
363  C     Loop counters  C     Loop counters
364        INTEGER I, J        INTEGER I, J, I2, katm
365          _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
366    
367        DO J=1,sNy        katm = _KD2KA( kLev )
368         DO I=1,sNx        DO J=1-OLy,sNy+OLy
369          katm = _KD2KA( kLev )         DO I=1-OLx,sNx+OLx
370          I2 = sNx*(J-1)+I          I2 = sNx*(J-1)+I
371              gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)  C       phiTemp(i,j,bi,bj) = gS(i,j,kLev,bi,bj)
372       &                       +QT_PBL(I2,katm)  C    &                       +QT_PBL(I2,katm)
373       &                       +QT_CNV(I2,katm)  C    &                       +QT_CNV(I2,katm)
374       &                       +QT_LSC(I2,katm)  C    &                       +QT_LSC(I2,katm)
375            phiTemp(I,J,bi,bj) = gS(i,j,kLev,bi,bj)
376         &                      +aim_dSdt(i,j,kLev,bi,bj)
377         ENDDO         ENDDO
378        ENDDO        ENDDO
379    
380        _EXCH_XYZ_R8( gS , myThid)  C     This can't stay here
381    C     _EXCH_XY_R8( phiTemp , myThid)
382    C     _EXCH_XYZ_R8( gS , myThid)
383    
384          DO J=1-OLy,sNy+OLy
385           DO I=1-OLx,sNx+OLx
386            gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
387           ENDDO
388          ENDDO
389    
390  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
391    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22