/[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.2 by adcroft, Fri Feb 2 21:36:29 2001 UTC revision 1.9 by jmc, Tue Jan 8 22:33:10 2002 UTC
# Line 3  C     $Name$ Line 3  C     $Name$
3    
4  #include "AIM_OPTIONS.h"  #include "AIM_OPTIONS.h"
5    
6        SUBROUTINE AIM_DO_ATMOS_PHYSICS( phi_hyd, currentTime, myThid )        SUBROUTINE AIM_DO_ATMOS_PHYSICS( phi_hyd,
7         I                                 bi, bj,
8         I                                 currentTime, myThid )
9  C     /==================================================================\  C     /==================================================================\
10  C     | S/R AIM_DO_ATMOS_PHYSICS                                         |  C     | S/R AIM_DO_ATMOS_PHYSICS                                         |
11  C     |==================================================================|  C     |==================================================================|
# Line 15  C     | which can be included as externa Line 17  C     | which can be included as externa
17  C     | tendency routines. Packages should communicate this information  |  C     | tendency routines. Packages should communicate this information  |
18  C     | through common blocks.                                           |  C     | through common blocks.                                           |
19  C     \==================================================================/  C     \==================================================================/
20          IMPLICIT rEAL*8 (A-H,O-Z)
21    
22  C     -------------- Global variables ------------------------------------  C     -------------- Global variables ------------------------------------
23  C     Physics package  C     Physics package
# Line 25  C     Physics package Line 28  C     Physics package
28        INTEGER NLAT        INTEGER NLAT
29        INTEGER NLEV        INTEGER NLEV
30        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )        PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
31  #include "com_physvar.h"  
 #include "com_forcing1.h"  
 #include "Lev_def.h"  
32  C     MITgcm  C     MITgcm
33  #include "EEPARAMS.h"  #include "EEPARAMS.h"
34  #include "PARAMS.h"  #include "PARAMS.h"
35  #include "DYNVARS.h"  #include "DYNVARS.h"
 #include "CG2D.h"  
36  #include "GRID.h"  #include "GRID.h"
37    #include "SURFACE.h"
38    #include "AIM_FFIELDS.h"
39    
40    C     Physics package
41    #include "com_physvar.h"
42    #include "com_forcing1.h"
43    #include "Lev_def.h"
44    
45  C     -------------- Routine arguments -----------------------------------  C     -------------- Routine arguments -----------------------------------
46        _RL phi_hyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL phi_hyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
47        _RL currentTime        _RL currentTime
48          INTEGER myThid
49          INTEGER bi, bj
50    
51  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
52  C     -------------- Local variables -------------------------------------  C     -------------- Local variables -------------------------------------
# Line 81  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 104  C     Katm          - Atmospheric K inde Line 113  C     Katm          - Atmospheric K inde
113        real pvoltotNiv5        real pvoltotNiv5
114        SAVE pvoltotNiv5        SAVE pvoltotNiv5
115        real ptotalNiv5        real ptotalNiv5
       INTEGER bi, bj  
116        INTEGER Katm        INTEGER Katm
117    
118  C  C
119        pGround = 1.D5        pGround = 1.D5
120        CPAIR   = 1004        CPAIR   = 1004
121        RD      =  287        RD      =  287
122    
123          CALL AIM_DYN2AIM( bi, bj, currentTime, myThid )
124    
125  C     Assume only one tile per proc. for now  C     Assume only one tile per proc. for now
126        bi  = 1        IG0 = myXGlobalLo+(bi-1)*sNx
127        bj  = 1        JG0 = myYGlobalLo+(bj-1)*sNy
       IG0 = myXGlobalLo  
       JG0 = myYGlobalLo  
128    
129  C        C      
130  C     Physics package works with sub-domains 1:sNx,1:sNy,1:Nr.  C     Physics package works with sub-domains 1:sNx,1:sNy,1:Nr.
# Line 132  C       the mean heave of the base of th Line 141  C       the mean heave of the base of th
141        DO K=1,Nr        DO K=1,Nr
142        DO J=1,sNy        DO J=1,sNy
143         DO I=1,sNx         DO I=1,sNx
144          phiTotal(I,J,K)  = cg2d_x(i,j,bi,bj)          phiTotal(I,J,K)  = etaN(i,j,bi,bj)
145          phiTCount        = phiTCount + hFacC(i,j,Nr,bi,bj)          phiTCount        = phiTCount + hFacC(i,j,Nr,bi,bj)
146         ENDDO         ENDDO
147        ENDDO        ENDDO
# Line 141  C       the mean heave of the base of th Line 150  C       the mean heave of the base of th
150         DO J=1,sNy         DO J=1,sNy
151          DO I=1,sNx          DO I=1,sNx
152           phiTotal(I,J,K) = phiTotal(I,J,K) +           phiTotal(I,J,K) = phiTotal(I,J,K) +
153       &   recip_rhoConst*(phi_hyd(i,j,k,bi,bj))       &   recip_rhoConst*(phi_hyd(i,j,k))
154          ENDDO          ENDDO
155         ENDDO         ENDDO
156        ENDDO        ENDDO
# Line 159  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  C     Note the mapping here is only valid for one tile  #ifndef OLD_AIM_INTERFACE
172  C     per proc.  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.
174          DO J = 1-Oly, sNy+Oly
175           DO I = 1-Olx, sNx+Olx
176            k = ksurfC(i,j,bi,bj)
177            IF (k.LE.Nr)
178         &    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.
181           ENDDO
182          ENDDO
183    #endif /* OLD_AIM_INTERFACE */
184    
185    C     Note the mapping here is only valid for one tile per proc.
186        DO K = 1, Nr        DO K = 1, Nr
187         DO J = 1, sNy         DO J = 1, sNy
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)   = 0.5*(uVel(I,J,K,bi,bj)+uVel(I+1,J,K,bi,bj))  C - to reproduce old results (coupled run, summer 2000) :
192           VG1(I2,Katm)   = 0.5*(vVel(I,J,K,bi,bj)+vVel(I,J+1,K,bi,bj))           UG1(I2,Katm,myThid)   = uVel(I,J,K,bi,bj)
193  C        Phyiscs works with temperature - not potential temp.           VG1(I2,Katm,myThid)   = vVel(I,J,K,bi,bj)
194           TG1(I2,Katm)   = theta(I,J,K,bi,bj)/((pGround/pSurfs(K))**(RD/CPAIR))  C        Physics works with temperature - not potential temp.
195           QG1(I2,Katm)   = salt(I,J,K,bi,bj)           TG1(I2,Katm,myThid)   = theta(I,J,K,bi,bj)
196           PHIG1(I2,Katm) = (phiTotal(I,J,K)- ptotalniv5 ) + gravity*Hinitial(k)       &                  / ((pGround/pSurfs(Katm))**(RD/CPAIR))
197           if(hFacC(i,j,k,bi,bj).eq.1.) then  #ifdef OLD_AIM_INTERFACE
198             RHOG1(I2,Katm) = pSurfs(K)/RD/TG1(I2,Katm)           QG1(I2,Katm,myThid)   = salt(I,J,K,bi,bj)
199           else  #else
200             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 )
203         &                  + gravity*Hinitial(Katm)
204    C *NOTE* Fix me for lopped cells <== done !
205             IF (maskC(i,j,k,bi,bj).EQ.1.) THEN
206               RHOG1(I2,Katm) = pSurfs(Katm)/RD/TG1(I2,Katm,myThid)
207             ELSE
208             RHOG1(I2,Katm)=0.             RHOG1(I2,Katm)=0.
209           endif           ENDIF
210          ENDDO          ENDDO
211         ENDDO         ENDDO
212        ENDDO        ENDDO
213    
214    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
215    c_jmc: add square of surface wind speed (center of C grid) = 2 * KE_surf
216          DO J = 1, sNy
217           DO I = 1, sNx
218            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)
232            IF (K.LE.Nr) THEN
233             Vsurfsq(I2,myThid) = 0.5 * (
234         &                 uVel(I,J,K,bi,bj)*uVel(I,J,K,bi,bj)
235         &               + uVel(I+1,J,K,bi,bj)*uVel(I+1,J,K,bi,bj)
236         &               + 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)
238         &                        )
239            ELSE
240             Vsurfsq(I2,myThid) = 0.
241            ENDIF
242    #endif /* OLD_AIM_INTERFACE */
243           ENDDO
244          ENDDO
245    c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
246    
247  C        C      
248  C     Set geopotential surfaces  C     Set geopotential surfaces
249  C     -------------------------  C     -------------------------
250        DO J=1,sNy        DO J=1,sNy
251         DO I=1,sNx         DO I=1,sNx
252          I2 = (sNx)*(J-1)+I          I2 = (sNx)*(J-1)+I
253          IF ( Nlevxy(I2) .NE. 0 ) THEN          IF ( Nlevxy(I2,myThid) .NE. 0 ) THEN
254           PHI0(I2) = gravity*Hinitialw(Nlevxy(I2))           PHI0(I2,myThid) = gravity*Hinitialw(Nlevxy(I2,myThid))
255          ELSE          ELSE
256           PHI0(I2) = 0.           PHI0(I2,myThid) = 0.
257          ENDIF          ENDIF
258         ENDDO         ENDDO
259        ENDDO        ENDDO
260    
261  C  C
262  C     Physics package works with log of surface pressure  C     Physics package works with log of surface pressure
263  C     Get surface pressure from pbot-dpref/dz*Z'  C     Get surface pressure from pbot-dpref/dz*Z'
264        DO J=1,sNy        DO J=1,sNy
265         DO I=1,sNx         DO I=1,sNx
266          I2 = (sNx)*(J-1)+I          I2 = (sNx)*(J-1)+I
267          IF ( Nlevxy(I2) .NE. 0 ) THEN          IF ( Nlevxy(I2,myThid) .NE. 0 ) THEN
268           PNLEVW(I2) = PsurfW(Nlevxy(I2))/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) = PsurfW(1)/pGround           PNLEVW(I2,myThid) = PsurfW(Nr)/pGround
272          ENDIF          ENDIF
273          PSLG1(I2) = 0.          PSLG1(I2,myThid) = 0.
274         ENDDO         ENDDO
275        ENDDO        ENDDO
276  cch      write(0,*)  '(PNLEVW(I2),I2=257,384)'  cch      write(0,*)  '(PNLEVW(I2),I2=257,384)'
# Line 216  C Line 280  C
280  C     Physics package needs to know time of year as a fraction  C     Physics package needs to know time of year as a fraction
281        tYear = currentTime/(86400.*360.) -        tYear = currentTime/(86400.*360.) -
282       &        FLOAT(INT(currentTime/(86400.*360.)))       &        FLOAT(INT(currentTime/(86400.*360.)))
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
292  C     7. Surface geopotential  - to be done when orography is in  C     7. Surface geopotential  - to be done when orography is in
293  C                                dynamical kernel. Assume 0. for now.  C                                dynamical kernel. Assume 0. for now.
294        mnthIndex = INT(tYear*12.)+1        mnthIndex = INT(tYear*12.)+1
295        IF ( mnthIndex .NE. prevMnthIndex .OR.  C_cnh01      IF ( mnthIndex .NE. prevMnthIndex .OR.
296       &     FirstCall ) THEN  C_cnh01     &     FirstCall ) THEN
297         prevMnthIndex = mnthIndex  C_cnh01       prevMnthIndex = mnthIndex
298  C      Read in surface albedo data (input is in % 0-100 )  C      Read in surface albedo data (input is in % 0-100 )
299  C      scale to give fraction between 0-1 for Francos package.  C      scale to give fraction between 0-1 for Francos package.
300  CequChan       WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.sun.b'  C      WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.sun.b'
301  CequChan       OPEN(1,FILE=fNam(1:14),STATUS='old',FORM='unformatted')  C      OPEN(1,FILE=fNam(1:14),STATUS='old',FORM='unformatted')
302  CequChan       READ(1) tmp4  C      READ(1) tmp4
303  CequChan       CLOSE(1)  C      CLOSE(1)
304  CequChan       DO J=1,nYio  C      DO J=1,nYio
305  CequChan        DO I=1,nXio  C       DO I=1,nXio
306  CequChan         tmp4(I,J) = tmp4(I,J)/100.  C        tmp4(I,J) = aim_albedo(I,J)/100.
307  CequChan        ENDDO  C       ENDDO
308  CequChan       ENDDO  C      ENDDO
309         DO J=1,sNy         DO J=1,sNy
310          DO I=1,sNx          DO I=1,sNx
311           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
312           alb0(I2) = 0.           alb0(I2,myThid) = 0.
313  CequChan         IF ( IG0+I-1 .LE. nxIo .AND. JG0+J-1 .LE. nyIo ) THEN  c        alb0(I2,myThid) = aim_albedo(I,J,bi,bj)/100.
314  CequChan          alb0(I2) = tmp4(IG0+I-1,JG0+J-1)           alb0(I2,myThid) = aim_albedo(I,J,bi,bj)
 CequChan         ENDIF  
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)
318  CequChan       WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.sun.b'  C      WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.sun.b'
319  CequChan       OPEN(1,FILE=fNam(1:15),STATUS='old',FORM='unformatted')  C      OPEN(1,FILE=fNam(1:15),STATUS='old',FORM='unformatted')
320  CequChan       READ(1) tmp4  C      READ(1) tmp4
321  CequChan       CLOSE(1)  C      CLOSE(1)
322         DO J=1,sNy         DO J=1,sNy
323          DO I=1,sNx          DO I=1,sNx
324           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
325           sst1(I2) = 300.           sst1(I2,myThid) = 300.
326           stl1(I2) = 300.           stl1(I2,myThid) = 300.
327  CequChan         IF ( IG0+I-1 .LE. nxIo .AND. JG0+J-1 .LE. nyIo ) THEN           sst1(I2,myThid) = aim_surfTemp(I,J,bi,bj)
328  CequChan          sst1(I2) = tmp4(IG0+I-1,JG0+J-1)           stl1(I2,myThid) = aim_surfTemp(I,J,bi,bj)
 CequChan          stl1(I2) = tmp4(IG0+I-1,JG0+J-1)  
 CequChan         ENDIF  
 caja     IF ( I .GE. 64-10 .AND. I .LE. 65+10 ) THEN  
 caja      sst1(I2) = 310.  
 caja      stl1(I2) = 310.  
 caja     ENDIF  
 caja     IF ( I .GE. 64-10 .AND. I .LE. 65+10 ) THEN  
 caja      sst1(I2) = 300.+10.*exp( -((float(I)-64.5)/5.)**2 )  
 caja      stl1(I2) = sst1(I2)  
 caja     ENDIF  
 c_jmc: should not be part of the AIM package :  
          sst1(I2) = 300.+10.*exp( -((float(I)-64.5)/25.)**2 )  
          stl1(I2) = sst1(I2)  
329          ENDDO          ENDDO
330         ENDDO         ENDDO
331  C  C
332  C      Read in soil moisture data (input is in cm in bucket of depth 20cm. )  C      Read in soil moisture data (input is in cm in bucket of depth 20cm. )
333  C??? NOT CLEAR  scale for bucket depth of 75mm which is what Franco uses.  C??? NOT CLEAR  scale for bucket depth of 75mm which is what Franco uses.
334  CequChan       WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.sun.b'  C      WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.sun.b'
335  CequChan       OPEN(1,FILE=fNam(1:16),STATUS='old',FORM='unformatted')  C      OPEN(1,FILE=fNam(1:16),STATUS='old',FORM='unformatted')
336  CequChan       READ(1) tmp4  C      READ(1) tmp4
337  CequChan       CLOSE(1)  C      CLOSE(1)
338  CequChan       WRITE(0,*) ' Read file ', fNam(1:16), IG0, JG0  C      WRITE(0,*) ' Read file ', fNam(1:16), IG0, JG0
339  cdj       tmp4 = (tmp4*7.5/20.)*10.  cdj       tmp4 = (tmp4*7.5/20.)*10.
340         DO J=1,sNy         DO J=1,sNy
341          DO I=1,sNx          DO I=1,sNx
342           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
343           soilq1(I2) = 0.           soilq1(I2,myThid) = 0.
344  CequChan         IF ( IG0+I-1 .LE. nxIo .AND. JG0+J-1 .LE. nyIo ) THEN  c        soilq1(I2,myThid) = aim_soilMoisture(I,J,bi,bj)/20.
345  CequChan          soilq1(I2) = tmp4(IG0+I-1,JG0+J-1)           soilq1(I2,myThid) = aim_soilMoisture(I,J,bi,bj)
 CequChan         ENDIF  
346          ENDDO          ENDDO
347         ENDDO         ENDDO
348  cdj      Soilqmax=MAxval(soilq1)  C_cnh01      ENDIF
        Soilqmax=20.  
 cdj      if(Soilqmax.ne.0.) then  
        DO J=1,sNy  
         DO I=1,sNx  
          I2 = (sNx)*(J-1)+I  
 CequChan         soilq1(I2)=soilq1(I2)/Soilqmax  
          soilq1(I2) = 1.  
         ENDDO  
        ENDDO  
 cdj      endif  
       ENDIF  
349  C  C
350        IF ( FirstCall ) THEN  C_cnh01      IF ( FirstCall ) THEN
351  C      Set snow depth, sea ice to zero for now  C      Set snow depth, sea ice to zero for now
352  C      Land-sea mask ( figure this out from where soil moisture is exactly zero ).  C      Land-sea mask ( figure this out from where
353    C                      soil moisture is exactly zero ).
354         DO J=1,sNy         DO J=1,sNy
355          DO I=1,sNx          DO I=1,sNx
356           I2 = (sNx)*(J-1)+I           I2 = (sNx)*(J-1)+I
357           fMask1(I2) = 1.           fMask1(I2,myThid) = 1.
358           IF ( soilq1(I2) .EQ. 0. ) fMask1(I2) = 0.           IF ( soilq1(I2,myThid) .EQ. 0. ) fMask1(I2,myThid) = 0.
359           oice1(I2) = 0.           oice1(I2,myThid) = 0.
360           snow1(I2) = 0.           snow1(I2,myThid) = 0.
361          ENDDO          ENDDO
362         ENDDO         ENDDO
363  C      open(77,file='lsmask',form='unformatted')  C      open(77,file='lsmask',form='unformatted')
364  C      write(77) fmask1  C      write(77) fmask1
365  C      close(77)  C      close(77)
366        ENDIF  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    #ifdef OLD_AIM_INTERFACE
371        DO K=1,Nr        DO K=1,Nr
372         DO J=1-OLy,sNy+OLy         DO J=1-OLy,sNy+OLy
373          DO I=1-Olx,sNx+OLx          DO I=1-Olx,sNx+OLx
# Line 336  C -------------------------------------- Line 377  C --------------------------------------
377          ENDDO          ENDDO
378         ENDDO         ENDDO
379        ENDDO        ENDDO
380  C  #endif /* OLD_AIM_INTERFACE */
       CALL PDRIVER( tYear )  
381    
382  #ifdef INCLUDE_DIAGNOSTICS_INTERFACE_CODE        CALL PDRIVER( tYear, myThid )
383    
384    #ifdef ALLOW_TIMEAVE
385  C     Calculate diagnostics for AIM  C     Calculate diagnostics for AIM
386        CALL AIM_CALC_DIAGS( bi, bj, currentTime, myThid )        CALL AIM_CALC_DIAGS( bi, bj, currentTime, myThid )
387  #endif /* INCLUDE_DIAGNOSTICS_INTERFACE_CODE */  #endif /* ALLOW_TIMEAVE */
388  C  C
389        FirstCall = .FALSE.        FirstCall = .FALSE.
390    
391          CALL AIM_AIM2DYN( bi, bj, currentTime, myThid )
392  C  C
393  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
394    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22