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

Contents 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.1 - (show annotations) (download)
Fri Aug 11 18:55:50 2006 UTC (19 years, 7 months ago) by jscott
Branch: MAIN
new 2d atm package

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 IF (iceMask(i,j,1,1).NE.0.D0)
123 & 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 IF (iceMask(i,j,1,1).NE.0.D0) THEN
130 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 IF (iceMask(i,j,1,1).NE.0.D0) THEN
140 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