/[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.5 by jmc, Tue Sep 25 19:53:57 2001 UTC revision 1.6 by jmc, Fri Sep 27 20:05:11 2002 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)        IMPLICIT NONE
15    
16  C     == Global data ==  C     == Global data ==
17  #include "SIZE.h"  #include "SIZE.h"
# Line 20  C     == Global data == Line 20  C     == Global data ==
20  #include "GRID.h"  #include "GRID.h"
21  #include "DYNVARS.h"  #include "DYNVARS.h"
22    
 #ifdef ALLOW_AIM  
23  #include "AIM2DYN.h"  #include "AIM2DYN.h"
24  #include "AIM_DIAGS.h"  #include "AIM_DIAGS.h"
 #endif /* ALLOW_AIM */  
25    
26  C     == Routine arguments ==  C     == Routine arguments ==
27  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
# Line 52  C - to reproduce old results (coupled ru Line 50  C - to reproduce old results (coupled ru
50          DO i=iMin,iMax          DO i=iMin,iMax
51            uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)            uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
52            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
53       &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + uStr_tmp*gravity*recip_drF(kLev)
54  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
55            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
56  #endif  #endif
# Line 69  C - to reproduce old results (coupled ru Line 67  C - to reproduce old results (coupled ru
67  C - put the same bug as in the old setup :  C - put the same bug as in the old setup :
68            IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) uStr_tmp = 0.            IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) uStr_tmp = 0.
69            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
70       &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + uStr_tmp*gravity*recip_drF(kLev)
71           ENDIF           ENDIF
72          ENDDO          ENDDO
73         ENDDO         ENDDO
# Line 84  c---+----1----+----2----+----3----+----4 Line 82  c---+----1----+----2----+----3----+----4
82       &     -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )       &     -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
83       &       * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)       &       * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
84            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
85       &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + uStr_tmp*gravity*recip_drF(kLev)
86    c    &                       * recip_hFacW(i,j,kLev,bi,bj)
87  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
88            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
89  #endif  #endif
# Line 100  c---+----1----+----2----+----3----+----4 Line 99  c---+----1----+----2----+----3----+----4
99       &        +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)       &        +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
100       &       )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)       &       )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
101            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)            gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
102       &                       + uStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + uStr_tmp*gravity*recip_drF(kLev)
103    c    &                       * recip_hFacW(i,j,kLev,bi,bj)
104  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
105            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT            USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
106  #endif  #endif
# Line 123  C     /================================= Line 123  C     /=================================
123  C     | S/R EXTERNAL_FORCING_V                                   |  C     | S/R EXTERNAL_FORCING_V                                   |
124  C     | o Add AIM tendency to meridional velocity.               |  C     | o Add AIM tendency to meridional velocity.               |
125  C     \==========================================================/  C     \==========================================================/
126        IMPLICIT rEAL*8 (A-H,O-Z)        IMPLICIT NONE
127    
128  C     == Global data ==  C     == Global data ==
129  #include "SIZE.h"  #include "SIZE.h"
# Line 132  C     == Global data == Line 132  C     == Global data ==
132  #include "GRID.h"  #include "GRID.h"
133  #include "DYNVARS.h"  #include "DYNVARS.h"
134    
 #ifdef ALLOW_AIM  
135  #include "AIM2DYN.h"  #include "AIM2DYN.h"
136  #include "AIM_DIAGS.h"  #include "AIM_DIAGS.h"
 #endif /* ALLOW_AIM */  
137    
138  C     == Routine arguments ==  C     == Routine arguments ==
139  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
# Line 166  C - to reproduce old results (coupled ru Line 164  C - to reproduce old results (coupled ru
164          DO i=iMin,iMax          DO i=iMin,iMax
165            vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)            vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
166            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
167       &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + vStr_tmp*gravity*recip_drF(kLev)
168  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
169            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
170  #endif  #endif
# Line 183  C - to reproduce old results (coupled ru Line 181  C - to reproduce old results (coupled ru
181  C - put the same bug as in the old setup :  C - put the same bug as in the old setup :
182            IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) vStr_tmp = 0.            IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) vStr_tmp = 0.
183            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
184       &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + vStr_tmp*gravity*recip_drF(kLev)
185           ENDIF           ENDIF
186          ENDDO          ENDDO
187         ENDDO         ENDDO
# Line 198  c---+----1----+----2----+----3----+----4 Line 196  c---+----1----+----2----+----3----+----4
196       &     -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )       &     -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
197       &       * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)       &       * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
198            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
199       &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + vStr_tmp*gravity*recip_drF(kLev)
200    c    &                       * recip_hFacS(i,j,kLev,bi,bj)
201  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
202            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
203  #endif  #endif
# Line 214  c---+----1----+----2----+----3----+----4 Line 213  c---+----1----+----2----+----3----+----4
213       &       +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)       &       +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
214       &      )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)       &      )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
215            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)            gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
216       &                       + vStr_tmp*horiVertRatio*recip_drF(kLev)       &                       + vStr_tmp*gravity*recip_drF(kLev)
217    c    &                       * recip_hFacS(i,j,kLev,bi,bj)
218  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
219            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT            VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
220  #endif  #endif
# Line 237  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)        IMPLICIT NONE
241    
242  C     == Global data ==  C     == Global data ==
243  #include "SIZE.h"  #include "SIZE.h"
# Line 246  C     == Global data == Line 246  C     == Global data ==
246  #include "GRID.h"  #include "GRID.h"
247  #include "DYNVARS.h"  #include "DYNVARS.h"
248    
 #ifdef ALLOW_AIM  
 #include "atparam0.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"  
249  #include "AIM2DYN.h"  #include "AIM2DYN.h"
 #endif  
250    
251  C     == Routine arguments ==  C     == Routine arguments ==
252  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
# Line 272  CEndOfInterface Line 262  CEndOfInterface
262  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
263  C     == Local variables ==  C     == Local variables ==
264  C     Loop counters  C     Loop counters
265        INTEGER I, J, I2, katm        INTEGER I, J
       _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)  
   
 C--   Forcing term  
       _RL pGround  
       _RL convert_fact  
   
   
 C--   Forcing:  
 C-    AIM heating/cooling tendencies terms: Convert to Pot.Temp and Add to gT  
       pGround = 1. _d 5  
       RD      = 287. _d 0  
       CPAIR   = 1004. _d 0  
       katm = _KD2KA( Klev )  
       convert_fact = ((pGround/rC(kLev))**(RD/CPAIR))  
       DO J=1-OLy,sNy+OLy  
        DO I=1-OLx,sNx+OLx  
 C       I2 = sNx*(J-1)+I  
 C       phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)  
 C    &        +convert_fact*(  
 C    &                        TT_PBL(I2,katm)  
 C    &                       +TT_CNV(I2,katm)  
 C    &                       +TT_LSC(I2,katm)  
 C    &                       +TT_RSW(I2,katm)  
 C    &                       +TT_RLW(I2,katm)  
 C    &                       )  
         phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)  
      &                      +aim_dTdt(i,j,kLev,bi,bj)  
        ENDDO  
       ENDDO  
   
 C     This can't stay here  
 C     _EXCH_XY_R8( phiTemp , myThid)  
266    
267        DO J=1-OLy,sNy+OLy  C--   Forcing: add AIM heating/cooling tendency to gT:
268         DO I=1-OLx,sNx+OLx        DO J=1,sNy
269          gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)         DO I=1,sNx
270            gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
271         &       *( gT(i,j,kLev,bi,bj) + aim_dTdt(i,j,kLev,bi,bj) )
272         ENDDO         ENDDO
273        ENDDO        ENDDO
274    
# Line 324  C     /================================= Line 284  C     /=================================
284  C     | S/R AIM_EXTERNAL_FORCING_S                               |  C     | S/R AIM_EXTERNAL_FORCING_S                               |
285  C     | o Add AIM tendency to S.                                 |  C     | o Add AIM tendency to S.                                 |
286  C     \==========================================================/  C     \==========================================================/
287        IMPLICIT rEAL*8 (A-H,O-Z)        IMPLICIT NONE
288    
289  C     == Global data ==  C     == Global data ==
290  #include "SIZE.h"  #include "SIZE.h"
# Line 333  C     == Global data == Line 293  C     == Global data ==
293  #include "GRID.h"  #include "GRID.h"
294  #include "DYNVARS.h"  #include "DYNVARS.h"
295    
 #ifdef ALLOW_AIM  
 #include "atparam0.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"  
296  #include "AIM2DYN.h"  #include "AIM2DYN.h"
 #endif  
   
297    
298  C     == Routine arguments ==  C     == Routine arguments ==
299  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
# Line 361  CEndOfInterface Line 310  CEndOfInterface
310  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
311  C     == Local variables ==  C     == Local variables ==
312  C     Loop counters  C     Loop counters
313        INTEGER I, J, I2, katm        INTEGER I, J
       _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)  
   
       katm = _KD2KA( kLev )  
       DO J=1-OLy,sNy+OLy  
        DO I=1-OLx,sNx+OLx  
         I2 = sNx*(J-1)+I  
 C       phiTemp(i,j,bi,bj) = gS(i,j,kLev,bi,bj)  
 C    &                       +QT_PBL(I2,katm)  
 C    &                       +QT_CNV(I2,katm)  
 C    &                       +QT_LSC(I2,katm)  
         phiTemp(I,J,bi,bj) = gS(i,j,kLev,bi,bj)  
      &                      +aim_dSdt(i,j,kLev,bi,bj)  
        ENDDO  
       ENDDO  
314    
315  C     This can't stay here  C--   Forcing: add AIM dq/dt tendency to gS:
316  C     _EXCH_XY_R8( phiTemp , myThid)        DO J=1,sNy
317  C     _EXCH_XYZ_R8( gS , myThid)         DO I=1,sNx
318            gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
319        DO J=1-OLy,sNy+OLy       &       *( gS(i,j,kLev,bi,bj) + aim_dSdt(i,j,kLev,bi,bj) )
        DO I=1-OLx,sNx+OLx  
         gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)  
320         ENDDO         ENDDO
321        ENDDO        ENDDO
322    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22