/[MITgcm]/MITgcm/pkg/ebm/ebm_atmosphere.F
ViewVC logotype

Diff of /MITgcm/pkg/ebm/ebm_atmosphere.F

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

revision 1.1 by heimbach, Fri May 14 21:10:34 2004 UTC revision 1.2 by heimbach, Wed May 19 20:38:53 2004 UTC
# Line 47  CEndOfInterface Line 47  CEndOfInterface
47    
48  C     == Local variables ==  C     == Local variables ==
49        _RL Dy        _RL Dy
50        _RL ReCountX(1-OLy:sNy+OLy)        _RL ReCountX(1-OLy:sNy+OLy,nSy)
51        INTEGER bi, bj        INTEGER bi, bj
52        INTEGER i, j        INTEGER i, j
53        INTEGER no_so        INTEGER no_so
# Line 61  cph      IF ( TOP_LAYER ) THEN Line 61  cph      IF ( TOP_LAYER ) THEN
61        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
62         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
63    
64          DO j=1-OLy,sNy+OLy          DO j=1,sNy
65           S(j) = 0.0           S(j,bj) = 0.0
66           P2(j) = 0.0           P2(j,bj) = 0.0
67           P4(j) = 0.0           P4(j,bj) = 0.0
68           SW(j) = 0.0           SW(j,bj) = 0.0
69           LW(j) = 0.0           LW(j,bj) = 0.0
70           Hd(j) = 0.0           Hd(j,bj) = 0.0
71           Fw(j) = 0.0           Fw(j,bj) = 0.0
72           T(j) = 0.0           T(j,bj) = 0.0
73           ReCountX(j) = 0.0           ReCountX(j,bj) = 0.0
74          ENDDO          ENDDO
75    
76          print *, 'SH', TmlS-t_mlt, TtS-t_mlt          print *, 'SH', TmlS-t_mlt, TtS-t_mlt
# Line 78  cph      IF ( TOP_LAYER ) THEN Line 78  cph      IF ( TOP_LAYER ) THEN
78    
79  C--   account for ice (can absorb heat on an annual averaged basis)  C--   account for ice (can absorb heat on an annual averaged basis)
80  C--   Greenland in Northern Hemisphere, Antarctica in Southern  C--   Greenland in Northern Hemisphere, Antarctica in Southern
81          DO j = 1-OLy,sNy+OLy          DO j = 1,sNy
82           ReCountX(j) = CountX(j)           ReCountX(j,bj) = CountX(j,bj)
83           IF (yC(1,j,bi,bj) .LE. -62.0) THEN           IF (yC(1,j,bi,bj) .LE. -62.0) THEN
84              ReCountX(j) = 90.              ReCountX(j,bj) = 90.
85           ELSE IF (yC(1,j,bi,bj) .EQ. 74.0) THEN           ELSE IF (yC(1,j,bi,bj) .EQ. 74.0) THEN
86              ReCountX(j) = CountX(j) + 9.0              ReCountX(j,bj) = CountX(j,bj) + 9.0
87           ELSE IF (yC(1,j,bi,bj) .EQ. 70.0) THEN           ELSE IF (yC(1,j,bi,bj) .EQ. 70.0) THEN
88              ReCountX(j) = CountX(j) + 8.0              ReCountX(j,bj) = CountX(j,bj) + 8.0
89           ELSE IF (yC(1,j,bi,bj) .EQ. 66.0) THEN           ELSE IF (yC(1,j,bi,bj) .EQ. 66.0) THEN
90              ReCountX(j) = CountX(j) + 5.0              ReCountX(j,bj) = CountX(j,bj) + 5.0
91           ELSE IF (yC(1,j,bi,bj) .EQ. 62.0) THEN           ELSE IF (yC(1,j,bi,bj) .EQ. 62.0) THEN
92              ReCountX(j) = CountX(j) + 1.0              ReCountX(j,bj) = CountX(j,bj) + 1.0
93           ENDIF           ENDIF
94          ENDDO          ENDDO
95                    
# Line 167  c======================================= Line 167  c=======================================
167  c     Calculation of latitudinal profiles  c     Calculation of latitudinal profiles
168  c======================================================  c======================================================
169  c    c  
170          DO j=1-OLy,sNy+OLy          DO j=1,sNy
171           DO i=1-Olx,sNx+Olx           DO i=1,sNx
172    
173            IF (yC(i,j,bi,bj) .LT. 0.) THEN            IF (yC(i,j,bi,bj) .LT. 0.) THEN
174               no_so = 1               no_so = 1
# Line 176  c Line 176  c
176               no_so = 2               no_so = 2
177            ENDIF            ENDIF
178  C     sin(lat)  C     sin(lat)
179            S(j) = sin(yC(i,j,bi,bj)*deg2rad)            S(j,bj) = sin(yC(i,j,bi,bj)*deg2rad)
180  C     setup Legendre polynomials and  derivatives  C     setup Legendre polynomials and  derivatives
181            P2(j) = 0.5*(3.*S(j)**2 - 1.)            P2(j,bj) = 0.5*(3.*S(j,bj)**2 - 1.)
182            P4(j) = 0.12*(35.*S(j)**4 - 30.*S(j)**2 + 3.)            P4(j,bj) = 0.12*(35.*S(j,bj)**4 - 30.*S(j,bj)**2 + 3.)
183  c     net shortwave  c     net shortwave
184            SW(j) = 0.25*Q0*(1 + Q2*P2(j))*            SW(j,bj) = 0.25*Q0*(1 + Q2*P2(j,bj))*
185       <         (1 - A0 - A2*P2(j) - A4*P4(j) )       <         (1 - A0 - A2*P2(j,bj) - A4*P4(j,bj) )
186  c     temperature  c     temperature
187            T(j) = T0(no_so) + T2(no_so)*P2(j)            T(j,bj) = T0(no_so) + T2(no_so)*P2(j,bj)
188  c     net longwave  c     net longwave
189            LW(j) = LW0 + LW1*(T(j)-t_mlt)            LW(j,bj) = LW0 + LW1*(T(j,bj)-t_mlt)
190  c     climate change run, the parameter to change is DLW  c     climate change run, the parameter to change is DLW
191  #ifdef EBM_CLIMATE_CHANGE  #ifdef EBM_CLIMATE_CHANGE
192               LW(j) = LW(j) -               LW(j,bj) = LW(j,bj) -
193       <            (myTime-startTime)*3.215e-8*DLW       <            (myTime-startTime)*3.215e-8*DLW
194  c     <            - 6.0  c     <            - 6.0
195  c     <            *75.0*0.0474*  c     <            *75.0*0.0474*
196  c     <            (-2.62*S(j)**8 + 0.73*S(j)**7 +  c     <            (-2.62*S(j,bj)**8 + 0.73*S(j,bj)**7 +
197  c     <            4.82*S(j)**6 -  c     <            4.82*S(j,bj)**6 -
198  c     <            1.12*S(j)**5 - 2.69*S(j)**4 + 0.47*S(j)**3 +  c     <            1.12*S(j,bj)**5 - 2.69*S(j,bj)**4 + 0.47*S(j,bj)**3 +
199  c     <            0.51*S(j)**2 - 0.05*S(j)**1 + 0.17)  c     <            0.51*S(j,bj)**2 - 0.05*S(j,bj)**1 + 0.17)
200  #endif  #endif
201  c     fluxes at ocean/atmosphere interface  c     fluxes at ocean/atmosphere interface
202  c     Heat Flux = -Div(atmospheric heat transport) + SW - LW  c     Heat Flux = -Div(atmospheric heat transport) + SW - LW
203  #ifdef EBM_VERSION_1BASIN  #ifdef EBM_VERSION_1BASIN
204           Qnet(i,j,bi,bj) = -1.0*( SW(j) - LW(j) -           Qnet(i,j,bi,bj) = -1.0*( SW(j,bj) - LW(j,bj) -
205       <        Hd35(no_so)*(       <        Hd35(no_so)*(
206       <        0.000728e4      - 0.00678e4*S(j) +       <        0.000728e4      - 0.00678e4*S(j,bj) +
207       <        0.0955e4*S(j)**2 + 0.0769e4*S(j)**3 -       <        0.0955e4*S(j,bj)**2 + 0.0769e4*S(j,bj)**3 -
208       <        0.8508e4*S(j)**4 - 0.3581e4*S(j)**5 +       <        0.8508e4*S(j,bj)**4 - 0.3581e4*S(j,bj)**5 +
209       <        2.9240e4*S(j)**6 + 0.8311e4*S(j)**7 -         <        2.9240e4*S(j,bj)**6 + 0.8311e4*S(j,bj)**7 -  
210       <        4.9548e4*S(j)**8 - 0.8808e4*S(j)**9 +       <        4.9548e4*S(j,bj)**8 - 0.8808e4*S(j,bj)**9 +
211       <        4.0644e4*S(j)**10 +0.3409e4*S(j)**11 -       <        4.0644e4*S(j,bj)**10 +0.3409e4*S(j,bj)**11 -
212       <        1.2893e4*S(j)**12 )       <        1.2893e4*S(j,bj)**12 )
213       <        /(2*PI*rSphere*rSphere*25.0) )       <        /(2*PI*rSphere*rSphere*25.0) )
214  c             Qnet(i,j,bi,bj) = -1.0*( SW(j) - LW(j) -  c             Qnet(i,j,bi,bj) = -1.0*( SW(j,bj) - LW(j,bj) -
215  c     <            0.5*Hd35(no_so)*(3.054e1 - 3.763e1*S(j) +  c     <            0.5*Hd35(no_so)*(3.054e1 - 3.763e1*S(j,bj) +
216  c     <        1.892e2*S(j)**2 + 3.041e2*S(j)**3 -  c     <        1.892e2*S(j,bj)**2 + 3.041e2*S(j,bj)**3 -
217  c     <        1.540e3*S(j)**4 - 9.586e2*S(j)**5 +  c     <        1.540e3*S(j,bj)**4 - 9.586e2*S(j,bj)**5 +
218  c     <        2.939e3*S(j)**6 + 1.219e3*S(j)**7 -    c     <        2.939e3*S(j,bj)**6 + 1.219e3*S(j,bj)**7 -  
219  c     <        2.550e3*S(j)**8 - 5.396e2*S(j)**9 +  c     <        2.550e3*S(j,bj)**8 - 5.396e2*S(j,bj)**9 +
220  c     <        8.119e2*S(j)**10)  c     <        8.119e2*S(j,bj)**10)
221  c     <            /(2*PI*rSphere*rSphere*22.3) )  c     <            /(2*PI*rSphere*rSphere*22.3) )
222  #else  #else
223            IF (ReCountX(j) .GT. 0.) THEN            IF (ReCountX(j,bj) .GT. 0.) THEN
224               Qnet(i,j,bi,bj) = (-90./ReCountX(j))*               Qnet(i,j,bi,bj) = (-90./ReCountX(j,bj))*
225       <            ( SW(j) - LW(j) -       <            ( SW(j,bj) - LW(j,bj) -
226       <            Hd35(no_so)*(3.054e1 - 3.763e1*S(j) +       <            Hd35(no_so)*(3.054e1 - 3.763e1*S(j,bj) +
227       <        1.892e2*S(j)**2 + 3.041e2*S(j)**3 -       <        1.892e2*S(j,bj)**2 + 3.041e2*S(j,bj)**3 -
228       <        1.540e3*S(j)**4 - 9.586e2*S(j)**5 +       <        1.540e3*S(j,bj)**4 - 9.586e2*S(j,bj)**5 +
229       <        2.939e3*S(j)**6 + 1.219e3*S(j)**7 -         <        2.939e3*S(j,bj)**6 + 1.219e3*S(j,bj)**7 -  
230       <        2.550e3*S(j)**8 - 5.396e2*S(j)**9 +       <        2.550e3*S(j,bj)**8 - 5.396e2*S(j,bj)**9 +
231       <        8.119e2*S(j)**10)       <        8.119e2*S(j,bj)**10)
232       <            /(2*PI*rSphere*rSphere*22.3) )       <            /(2*PI*rSphere*rSphere*22.3) )
233            ELSE            ELSE
234               Qnet(i,j,bi,bj) = 0.               Qnet(i,j,bi,bj) = 0.
# Line 238  c     Freshwater Flux = Div(atmospheric Line 238  c     Freshwater Flux = Div(atmospheric
238  c---  conversion of E-P from kg/(s m^2) -> m/s -> psu/s: 1e-3*35/delZ(1)  c---  conversion of E-P from kg/(s m^2) -> m/s -> psu/s: 1e-3*35/delZ(1)
239  #ifdef EBM_VERSION_1BASIN  #ifdef EBM_VERSION_1BASIN
240            EmPmR(i,j,bi,bj) = -1.e-3*Fw35(no_so)            EmPmR(i,j,bi,bj) = -1.e-3*Fw35(no_so)
241       <    *(-0.8454e5*S(j)**14 + 0.5367e5*S(j)**13       <    *(-0.8454e5*S(j,bj)**14 + 0.5367e5*S(j,bj)**13
242       <    +3.3173e5*S(j)**12 - 1.8965e5*S(j)**11 - 5.1701e5*S(j)**10       <    +3.3173e5*S(j,bj)**12 - 1.8965e5*S(j,bj)**11
243       <    +2.6240e5*S(j)**9 + 4.077e5*S(j)**8 - 1.791e5*S(j)**7       <    -5.1701e5*S(j,bj)**10
244       <    -1.7231e5*S(j)**6 + 0.6229e5*S(j)**5 + 0.3824e5*S(j)**4       <    +2.6240e5*S(j,bj)**9 + 4.077e5*S(j,bj)**8 - 1.791e5*S(j,bj)**7
245       <    -0.1017e5*S(j)**3 - 0.0387e5*S(j)**2       <    -1.7231e5*S(j,bj)**6 + 0.6229e5*S(j,bj)**5
246       <    +0.00562e5*S(j)  + 0.0007743e5)       <    +0.3824e5*S(j,bj)**4
247         <    -0.1017e5*S(j,bj)**3 - 0.0387e5*S(j,bj)**2
248         <    +0.00562e5*S(j,bj)  + 0.0007743e5)
249       <    /(2.0*12.0*PI*rSphere*rSphere)       <    /(2.0*12.0*PI*rSphere*rSphere)
250  c             EmPmR(i,j,bi,bj) = 1.e-3*Fw35(no_so)  c             EmPmR(i,j,bi,bj) = 1.e-3*Fw35(no_so)
251  c     <            *(50.0 + 228.0*S(j) -1.593e3*S(j)**2  c     <            *(50.0 + 228.0*S(j,bj) -1.593e3*S(j,bj)**2
252  c     <            - 2.127e3*S(j)**3 + 7.3e3*S(j)**4  c     <            - 2.127e3*S(j,bj)**3 + 7.3e3*S(j,bj)**4
253  c     <            + 5.799e3*S(j)**5 - 1.232e4*S(j)**6  c     <            + 5.799e3*S(j,bj)**5 - 1.232e4*S(j,bj)**6
254  c     <            - 6.389e3*S(j)**7 + 9.123e3*S(j)**8  c     <            - 6.389e3*S(j,bj)**7 + 9.123e3*S(j,bj)**8
255  c     <            + 2.495e3*S(j)**9 - 2.567e3*S(j)**10)  c     <            + 2.495e3*S(j,bj)**9 - 2.567e3*S(j,bj)**10)
256  c     <            /(2*PI*rSphere*rSphere*15.0)  c     <            /(2*PI*rSphere*rSphere*15.0)
257  #else  #else
258            IF (yC(i,j,bi,bj) .LT. -40.) THEN            IF (yC(i,j,bi,bj) .LT. -40.) THEN
259  c--   Southern Hemisphere  c--   Southern Hemisphere
260             EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)*             EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)*
261       <            (-6.5 + 35.3 + 71.7*S(j)         <            (-6.5 + 35.3 + 71.7*S(j,bj)  
262       <           - 1336.3*S(j)**2 - 425.8*S(j)**3       <           - 1336.3*S(j,bj)**2 - 425.8*S(j,bj)**3
263       <           + 5434.8*S(j)**4 + 707.9*S(j)**5       <           + 5434.8*S(j,bj)**4 + 707.9*S(j,bj)**5
264       <           - 6987.7*S(j)**6 - 360.4*S(j)**7       <           - 6987.7*S(j,bj)**6 - 360.4*S(j,bj)**7
265       <           + 2855.0*S(j)**8)       <           + 2855.0*S(j,bj)**8)
266       <            /(2*PI*rSphere*rSphere*18.0))       <            /(2*PI*rSphere*rSphere*18.0))
267            ELSE            ELSE
268  c--   Atlantic  c--   Atlantic
269             IF (xC(i,j,bi,bj) .GT. 284.             IF (xC(i,j,bi,bj) .GT. 284.
270       <      .OR. xC(i,j,bi,bj) .LT. 28.) THEN       <      .OR. xC(i,j,bi,bj) .LT. 28.) THEN
271                EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)*                EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)*
272       <             (-6.5 -2.878 + 3.157e2*S(j) -       <             (-6.5 -2.878 + 3.157e2*S(j,bj) -
273       <             2.388e3*S(j)**2 - 4.101e3*S(j)**3 +       <             2.388e3*S(j,bj)**2 - 4.101e3*S(j,bj)**3 +
274       <             1.963e4*S(j)**4 + 1.534e4*S(j)**5 -       <             1.963e4*S(j,bj)**4 + 1.534e4*S(j,bj)**5 -
275       <             6.556e4*S(j)**6 - 2.478e4*S(j)**7 +       <             6.556e4*S(j,bj)**6 - 2.478e4*S(j,bj)**7 +
276       <             1.083e5*S(j)**8 + 1.85e4*S(j)**9 -       <             1.083e5*S(j,bj)**8 + 1.85e4*S(j,bj)**9 -
277       <             8.703e4*S(j)**10 - 5.276e3*S(j)**11 +       <             8.703e4*S(j,bj)**10 - 5.276e3*S(j,bj)**11 +
278       <             2.703e4*S(j)**12)       <             2.703e4*S(j,bj)**12)
279       <             /(2*PI*rSphere*rSphere*12.0))       <             /(2*PI*rSphere*rSphere*12.0))
280             ELSE             ELSE
281  c--   Pacific  c--   Pacific
282                EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)                EmPmR(i,j,bi,bj) = -1.e-3*(Fw35(no_so)
283       <             *(-6.5 +51.89 + 4.916e2*S(j) -       <             *(-6.5 +51.89 + 4.916e2*S(j,bj) -
284       <             1.041e3*S(j)**2 - 7.546e3*S(j)**3 +       <             1.041e3*S(j,bj)**2 - 7.546e3*S(j,bj)**3 +
285       <             2.335e3*S(j)**4 + 3.449e4*S(j)**5 +       <             2.335e3*S(j,bj)**4 + 3.449e4*S(j,bj)**5 +
286       <             6.702e3*S(j)**6 - 6.601e4*S(j)**7 -       <             6.702e3*S(j,bj)**6 - 6.601e4*S(j,bj)**7 -
287       <             2.594e4*S(j)**8 + 5.652e4*S(j)**9 +       <             2.594e4*S(j,bj)**8 + 5.652e4*S(j,bj)**9 +
288       <             2.738e4*S(j)**10 - 1.795e4*S(j)**11 -       <             2.738e4*S(j,bj)**10 - 1.795e4*S(j,bj)**11 -
289       <             9.486e3*S(j)**12)       <             9.486e3*S(j,bj)**12)
290       <             /(2*PI*rSphere*rSphere*12.0))       <             /(2*PI*rSphere*rSphere*12.0))
291             ENDIF             ENDIF
292            ENDIF            ENDIF
# Line 294  c--   Pacific Line 296  c--   Pacific
296         ENDDO         ENDDO
297        ENDDO        ENDDO
298    
299          _EXCH_XY_R4(Qnet , myThid )
300          _EXCH_XY_R4(EmPmR , myThid )
301          
302    
303  C      CALL PLOT_FIELD_XYRS( Qnet, 'Qnet' , 1, myThid )  C      CALL PLOT_FIELD_XYRS( Qnet, 'Qnet' , 1, myThid )
304  C      CALL PLOT_FIELD_XYRS( EmPmR, 'EmPmR' , 1, myThid )  C      CALL PLOT_FIELD_XYRS( EmPmR, 'EmPmR' , 1, myThid )
305    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22