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

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

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

revision 1.7 by jmc, Mon Aug 27 18:45:47 2001 UTC revision 1.9 by jmc, Tue Jan 8 22:33:10 2002 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C     $Name$  C     $Name$
3    
4  #include "AIM_OPTIONS.h"  #include "AIM_OPTIONS.h"
 #undef OLD_AIM_GRIG_MAPPING  
5    
6        SUBROUTINE AIM_DO_ATMOS_PHYSICS( phi_hyd,        SUBROUTINE AIM_DO_ATMOS_PHYSICS( phi_hyd,
7       I                                 bi, bj,       I                                 bi, bj,
# Line 91  C     Katm          - Atmospheric K inde Line 90  C     Katm          - Atmospheric K inde
90        SAVE mnthNam        SAVE mnthNam
91        REAL    hInitial(Nr)        REAL    hInitial(Nr)
92        REAL    hInitialW(Nr)        REAL    hInitialW(Nr)
93        DATA    hInitial / 418.038,2038.54,5296.88,10090.02,17338.0/        DATA    hInitial / 17338.0,10090.02,5296.88,2038.54,418.038/
94        SAVE    hInitial        SAVE    hInitial
95        DATA    hInitialW / 0., 1657.54, 4087.75, 8050.96,15090.4 /        DATA    hInitialW / 15090.4, 8050.96, 4087.75, 1657.54, 0. /
96        REAL    pSurfs(Nr)        REAL    pSurfs(Nr)
97        DATA    pSurfs   / 950.D2,775.D2, 500.D2,  250.D2, 75.D2 /        DATA    pSurfs   / 75.D2, 250.D2, 500.D2, 775.D2, 950.D2 /
98        SAVE    pSurfs        SAVE    pSurfs
99        REAL    pSurfw(Nr)        REAL    pSurfw(Nr)
100        DATA    pSurfw   /1000.D2, 900.D2, 650.D2, 350.D2, 150.D2  /        DATA    pSurfw / 150.D2, 350.D2, 650.D2, 900.D2, 1000.D2 /
101        SAVE    pSurfw        SAVE    pSurfw
102        REAL    RD        REAL    RD
103        REAL    CPAIR        REAL    CPAIR
# Line 169  C     _GLOBAL_SUM_R8( phiTSum, myThid ) Line 168  C     _GLOBAL_SUM_R8( phiTSum, myThid )
168  C     ptotalniv5=phiTSum/phiTCount  C     ptotalniv5=phiTSum/phiTCount
169        ptotalniv5=0.        ptotalniv5=0.
170    
171    #ifndef OLD_AIM_INTERFACE
172  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),
173  c      ==> move water wapor from the stratos to the surface level.  c      ==> move water wapor from the stratos to the surface level.
174        DO J = 1-Oly, sNy+Oly        DO J = 1-Oly, sNy+Oly
175         DO I = 1-Olx, sNx+Olx         DO I = 1-Olx, sNx+Olx
176  c       k = k_surf(i,j,bi,bj)          k = ksurfC(i,j,bi,bj)
177  c       salt(I,J,k,bi,bj) = salt(I,J,k,bi,bj)          IF (k.LE.Nr)
178  c    &   + maskC(i,j,Nr,bi,bj)*salt(I,J,Nr,bi,bj)*drF(Nr)*recip_drF(k)       &    salt(I,J,k,bi,bj) = salt(I,J,k,bi,bj)
179         &                      + salt(I,J,Nr,bi,bj)*drF(Nr)*recip_drF(k)
180          salt(I,J,Nr,bi,bj) = 0.          salt(I,J,Nr,bi,bj) = 0.
181         ENDDO         ENDDO
182        ENDDO        ENDDO
183    #endif /* OLD_AIM_INTERFACE */
184    
185  C     Note the mapping here is only valid for one tile per proc.  C     Note the mapping here is only valid for one tile per proc.
186        DO K = 1, Nr        DO K = 1, Nr
# Line 186  C     Note the mapping here is only vali Line 188  C     Note the mapping here is only vali
188          DO I = 1, sNx          DO I = 1, sNx
189           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
190           Katm = _KD2KA( K )           Katm = _KD2KA( K )
191           UG1(I2,Katm,myThid)   =  C - to reproduce old results (coupled run, summer 2000) :
192       &    0.5*(uVel(I,J,K,bi,bj)+uVel(I+1,J,K,bi,bj))           UG1(I2,Katm,myThid)   = uVel(I,J,K,bi,bj)
193           VG1(I2,Katm,myThid)   =           VG1(I2,Katm,myThid)   = vVel(I,J,K,bi,bj)
      &    0.5*(vVel(I,J,K,bi,bj)+vVel(I,J+1,K,bi,bj))  
194  C        Physics works with temperature - not potential temp.  C        Physics works with temperature - not potential temp.
195           TG1(I2,Katm,myThid)   = theta(I,J,K,bi,bj)           TG1(I2,Katm,myThid)   = theta(I,J,K,bi,bj)
196       &                  / ((pGround/pSurfs(K))**(RD/CPAIR))       &                  / ((pGround/pSurfs(Katm))**(RD/CPAIR))
197  c_jmc    QG1(I2,Katm,myThid)   = salt(I,J,K,bi,bj)  #ifdef OLD_AIM_INTERFACE
198             QG1(I2,Katm,myThid)   = salt(I,J,K,bi,bj)
199    #else
200           QG1(I2,Katm,myThid)   = MAX(salt(I,J,K,bi,bj), 0. _d 0)           QG1(I2,Katm,myThid)   = MAX(salt(I,J,K,bi,bj), 0. _d 0)
201    #endif
202           PHIG1(I2,Katm,myThid) = (phiTotal(I,J,K)- ptotalniv5 )           PHIG1(I2,Katm,myThid) = (phiTotal(I,J,K)- ptotalniv5 )
203       &                  + gravity*Hinitial(k)       &                  + gravity*Hinitial(Katm)
204  C *NOTE* Fix me for lopped cells <== done !  C *NOTE* Fix me for lopped cells <== done !
205           IF (maskC(i,j,k,bi,bj).EQ.1.) THEN           IF (maskC(i,j,k,bi,bj).EQ.1.) THEN
206             RHOG1(I2,Katm) = pSurfs(K)/RD/TG1(I2,Katm,myThid)             RHOG1(I2,Katm) = pSurfs(Katm)/RD/TG1(I2,Katm,myThid)
207           ELSE           ELSE
208             RHOG1(I2,Katm)=0.             RHOG1(I2,Katm)=0.
209           ENDIF           ENDIF
# Line 212  c_jmc: add square of surface wind speed Line 216  c_jmc: add square of surface wind speed
216        DO J = 1, sNy        DO J = 1, sNy
217         DO I = 1, sNx         DO I = 1, sNx
218          I2 = I+(J-1)*sNx          I2 = I+(J-1)*sNx
219    #ifdef OLD_AIM_INTERFACE
220    C - to reproduce old results (coupled run, summer 2000) :
221             Vsurfsq(I2,myThid) = 0.
222            IF (NLEVxyU(I2,myThid).GT.0)
223         &   Vsurfsq(I2,myThid) = Vsurfsq(I2,myThid)
224         &    +UG1(I2,NLEVxyU(I2,myThid),myThid)
225         &    *UG1(I2,NLEVxyU(I2,myThid),myThid)
226            IF (NLEVxyV(I2,myThid).GT.0)
227         &   Vsurfsq(I2,myThid) = Vsurfsq(I2,myThid)
228         &    +VG1(I2,NLEVxyV(I2,myThid),myThid)
229         &    *VG1(I2,NLEVxyV(I2,myThid),myThid)
230    #else /* OLD_AIM_INTERFACE */
231          K = ksurfC(i,j,bi,bj)          K = ksurfC(i,j,bi,bj)
232          IF (K.LE.Nr) THEN          IF (K.LE.Nr) THEN
233           Vsurfsq(I2,myThid) = 0.5 * (           Vsurfsq(I2,myThid) = 0.5 * (
# Line 220  c_jmc: add square of surface wind speed Line 236  c_jmc: add square of surface wind speed
236       &               + vVel(I,J,K,bi,bj)*vVel(I,J,K,bi,bj)       &               + vVel(I,J,K,bi,bj)*vVel(I,J,K,bi,bj)
237       &               + vVel(I,J+1,K,bi,bj)*vVel(I,J+1,K,bi,bj)       &               + vVel(I,J+1,K,bi,bj)*vVel(I,J+1,K,bi,bj)
238       &                        )       &                        )
 #ifdef OLD_AIM_GRIG_MAPPING  
 c - to reproduce old results :  
          Katm = _KD2KA( K )  
          Vsurfsq(I2,myThid) =    
      &     UG1(I2,Katm,myThid)*UG1(I2,Katm,myThid)  
      &   + VG1(I2,Katm,myThid)*VG1(I2,Katm,myThid)  
 #endif /* OLD_AIM_GRIG_MAPPING */  
239          ELSE          ELSE
240           Vsurfsq(I2,myThid) = 0.           Vsurfsq(I2,myThid) = 0.
241          ENDIF          ENDIF
242    #endif /* OLD_AIM_INTERFACE */
243         ENDDO         ENDDO
244        ENDDO        ENDDO
245  c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 258  C     Get surface pressure from pbot-dpr Line 268  C     Get surface pressure from pbot-dpr
268           PNLEVW(I2,myThid) = PsurfW(Nlevxy(I2,myThid))/pGround           PNLEVW(I2,myThid) = PsurfW(Nlevxy(I2,myThid))/pGround
269          ELSE          ELSE
270  C        Dummy value for land  C        Dummy value for land
271           PNLEVW(I2,myThid) = PsurfW(1)/pGround           PNLEVW(I2,myThid) = PsurfW(Nr)/pGround
272          ENDIF          ENDIF
273          PSLG1(I2,myThid) = 0.          PSLG1(I2,myThid) = 0.
274         ENDDO         ENDDO
# Line 273  C     Physics package needs to know time Line 283  C     Physics package needs to know time
283    
284  C  C
285  C     Load external data needed by physics package  C     Load external data needed by physics package
286  C     1. Albedo  C     1. Albedo                (between 0-1)
287  C     2. Soil moisture  C     2. Soil moisture         (between 0-1)
288  C     3. Surface temperatures  C     3. Surface temperatures  (in situ Temp. [K])
289  C     4. Snow depth            - assume no snow for now  C     4. Snow depth            - assume no snow for now
290  C     5. Sea ice               - assume no sea ice for now  C     5. Sea ice               - assume no sea ice for now
291  C     6. Land sea mask         - infer from exact zeros in soil moisture dataset  C     6. Land sea mask         - infer from exact zeros in soil moisture dataset
# Line 300  C      ENDDO Line 310  C      ENDDO
310          DO I=1,sNx          DO I=1,sNx
311           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
312           alb0(I2,myThid) = 0.           alb0(I2,myThid) = 0.
313           alb0(I2,myThid) = aim_albedo(I,J,bi,bj)/100.  c        alb0(I2,myThid) = aim_albedo(I,J,bi,bj)/100.
314             alb0(I2,myThid) = aim_albedo(I,J,bi,bj)
315          ENDDO          ENDDO
316         ENDDO         ENDDO
317  C      Read in surface temperature data (input is in absolute temperature)  C      Read in surface temperature data (input is in absolute temperature)
# Line 330  cdj       tmp4 = (tmp4*7.5/20.)*10. Line 341  cdj       tmp4 = (tmp4*7.5/20.)*10.
341          DO I=1,sNx          DO I=1,sNx
342           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
343           soilq1(I2,myThid) = 0.           soilq1(I2,myThid) = 0.
344           soilq1(I2,myThid) = aim_soilMoisture(I,J,bi,bj)/20.  c        soilq1(I2,myThid) = aim_soilMoisture(I,J,bi,bj)/20.
345             soilq1(I2,myThid) = aim_soilMoisture(I,J,bi,bj)
346          ENDDO          ENDDO
347         ENDDO         ENDDO
348  C_cnh01      ENDIF  C_cnh01      ENDIF
# Line 355  C_cnh01      ENDIF Line 367  C_cnh01      ENDIF
367  C  C
368  C Addition may 15 . Reset humidity to 0. if negative  C Addition may 15 . Reset humidity to 0. if negative
369  C ---------------------------------------------------  C ---------------------------------------------------
370  Caja  DO K=1,Nr  #ifdef OLD_AIM_INTERFACE
371  Caja   DO J=1-OLy,sNy+OLy        DO K=1,Nr
372  Caja    DO I=1-Olx,sNx+OLx         DO J=1-OLy,sNy+OLy
373  Caja     IF ( salt(i,j,k,bi,bj) .LT. 0. .OR. K .EQ. Nr ) THEN          DO I=1-Olx,sNx+OLx
374  Caja      salt(i,j,k,bi,bj) = 0.           IF ( salt(i,j,k,bi,bj) .LT. 0. .OR. K .EQ. Nr ) THEN
375  Caja     ENDIF            salt(i,j,k,bi,bj) = 0.
376  Caja    ENDDO           ENDIF
377  Caja   ENDDO          ENDDO
378  Caja  ENDDO         ENDDO
379          ENDDO
380    #endif /* OLD_AIM_INTERFACE */
381    
382        CALL PDRIVER( tYear, myThid )        CALL PDRIVER( tYear, myThid )
383    
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22