/[MITgcm]/MITgcm_contrib/jscott/pkg_atm2d/fixed_flux_add.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/pkg_atm2d/fixed_flux_add.F

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


Revision 1.2 - (hide annotations) (download)
Tue Aug 22 20:21:38 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
Changes since 1.1: +3 -3 lines
new revision of atm2d package

1 jscott 1.1 #include "ctrparam.h"
2     #include "ATM2D_OPTIONS.h"
3    
4     C !INTERFACE:
5     SUBROUTINE FIXED_FLUX_ADD( wght0, wght1,
6     & intime0, intime1, iftime, myIter, myThid)
7     C *==========================================================*
8     C | |
9     c | |
10     C *==========================================================*
11     IMPLICIT NONE
12    
13     C === Global Atmos/Ocean/Seaice Interface Variables ===
14     #include "ATMSIZE.h"
15     #include "SIZE.h"
16     #include "EEPARAMS.h"
17     #include "THSICE_VARS.h"
18     #include "ATM2D_VARS.h"
19    
20     C !INPUT/OUTPUT PARAMETERS:
21     C === Routine arguments ===
22     C myIter - Ocean iteration number
23     C myThid - Thread no. that called this routine.
24     _RL wght0
25     _RL wght1
26     INTEGER intime0
27     INTEGER intime1
28     LOGICAL iftime
29     INTEGER myIter
30     INTEGER myThid
31    
32     C LOCAL VARIABLES:
33     INTEGER i,j
34     COMMON /OCEANMEAN/
35     & tau0, tau1, tav0, tav1,
36     & wind0, wind1, qnet0, qnet1,
37     & evap0, evap1,
38     & precip0, precip1,
39     & runoff0, runoff1
40    
41     _RS tau0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
42     _RS tau1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
43     _RS tav0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
44     _RS tav1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
45     _RS wind0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
46     _RS wind1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
47     _RS qnet0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
48     _RS qnet1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
49     _RS evap0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
50     _RS evap1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
51     _RS precip0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
52     _RS precip1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
53     _RS runoff0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
54     _RS runoff1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
55    
56     IF (ifTime) THEN
57    
58     C If the above condition is met then we need to read in
59     C data for the period ahead and the period behind current time.
60    
61     WRITE(*,*) 'S/R FIXED_FLUX_ADD: Reading new data'
62     IF ( tauuFile .NE. ' ' ) THEN
63     CALL READ_REC_XY_RS( tauuFile,tau0,intime0,
64     & myIter,myThid )
65     CALL READ_REC_XY_RS( tauuFile,tau1,intime1,
66     & myIter,myThid )
67     ENDIF
68     IF ( tauvFile .NE. ' ' ) THEN
69     CALL READ_REC_XY_RS( tauvFile,tav0,intime0,
70     & myIter,myThid )
71     CALL READ_REC_XY_RS( tauvFile,tav1,intime1,
72     & myIter,myThid )
73     ENDIF
74     IF ( windFile .NE. ' ' ) THEN
75     CALL READ_REC_XY_RS( windFile,wind0,intime0,
76     & myIter,myThid )
77     CALL READ_REC_XY_RS( windFile,wind1,intime1,
78     & myIter,myThid )
79     ENDIF
80     IF ( qnetFile .NE. ' ' ) THEN
81     CALL READ_REC_XY_RS( qnetFile,qnet0,intime0,
82     & myIter,myThid )
83     CALL READ_REC_XY_RS( qnetFile,qnet1,intime1,
84     & myIter,myThid )
85     ENDIF
86     IF ( evapFile .NE. ' ' ) THEN
87     CALL READ_REC_XY_RS( evapFile,evap0,intime0,
88     & myIter,myThid )
89     CALL READ_REC_XY_RS( evapFile,evap1,intime1,
90     & myIter,myThid )
91     ENDIF
92     IF ( precipFile .NE. ' ' ) THEN
93     CALL READ_REC_XY_RS( precipFile,precip0,intime0,
94     & myIter,myThid )
95     CALL READ_REC_XY_RS( precipFile,precip1,intime1,
96     & myIter,myThid )
97     ENDIF
98     IF ( runoffFile .NE. ' ' ) THEN
99     CALL READ_REC_XY_RS( runoffFile,runoff0,intime0,
100     & myIter,myThid )
101     CALL READ_REC_XY_RS( runoffFile,runoff1,intime1,
102     & myIter,myThid )
103     ENDIF
104    
105     ENDIF
106    
107    
108     C-- Interpolate and add to anomaly
109     DO j=1,sNy
110     DO i=1,sNx
111    
112     fu_2D(i,j)= fu_2D(i,j) +
113     & (wght0*tau0(i,j,1,1) + wght1*tau1(i,j,1,1))
114     fv_2D(i,j)= fv_2D(i,j) +
115     & (wght0*tav0(i,j,1,1) + wght1*tav1(i,j,1,1))
116     wspeed_2D(i,j)= wspeed_2D(i,j) +
117     & (wght0*wind0(i,j,1,1) + wght1*wind1(i,j,1,1))
118     qneto_2D(i,j)= qneto_2D(i,j) +
119     & (wght0*qnet0(i,j,1,1) + wght1*qnet1(i,j,1,1))
120    
121     c note below is different from older code...
122 jscott 1.2 IF (iceMask(i,j,1,1) .NE. 0. _d 0)
123 jscott 1.1 & qneti_2D(i,j)= qneti_2D(i,j) +
124     & (wght0*qnet0(i,j,1,1) + wght1*qnet1(i,j,1,1))
125    
126     IF (useObsEmP) THEN
127     evapo_2D(i,j)= (wght0*evap0(i,j,1,1) + wght1*evap1(i,j,1,1))
128     precipo_2D(i,j)= (wght0*precip0(i,j,1,1) + wght1*precip1(i,j,1,1))
129 jscott 1.2 IF (iceMask(i,j,1,1) .NE. 0. _d 0) THEN
130 jscott 1.1 evapi_2D(i,j)= (wght0*evap0(i,j,1,1) + wght1*evap1(i,j,1,1))
131     precipi_2D(i,j)= (wght0*precip0(i,j,1,1) +
132     & wght1*precip1(i,j,1,1))
133     ENDIF
134     ELSE
135     evapo_2D(i,j)= evapo_2D(i,j) +
136     & (wght0*evap0(i,j,1,1) + wght1*evap1(i,j,1,1))
137     precipo_2D(i,j)= precipo_2D(i,j) +
138     & (wght0*precip0(i,j,1,1) + wght1*precip1(i,j,1,1))
139 jscott 1.2 IF (iceMask(i,j,1,1) .NE. 0. _d 0) THEN
140 jscott 1.1 evapi_2D(i,j)= evapi_2D(i,j) +
141     & (wght0*evap0(i,j,1,1) + wght1*evap1(i,j,1,1))
142     precipi_2D(i,j)= precipi_2D(i,j) +
143     & (wght0*precip0(i,j,1,1) + wght1*precip1(i,j,1,1))
144     ENDIF
145     ENDIF
146    
147     IF (useObsRunoff) THEN
148     runoff_2D(i,j)= (wght0*runoff0(i,j,1,1) + wght1*runoff1(i,j,1,1))
149     ELSE
150     runoff_2D(i,j)= runoff_2D(i,j) +
151     & (wght0*runoff0(i,j,1,1) + wght1*runoff1(i,j,1,1))
152     ENDIF
153     ENDDO
154     ENDDO
155    
156     RETURN
157     END
158    

  ViewVC Help
Powered by ViewVC 1.1.22