/[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.3 by cnh, Tue May 29 19:28:53 2001 UTC
# Line 2  C     $Header$ Line 2  C     $Header$
2  C     $Name$  C     $Name$
3    
4  #include "AIM_OPTIONS.h"  #include "AIM_OPTIONS.h"
5    #undef OLD_AIM_GRIG_MAPPING
6    
7  CStartOfInterface  CStartOfInterface
8        SUBROUTINE AIM_EXTERNAL_FORCING_U(        SUBROUTINE AIM_EXTERNAL_FORCING_U(
# Line 11  C     /================================= Line 12  C     /=================================
12  C     | S/R AIM_EXTERNAL_FORCING_U                               |  C     | S/R AIM_EXTERNAL_FORCING_U                               |
13  C     | o Add AIM tendency terms to U tendency.                  |  C     | o Add AIM tendency terms to U tendency.                  |
14  C     \==========================================================/  C     \==========================================================/
15          IMPLICIT rEAL*8 (A-H,O-Z)
16    
17  C     == Global data ==  C     == Global data ==
18  #include "SIZE.h"  #include "SIZE.h"
# Line 20  C     == Global data == Line 22  C     == Global data ==
22  #include "DYNVARS.h"  #include "DYNVARS.h"
23    
24  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
25  #include "atparam0.h"  #include "AIM2DYN.h"
 #include "atparam1.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 44  CEndOfInterface Line 39  CEndOfInterface
39  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
40  C     == Local variables ==  C     == Local variables ==
41  C     Loop counters  C     Loop counters
42        INTEGER I, J        INTEGER i, j
       INTEGER I2, I3, kAtm  
43    
       DO J=1,sNy  
        DO I=1,sNx  
         I2 = sNx*(J-1)+I  
         I3 = sNx*(J-1)+mod(I+sNx-2,sNx)+1  
          Katm = _KD2KA( Klev )  
          gU(i,j,kLev,bi,bj) =  
      &   gU(i,j,kLev,bi,bj) + 0.5*(UT_PBL(I2,katm)+UT_PBL(I3,katm))  
        ENDDO  
       ENDDO  
44    
45        _EXCH_XYZ_R8( gU , myThid)  #ifdef OLD_AIM_GRIG_MAPPING
46    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
47    c - to reproduce old results :
48          IF (kLev.eq.1) THEN
49            DO j=jMin,jMax
50             DO i=iMin,iMax
51              IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
52               gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
53         &      -aim_drag(i-1,j,bi,bj)
54         &          *0.25*(uVel(i-1,j,kLev,bi,bj)+uVel(i,j,kLev,bi,bj))
55         &      -aim_drag(i,j,bi,bj)
56         &          *0.25*(uVel(i,j,kLev,bi,bj)+uVel(i+1,j,kLev,bi,bj))
57              ENDIF
58             ENDDO
59            ENDDO
60          ELSE
61            DO j=jMin,jMax
62             DO i=iMin,iMax
63              IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
64               gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
65         &      -(1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
66         &          *0.25*(uVel(i-1,j,kLev,bi,bj)+uVel(i,j,kLev,bi,bj))
67         &      -(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
68         &          *0.25*(uVel(i,j,kLev,bi,bj)+uVel(i+1,j,kLev,bi,bj))
69              ENDIF
70             ENDDO
71            ENDDO
72          ENDIF
73    #else  /* OLD_AIM_GRIG_MAPPING */
74    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75          IF (kLev.eq.1) THEN
76           DO j=jMin,jMax
77            DO i=iMin,iMax
78             IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
79              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
80         &     -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
81         &       * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
82             ENDIF
83            ENDDO
84           ENDDO
85          ELSE
86           DO j=jMin,jMax
87            DO i=iMin,iMax
88             IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
89              gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
90         &     -( (1.-maskC(i-1,j,kLev-1,bi,bj))
91         &         *aim_drag(i-1,j,bi,bj)*0.0
92         &       +(1.-maskC( i ,j,kLev-1,bi,bj))
93         &         *aim_drag( i ,j,bi,bj)*0.0
94         &      )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
95             ENDIF
96            ENDDO
97           ENDDO
98          ENDIF
99    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
100    #endif /* OLD_AIM_GRIG_MAPPING */
101    
102  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
103    
# Line 82  C     == Global data == Line 122  C     == Global data ==
122  #include "FFIELDS.h"  #include "FFIELDS.h"
123    
124  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
125  #include "atparam0.h"  #include "AIM2DYN.h"
 #include "atparam1.h"  
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
126  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
127    
128  C     == Routine arguments ==  C     == Routine arguments ==
# Line 106  CEndOfInterface Line 139  CEndOfInterface
139  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
140  C     == Local variables ==  C     == Local variables ==
141  C     Loop counters  C     Loop counters
142        INTEGER I, J        INTEGER i, j
       INTEGER I2, I3, JN, kAtm  
143    
144        DO J=1,sNy  C     call CHKSUM_TILED( ' drag AAA ',aim_drag,1,bi,bj,myThid )
        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  
145    
146        _EXCH_XYZ_R8( gV , myThid)  #ifdef OLD_AIM_GRIG_MAPPING
147    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
148    c - to reproduce old results :
149          IF (kLev.eq.1) THEN
150           DO j=jMin,jMax
151            DO i=iMin,iMax
152             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
153              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
154         &     -aim_drag(i,j-1,bi,bj)
155         &         *0.25*(vVel(i,j-1,kLev,bi,bj)+vVel(i,j,kLev,bi,bj))
156         &     -aim_drag(i,j,bi,bj)
157         &         *0.25*(vVel(i,j,kLev,bi,bj)+vVel(i,j+1,kLev,bi,bj))
158             ENDIF
159            ENDDO
160           ENDDO
161          ELSE
162           DO j=jMin,jMax
163            DO i=iMin,iMax
164             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
165              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
166         &     -(1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
167         &         *0.25*(vVel(i,j-1,kLev,bi,bj)+vVel(i,j,kLev,bi,bj))
168         &     -(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
169         &         *0.25*(vVel(i,j,kLev,bi,bj)+vVel(i,j+1,kLev,bi,bj))
170             ENDIF
171            ENDDO
172           ENDDO
173          ENDIF
174    #else  /* OLD_AIM_GRIG_MAPPING */
175    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
176          IF (kLev.eq.1) THEN
177           DO j=jMin,jMax
178            DO i=iMin,iMax
179             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
180              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
181         &     -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
182         &       * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
183             ENDIF
184            ENDDO
185           ENDDO
186          ELSE
187           DO j=jMin,jMax
188            DO i=iMin,iMax
189             IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
190              gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
191         &     -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
192         &       +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
193         &      )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
194             ENDIF
195            ENDDO
196           ENDDO
197          ENDIF
198    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
199    #endif /* OLD_AIM_GRIG_MAPPING */
200    
201  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
202    
# Line 135  C     /================================= Line 210  C     /=================================
210  C     | S/R AIM_EXTERNAL_FORCING_T                               |  C     | S/R AIM_EXTERNAL_FORCING_T                               |
211  C     | o Add AIM tendency to T                                  |  C     | o Add AIM tendency to T                                  |
212  C     \==========================================================/  C     \==========================================================/
213          IMPLICIT rEAL*8 (A-H,O-Z)
214    
215  C     == Global data ==  C     == Global data ==
216  #include "SIZE.h"  #include "SIZE.h"
# Line 152  C     == Global data == Line 228  C     == Global data ==
228        INTEGER NLEV        INTEGER NLEV
229        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
230  #include "com_physvar.h"  #include "com_physvar.h"
231    #include "AIM2DYN.h"
232  #endif  #endif
233    
234  C     == Routine arguments ==  C     == Routine arguments ==
# Line 168  CEndOfInterface Line 245  CEndOfInterface
245  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
246  C     == Local variables ==  C     == Local variables ==
247  C     Loop counters  C     Loop counters
248        INTEGER I, J        INTEGER I, J, I2, katm
249          _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
250    
251  C--   Forcing term  C--   Forcing term
       _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf  
252        _RL pGround        _RL pGround
253          _RL convert_fact
254    
255  C--   Forcing term  
256    C--   Forcing:
257    C-    AIM heating/cooling tendencies terms: Convert to Pot.Temp and Add to gT
258        pGround = 1. _d 5        pGround = 1. _d 5
259        RD      = 287. _d 0        RD      = 287. _d 0
260        CPAIR   = 1004. _d 0        CPAIR   = 1004. _d 0
261        DO J=1,sNy        katm = _KD2KA( Klev )
262         DO I=1,sNx        convert_fact = ((pGround/rC(kLev))**(RD/CPAIR))
263          I2 = sNx*(J-1)+I        DO J=1-OLy,sNy+OLy
264          katm = _KD2KA( Klev )         DO I=1-OLx,sNx+OLx
265          gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj) +(  C       I2 = sNx*(J-1)+I
266       &                           TT_PBL(I2,katm)  C       phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
267       &                          +TT_CNV(I2,katm)  C    &        +convert_fact*(
268       &                          +TT_LSC(I2,katm)  C    &                        TT_PBL(I2,katm)
269       &                          +TT_RSW(I2,katm)  C    &                       +TT_CNV(I2,katm)
270       &                          +TT_RLW(I2,katm)  C    &                       +TT_LSC(I2,katm)
271       &        )*((pGround/rC(kLev))**(RD/CPAIR))  C    &                       +TT_RSW(I2,katm)
272    C    &                       +TT_RLW(I2,katm)
273    C    &                       )
274            phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
275         &                      +aim_dTdt(i,j,kLev,bi,bj)
276         ENDDO         ENDDO
277        ENDDO        ENDDO
278    
279        _EXCH_XYZ_R8( gT , myThid)  C     This can't stay here
280    C     _EXCH_XY_R8( phiTemp , myThid)
281    
282          DO J=1-OLy,sNy+OLy
283           DO I=1-OLx,sNx+OLx
284            gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
285           ENDDO
286          ENDDO
287    
288  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
289    
# Line 206  C     /================================= Line 297  C     /=================================
297  C     | S/R AIM_EXTERNAL_FORCING_S                               |  C     | S/R AIM_EXTERNAL_FORCING_S                               |
298  C     | o Add AIM tendency to S.                                 |  C     | o Add AIM tendency to S.                                 |
299  C     \==========================================================/  C     \==========================================================/
300          IMPLICIT rEAL*8 (A-H,O-Z)
301    
302  C     == Global data ==  C     == Global data ==
303  #include "SIZE.h"  #include "SIZE.h"
# Line 223  C     == Global data == Line 315  C     == Global data ==
315        INTEGER NLEV        INTEGER NLEV
316        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
317  #include "com_physvar.h"  #include "com_physvar.h"
318    #include "AIM2DYN.h"
319  #endif  #endif
320    
321    
# Line 237  C     kLev Line 330  C     kLev
330        INTEGER myThid        INTEGER myThid
331  CEndOfInterface  CEndOfInterface
332    
333    
334  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
335  C     == Local variables ==  C     == Local variables ==
336  C     Loop counters  C     Loop counters
337        INTEGER I, J        INTEGER I, J, I2, katm
338          _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
339    
340        DO J=1,sNy        katm = _KD2KA( kLev )
341         DO I=1,sNx        DO J=1-OLy,sNy+OLy
342          katm = _KD2KA( kLev )         DO I=1-OLx,sNx+OLx
343          I2 = sNx*(J-1)+I          I2 = sNx*(J-1)+I
344              gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)  C       phiTemp(i,j,bi,bj) = gS(i,j,kLev,bi,bj)
345       &                       +QT_PBL(I2,katm)  C    &                       +QT_PBL(I2,katm)
346       &                       +QT_CNV(I2,katm)  C    &                       +QT_CNV(I2,katm)
347       &                       +QT_LSC(I2,katm)  C    &                       +QT_LSC(I2,katm)
348            phiTemp(I,J,bi,bj) = gS(i,j,kLev,bi,bj)
349         &                      +aim_dSdt(i,j,kLev,bi,bj)
350         ENDDO         ENDDO
351        ENDDO        ENDDO
352    
353        _EXCH_XYZ_R8( gS , myThid)  C     This can't stay here
354    C     _EXCH_XY_R8( phiTemp , myThid)
355    C     _EXCH_XYZ_R8( gS , myThid)
356    
357          DO J=1-OLy,sNy+OLy
358           DO I=1-OLx,sNx+OLx
359            gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
360           ENDDO
361          ENDDO
362    
363  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
364    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22