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

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

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

Revision 1.5 - (show annotations) (download)
Tue May 29 14:02:00 2001 UTC (22 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46b_post, checkpoint46k_post, checkpoint40pre1, checkpoint44h_pre, checkpoint46j_post, checkpoint44e_post, checkpoint40pre3, checkpoint44f_pre, checkpoint46c_post, checkpoint46f_post, checkpoint46l_pre, checkpoint46a_post, release1_beta1, checkpoint46d_pre, checkpoint46e_post, checkpoint45b_post, release1-branch_tutorials, checkpoint44g_post, checkpoint46h_pre, checkpoint45c_post, checkpoint44h_post, checkpoint46l_post, chkpt44c_post, checkpoint46e_pre, checkpoint43a-release1mods, checkpoint46j_pre, checkpoint46b_pre, checkpoint45d_post, chkpt44a_pre, release1-branch-end, release1_final_v1, checkpoint46, checkpoint44f_post, checkpoint41, checkpoint44, checkpoint40pre2, checkpoint40pre5, checkpoint40pre6, checkpoint40pre8, release1_b1, checkpoint44b_post, chkpt44d_post, checkpoint42, checkpoint46m_post, checkpoint46g_pre, release1_p2, release1_p3, release1_p4, release1_p6, chkpt44a_post, checkpoint44b_pre, release1_p1, checkpoint40pre4, checkpoint46a_pre, release1_p5, checkpoint44e_pre, chkpt44c_pre, checkpoint40pre9, checkpoint46d_post, checkpoint46g_post, checkpoint45a_post, checkpoint46c_pre, checkpoint43, checkpoint40, release1-branch_branchpoint, checkpoint46i_post, checkpoint40pre7, checkpoint45, checkpoint46h_post, release1_chkpt44d_post, release1_p7
Branch point for: release1_coupled, release1_final, release1-branch, release1
Changes since 1.4: +4 -4 lines 
Merge from branch pre38:
 o essential mods for cubed sphere
 o debugged atmosphere, dynamcis + physics (aim)
 o new packages (mom_vecinv, mom_fluxform, ...)
1 C $Header: /u/gcmpack/models/MITgcmUV/verification/natl_box/code/external_fields_load.F,v 1.4 2001/02/04 14:38:53 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
39 C === Routine arguments ===
40 C myThid - Thread no. that called this routine.
41 C myTime - Simulation time
42 C myIter - Simulation timestep number
43 INTEGER myThid
44 _RL myTime
45 INTEGER myIter
46 CEndOfInterface
47
48 C === Functions ===
49 LOGICAL DIFFERENT_MULTIPLE
50 EXTERNAL DIFFERENT_MULTIPLE
51
52 C === Local arrays ===
53 COMMON /TDFIELDS/
54 & taux0, tauy0, Qnet0, EmPmR0, SST0, SSS0, Qsw0,
55 & taux1, tauy1, Qnet1, EmPmR1, SST1, SSS1, Qsw1
56 _RS taux0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
57 _RS tauy0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
58 _RS Qnet0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
59 _RS EmPmR0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
60 _RS SST0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
61 _RS SSS0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
62 _RS Qsw0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
63 _RS taux1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
64 _RS tauy1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65 _RS Qnet1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66 _RS EmPmR1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67 _RS SST1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
68 _RS SSS1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
69 _RS Qsw1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
70
71 C === Local variables ===
72 INTEGER bi,bj,i,j,intime0,intime1
73
74 _RL aWght,bWght,rdt
75 INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
76
77 IF ( periodicExternalForcing ) THEN
78
79 C First call requires that we initialize everything to zero for safety
80 IF ( myIter .EQ. nIter0 ) THEN
81 CALL LEF_ZERO( taux0 ,myThid )
82 CALL LEF_ZERO( tauy0 ,myThid )
83 CALL LEF_ZERO( Qnet0 ,myThid )
84 CALL LEF_ZERO( EmPmR0 ,myThid )
85 CALL LEF_ZERO( SST0 ,myThid )
86 CALL LEF_ZERO( SSS0 ,myThid )
87 CALL LEF_ZERO( Qsw0 ,myThid )
88 CALL LEF_ZERO( taux1 ,myThid )
89 CALL LEF_ZERO( tauy1 ,myThid )
90 CALL LEF_ZERO( Qnet1 ,myThid )
91 CALL LEF_ZERO( EmPmR1 ,myThid )
92 CALL LEF_ZERO( SST1 ,myThid )
93 CALL LEF_ZERO( SSS1 ,myThid )
94 CALL LEF_ZERO( Qsw1 ,myThid )
95 ENDIF
96
97 C Now calculate whether it is time to update the forcing arrays
98 rdt=1. _d 0 / deltaTclock
99 nForcingPeriods=int(externForcingCycle/externForcingPeriod)
100 Imytm=int(myTime*rdt)
101 Ifprd=int(externForcingPeriod*rdt)
102 Ifcyc=int(externForcingCycle*rdt)
103 Iftm=mod( Imytm ,Ifcyc)
104
105 intime0=int(Iftm/Ifprd)
106 intime1=mod(intime0+1,nForcingPeriods)
107 aWght=mod(myTime/externForcingPeriod,1.)
108 bWght=1.-aWght
109
110 intime0=intime0+1
111 intime1=intime1+1
112
113 IF (
114 & Iftm-Ifprd*(intime0-1) .EQ. 0
115 & .OR. myIter .EQ. nIter0
116 & ) THEN
117
118 _BEGIN_MASTER(myThid)
119
120 C If the above condition is met then we need to read in
121 C data for the period ahead and the period behind myTime.
122 WRITE(*,*)
123 & 'S/R EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter
124
125 IF ( zonalWindFile .NE. ' ' ) THEN
126 CALL READ_REC_XY_RS( zonalWindFile,taux0,intime0,myIter,myThid )
127 CALL READ_REC_XY_RS( zonalWindFile,taux1,intime1,myIter,myThid )
128 ENDIF
129 IF ( meridWindFile .NE. ' ' ) THEN
130 CALL READ_REC_XY_RS( meridWindFile,tauy0,intime0,myIter,myThid )
131 CALL READ_REC_XY_RS( meridWindFile,tauy1,intime1,myIter,myThid )
132 ENDIF
133 IF ( surfQFile .NE. ' ' ) THEN
134 CALL READ_REC_XY_RS( surfQFile,Qnet0,intime0,myIter,myThid )
135 CALL READ_REC_XY_RS( surfQFile,Qnet1,intime1,myIter,myThid )
136 ENDIF
137 IF ( EmPmRfile .NE. ' ' ) THEN
138 CALL READ_REC_XY_RS( EmPmRfile,EmPmR0,intime0,myIter,myThid )
139 CALL READ_REC_XY_RS( EmPmRfile,EmPmR1,intime1,myIter,myThid )
140 ENDIF
141 IF ( thetaClimFile .NE. ' ' ) THEN
142 CALL READ_REC_XY_RS( thetaClimFile,SST0,intime0,myIter,myThid )
143 CALL READ_REC_XY_RS( thetaClimFile,SST1,intime1,myIter,myThid )
144 ENDIF
145 IF ( saltClimFile .NE. ' ' ) THEN
146 CALL READ_REC_XY_RS( saltClimFile,SSS0,intime0,myIter,myThid )
147 CALL READ_REC_XY_RS( saltClimFile,SSS1,intime1,myIter,myThid )
148 ENDIF
149 #ifdef SHORTWAVE_HEATING
150 IF ( surfQswFile .NE. ' ' ) THEN
151 CALL READ_REC_XY_RS( surfQswFile,Qsw0,intime0,myIter,myThid )
152 CALL READ_REC_XY_RS( surfQswFile,Qsw1,intime1,myIter,myThid )
153 ENDIF
154 #endif
155
156 _END_MASTER(myThid)
157 C
158 _EXCH_XY_R4(SST0 , myThid )
159 _EXCH_XY_R4(SST1 , myThid )
160 _EXCH_XY_R4(SSS0 , myThid )
161 _EXCH_XY_R4(SSS1 , myThid )
162 _EXCH_XY_R4(taux0 , myThid )
163 _EXCH_XY_R4(taux1 , myThid )
164 _EXCH_XY_R4(tauy0 , myThid )
165 _EXCH_XY_R4(tauy1 , myThid )
166 _EXCH_XY_R4(Qnet0, myThid )
167 _EXCH_XY_R4(Qnet1, myThid )
168 _EXCH_XY_R4(EmPmR0, myThid )
169 _EXCH_XY_R4(EmPmR1, myThid )
170 #ifdef SHORTWAVE_HEATING
171 _EXCH_XY_R4(Qsw0, myThid )
172 _EXCH_XY_R4(Qsw1, myThid )
173 #endif
174 C
175 ENDIF
176
177 C-- Interpolate fu,fv,Qnet,EmPmR,SST,SSS,Qsw
178 DO bj = myByLo(myThid), myByHi(myThid)
179 DO bi = myBxLo(myThid), myBxHi(myThid)
180 DO j=1-Oly,sNy+Oly
181 DO i=1-Olx,sNx+Olx
182 SST(i,j,bi,bj) = bWght*SST0(i,j,bi,bj)
183 & +aWght*SST1(i,j,bi,bj)
184 SSS(i,j,bi,bj) = bWght*SSS0(i,j,bi,bj)
185 & +aWght*SSS1(i,j,bi,bj)
186 fu(i,j,bi,bj) = -(bWght*taux0(i,j,bi,bj)
187 & +aWght*taux1(i,j,bi,bj))
188 fv(i,j,bi,bj) = -(bWght*tauy0(i,j,bi,bj)
189 & +aWght*tauy1(i,j,bi,bj))
190 Qnet(i,j,bi,bj) = bWght*Qnet0(i,j,bi,bj)
191 & +aWght*Qnet1(i,j,bi,bj)
192 EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
193 & +aWght*EmPmR1(i,j,bi,bj)
194 #ifdef SHORTWAVE_HEATING
195 Qsw(i,j,bi,bj) = bWght*Qsw0(i,j,bi,bj)
196 & +aWght*Qsw1(i,j,bi,bj)
197 #endif
198 ENDDO
199 ENDDO
200 ENDDO
201 ENDDO
202
203 C endif for periodicForcing
204 ENDIF
205
206 RETURN
207 END
208
209 SUBROUTINE LEF_ZERO( arr ,myThid )
210 C This routine simply sets the argument array to zero
211 C Used only by EXTERNAL_FIELDS_LOAD
212 IMPLICIT NONE
213 C === Global variables ===
214 #include "SIZE.h"
215 #include "EEPARAMS.h"
216 C === Arguments ===
217 _RS arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
218 INTEGER myThid
219 C === Local variables ===
220 INTEGER i,j,bi,bj
221
222 DO bj = myByLo(myThid), myByHi(myThid)
223 DO bi = myBxLo(myThid), myBxHi(myThid)
224 DO j=1-Oly,sNy+Oly
225 DO i=1-Olx,sNx+Olx
226 arr(i,j,bi,bj)=0.
227 ENDDO
228 ENDDO
229 ENDDO
230 ENDDO
231
232 RETURN
233 END
  ViewVC Help
Powered by ViewVC 1.1.22