/[MITgcm]/MITgcm/verification/exp2/code/external_fields_load.F
ViewVC logotype

Contents of /MITgcm/verification/exp2/code/external_fields_load.F

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


Revision 1.4 - (show annotations) (download)
Fri Mar 9 19:35:38 2001 UTC (23 years ago) by adcroft
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +2 -2 lines
FILE REMOVED
Added missing CPP_EEOPTIONS.h, removed external_forcing_load.F from exp2.

1 C $Header: /u/gcmpack/models/MITgcmUV/verification/exp2/code/external_fields_load.F,v 1.3 2001/02/04 14:38:52 cnh Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CStartOfInterface
7 SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
8 C /==========================================================\
9 C | SUBROUTINE EXTERNAL_FIELDS_LOAD |
10 C | o Control reading of fields from external source. |
11 C |==========================================================|
12 C | External source field loading routine. |
13 C | This routine is called every time we want to |
14 C | load a a set of external fields. The routine decides |
15 C | which fields to load and then reads them in. |
16 C | This routine needs to be customised for particular |
17 C | experiments. |
18 C | Notes |
19 C | ===== |
20 C | Two-dimensional and three-dimensional I/O are handled in |
21 C | the following way under MITgcmUV. A master thread |
22 C | performs I/O using system calls. This threads reads data |
23 C | into a temporary buffer. At present the buffer is loaded |
24 C | with the entire model domain. This is probably OK for now|
25 C | Each thread then copies data from the buffer to the |
26 C | region of the proper array it is responsible for. |
27 C | ===== |
28 C | Conversion of flux fields are described in FFIELDS.h |
29 C \==========================================================/
30 IMPLICIT NONE
31
32 C === Global variables ===
33 #include "SIZE.h"
34 #include "EEPARAMS.h"
35 #include "PARAMS.h"
36 #include "FFIELDS.h"
37 #include "GRID.h"
38 #include "DYNVARS.h"
39
40 C === Routine arguments ===
41 C myThid - Thread no. that called this routine.
42 C myTime - Simulation time
43 C myIter - Simulation timestep number
44 INTEGER myThid
45 _RL myTime
46 INTEGER myIter
47 CEndOfInterface
48
49 C === Functions ===
50 LOGICAL DIFFERENT_MULTIPLE
51 EXTERNAL DIFFERENT_MULTIPLE
52
53 C === Local arrays ===
54 COMMON /TDFIELDS/
55 & taux0, tauy0, Qnet0, EmPmR0, SST0, SSS0, Qsw0,
56 & taux1, tauy1, Qnet1, EmPmR1, SST1, SSS1, Qsw1
57 _RS taux0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
58 _RS tauy0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
59 _RS Qnet0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
60 _RS EmPmR0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
61 _RS SST0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
62 _RS SSS0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
63 _RS Qsw0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
64 _RS taux1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65 _RS tauy1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66 _RS Qnet1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67 _RS EmPmR1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
68 _RS SST1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
69 _RS SSS1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
70 _RS Qsw1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
71
72 C === Local variables ===
73 INTEGER bi,bj,i,j,intime0,intime1
74
75 _RL aWght,bWght,rdt
76 INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
77
78 IF ( periodicExternalForcing ) THEN
79
80 C First call requires that we initialize everything to zero for safety
81 IF ( myIter .EQ. nIter0 ) THEN
82 CALL LEF_ZERO( taux0 ,myThid )
83 CALL LEF_ZERO( tauy0 ,myThid )
84 CALL LEF_ZERO( Qnet0 ,myThid )
85 CALL LEF_ZERO( EmPmR0 ,myThid )
86 CALL LEF_ZERO( SST0 ,myThid )
87 CALL LEF_ZERO( SSS0 ,myThid )
88 CALL LEF_ZERO( Qsw0 ,myThid )
89 CALL LEF_ZERO( taux1 ,myThid )
90 CALL LEF_ZERO( tauy1 ,myThid )
91 CALL LEF_ZERO( Qnet1 ,myThid )
92 CALL LEF_ZERO( EmPmR1 ,myThid )
93 CALL LEF_ZERO( SST1 ,myThid )
94 CALL LEF_ZERO( SSS1 ,myThid )
95 CALL LEF_ZERO( Qsw1 ,myThid )
96 ENDIF
97
98 C Now calculate whether it is time to update the forcing arrays
99 rdt=1. _d 0 / deltaTclock
100 nForcingPeriods=int(externForcingCycle/externForcingPeriod+0.5)
101 Imytm=int(myTime*rdt+0.5)
102 Ifprd=int(externForcingPeriod*rdt+0.5)
103 Ifcyc=int(externForcingCycle*rdt+0.5)
104 Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc)
105
106 intime0=int(Iftm/Ifprd)
107 intime1=mod(intime0+1,nForcingPeriods)
108 aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd )
109 bWght=1.-aWght
110
111 intime0=intime0+1
112 intime1=intime1+1
113
114 IF (
115 & Iftm-Ifprd*(intime0-1) .EQ. 0
116 & .OR. myIter .EQ. nIter0
117 & ) THEN
118
119 _BEGIN_MASTER(myThid)
120
121 C If the above condition is met then we need to read in
122 C data for the period ahead and the period behind myTime.
123 write(0,*)
124 & 'S/R LOAD_INTERPOLATE_FORCING: Reading new data',myTime,myIter
125
126 IF ( zonalWindFile .NE. ' ' ) THEN
127 CALL READ_REC_XY_RS( zonalWindFile,taux0,intime0,myIter,myThid )
128 CALL READ_REC_XY_RS( zonalWindFile,taux1,intime1,myIter,myThid )
129 ENDIF
130 IF ( meridWindFile .NE. ' ' ) THEN
131 CALL READ_REC_XY_RS( meridWindFile,tauy0,intime0,myIter,myThid )
132 CALL READ_REC_XY_RS( meridWindFile,tauy1,intime1,myIter,myThid )
133 ENDIF
134 IF ( surfQFile .NE. ' ' ) THEN
135 CALL READ_REC_XY_RS( surfQFile,Qnet0,intime0,myIter,myThid )
136 CALL READ_REC_XY_RS( surfQFile,Qnet1,intime1,myIter,myThid )
137 ENDIF
138 IF ( EmPmRfile .NE. ' ' ) THEN
139 cfixed CALL READ_REC_XY_RS( EmPmRfile,EmPmR0,intime0,myIter,myThid )
140 cfixed CALL READ_REC_XY_RS( EmPmRfile,EmPmR1,intime1,myIter,myThid )
141 CALL READ_REC_XY_RS( EmPmRfile,EmPmR0,1,myIter,myThid )
142 CALL READ_REC_XY_RS( EmPmRfile,EmPmR1,1,myIter,myThid )
143 ENDIF
144 IF ( thetaClimFile .NE. ' ' ) THEN
145 CALL READ_REC_XY_RS( thetaClimFile,SST0,intime0,myIter,myThid )
146 CALL READ_REC_XY_RS( thetaClimFile,SST1,intime1,myIter,myThid )
147 ENDIF
148 IF ( saltClimFile .NE. ' ' ) THEN
149 CALL READ_REC_XY_RS( saltClimFile,SSS0,intime0,myIter,myThid )
150 CALL READ_REC_XY_RS( saltClimFile,SSS1,intime1,myIter,myThid )
151 ENDIF
152 #ifdef SHORTWAVE_HEATING
153 IF ( surfQswFile .NE. ' ' ) THEN
154 CALL READ_REC_XY_RS( surfQswFile,Qsw0,intime0,myIter,myThid )
155 CALL READ_REC_XY_RS( surfQswFile,Qsw1,intime1,myIter,myThid )
156 ENDIF
157 #endif
158
159 _END_MASTER(myThid)
160 C
161 _EXCH_XY_R4(SST0 , myThid )
162 _EXCH_XY_R4(SST1 , myThid )
163 _EXCH_XY_R4(SSS0 , myThid )
164 _EXCH_XY_R4(SSS1 , myThid )
165 _EXCH_XY_R4(taux0 , myThid )
166 _EXCH_XY_R4(taux1 , myThid )
167 _EXCH_XY_R4(tauy0 , myThid )
168 _EXCH_XY_R4(tauy1 , myThid )
169 _EXCH_XY_R4(Qnet0, myThid )
170 _EXCH_XY_R4(Qnet1, myThid )
171 _EXCH_XY_R4(EmPmR0, myThid )
172 _EXCH_XY_R4(EmPmR1, myThid )
173 #ifdef SHORTWAVE_HEATING
174 _EXCH_XY_R4(Qsw0, myThid )
175 _EXCH_XY_R4(Qsw1, myThid )
176 #endif
177 C
178 ENDIF
179
180 C-- Interpolate fu,fv,Qnet,EmPmR,SST,SSS,Qsw
181 DO bj = myByLo(myThid), myByHi(myThid)
182 DO bi = myBxLo(myThid), myBxHi(myThid)
183 DO j=1-Oly,sNy+Oly
184 DO i=1-Olx,sNx+Olx
185 SST(i,j,bi,bj) = bWght*SST0(i,j,bi,bj)
186 & +aWght*SST1(i,j,bi,bj)
187 SSS(i,j,bi,bj) = bWght*SSS0(i,j,bi,bj)
188 & +aWght*SSS1(i,j,bi,bj)
189 fu(i,j,bi,bj) = bWght*taux0(i,j,bi,bj)
190 & +aWght*taux1(i,j,bi,bj)
191 fv(i,j,bi,bj) = bWght*tauy0(i,j,bi,bj)
192 & +aWght*tauy1(i,j,bi,bj)
193 Qnet(i,j,bi,bj) = bWght*Qnet0(i,j,bi,bj)
194 & +aWght*Qnet1(i,j,bi,bj)
195 EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
196 & +aWght*EmPmR1(i,j,bi,bj)
197 #ifdef SHORTWAVE_HEATING
198 Qsw(i,j,bi,bj) = bWght*Qsw0(i,j,bi,bj)
199 & +aWght*Qsw1(i,j,bi,bj)
200 #endif
201 ENDDO
202 ENDDO
203 ENDDO
204 ENDDO
205
206 C endif for periodicForcing
207 ENDIF
208
209 RETURN
210 END
211
212 SUBROUTINE LEF_ZERO( arr ,myThid )
213 C This routine simply sets the argument array to zero
214 C Used only by EXTERNAL_FIELDS_LOAD
215 IMPLICIT NONE
216 C === Global variables ===
217 #include "SIZE.h"
218 #include "EEPARAMS.h"
219 C === Arguments ===
220 _RS arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
221 INTEGER myThid
222 C === Local variables ===
223 INTEGER i,j,bi,bj
224
225 DO bj = myByLo(myThid), myByHi(myThid)
226 DO bi = myBxLo(myThid), myBxHi(myThid)
227 DO j=1-Oly,sNy+Oly
228 DO i=1-Olx,sNx+Olx
229 arr(i,j,bi,bj)=0.
230 ENDDO
231 ENDDO
232 ENDDO
233 ENDDO
234
235 RETURN
236 END

  ViewVC Help
Powered by ViewVC 1.1.22