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