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

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

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

revision 1.5 by adcroft, Tue May 29 14:02:00 2001 UTC revision 1.6 by heimbach, Tue Nov 12 20:39:46 2002 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6  CStartOfInterface  CBOP
7    C     !ROUTINE: EXTERNAL_FIELDS_LOAD
8    C     !INTERFACE:
9        SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )        SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
10  C     /==========================================================\  C     !DESCRIPTION: \bv
11  C     | SUBROUTINE EXTERNAL_FIELDS_LOAD                          |  C     *==========================================================*
12  C     | o Control reading of fields from external source.        |  C     | SUBROUTINE EXTERNAL_FIELDS_LOAD                          
13  C     |==========================================================|  C     | o Control reading of fields from external source.        
14  C     | External source field loading routine.                   |  C     *==========================================================*
15  C     | This routine is called every time we want to             |  C     | External source field loading routine.                    
16  C     | load a a set of external fields. The routine decides     |  C     | This routine is called every time we want to              
17  C     | which fields to load and then reads them in.             |  C     | load a a set of external fields. The routine decides      
18  C     | This routine needs to be customised for particular       |  C     | which fields to load and then reads them in.              
19  C     | experiments.                                             |  C     | This routine needs to be customised for particular        
20  C     | Notes                                                    |  C     | experiments.                                              
21  C     | =====                                                    |  C     | Notes                                                    
22  C     | Two-dimensional and three-dimensional I/O are handled in |  C     | =====                                                    
23  C     | the following way under MITgcmUV. A master thread        |  C     | Two-dimensional and three-dimensional I/O are handled in  
24  C     | performs I/O using system calls. This threads reads data |  C     | the following way under MITgcmUV. A master thread        
25  C     | into a temporary buffer. At present the buffer is loaded |  C     | performs I/O using system calls. This threads reads data  
26  C     | with the entire model domain. This is probably OK for now|  C     | into a temporary buffer. At present the buffer is loaded  
27  C     | Each thread then copies data from the buffer to the      |  C     | with the entire model domain. This is probably OK for now
28  C     | region of the proper array it is responsible for.        |  C     | Each thread then copies data from the buffer to the      
29  C     | =====                                                    |  C     | region of the proper array it is responsible for.        
30  C     | Conversion of flux fields are described in FFIELDS.h     |  C     | =====                                                    
31  C     \==========================================================/  C     | Conversion of flux fields are described in FFIELDS.h      
32    C     *==========================================================*
33    C     \ev
34    
35    C     !USES:
36        IMPLICIT NONE        IMPLICIT NONE
   
37  C     === Global variables ===  C     === Global variables ===
38  #include "SIZE.h"  #include "SIZE.h"
39  #include "EEPARAMS.h"  #include "EEPARAMS.h"
40  #include "PARAMS.h"  #include "PARAMS.h"
41  #include "FFIELDS.h"  #include "FFIELDS.h"
42  #include "GRID.h"  #include "GRID.h"
43    #include "DYNVARS.h"
44          LOGICAL DIFFERENT_MULTIPLE
45          EXTERNAL DIFFERENT_MULTIPLE
46    
47    C     !INPUT/OUTPUT PARAMETERS:
48  C     === Routine arguments ===  C     === Routine arguments ===
49  C     myThid - Thread no. that called this routine.  C     myThid - Thread no. that called this routine.
50  C     myTime - Simulation time  C     myTime - Simulation time
# Line 43  C     myIter - Simulation timestep numbe Line 52  C     myIter - Simulation timestep numbe
52        INTEGER myThid        INTEGER myThid
53        _RL     myTime        _RL     myTime
54        INTEGER myIter        INTEGER myIter
 CEndOfInterface  
55    
 C     === Functions ===  
       LOGICAL DIFFERENT_MULTIPLE  
       EXTERNAL DIFFERENT_MULTIPLE  
56    
57  C     === Local arrays ===  #ifndef INCLUDE_EXTERNAL_FORCING_PACKAGE
       COMMON /TDFIELDS/  
      &                 taux0, tauy0, Qnet0, EmPmR0, SST0, SSS0, Qsw0,  
      &                 taux1, tauy1, Qnet1, EmPmR1, SST1, SSS1, Qsw1  
       _RS  taux0    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  tauy0    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qnet0    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  EmPmR0   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  SST0     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  SSS0     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qsw0     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  taux1    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  tauy1    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qnet1    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  EmPmR1   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  SST1     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  SSS1     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qsw1     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
58    
59  C     === Local variables ===  C     !LOCAL VARIABLES:
60    C     === Local arrays ===
61    C     aWght, bWght :: Interpolation weights
62        INTEGER bi,bj,i,j,intime0,intime1        INTEGER bi,bj,i,j,intime0,intime1
   
63        _RL aWght,bWght,rdt        _RL aWght,bWght,rdt
64        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
65    CEOP
66    
67        IF ( periodicExternalForcing ) THEN        IF ( periodicExternalForcing ) THEN
68    
69  C First call requires that we initialize everything to zero for safety  C First call requires that we initialize everything to zero for safety
70        IF ( myIter .EQ. nIter0 ) THEN  cph    has been shifted to ini_forcing.F
71         CALL LEF_ZERO( taux0 ,myThid )  cph    arrays are now globally visible
72         CALL LEF_ZERO( tauy0 ,myThid )  cph
73         CALL LEF_ZERO( Qnet0 ,myThid )  cph      IF ( myIter .EQ. nIter0 ) THEN
74         CALL LEF_ZERO( EmPmR0 ,myThid )  cph       CALL LEF_ZERO( taux0 ,myThid )
75         CALL LEF_ZERO( SST0 ,myThid )  cph       CALL LEF_ZERO( tauy0 ,myThid )
76         CALL LEF_ZERO( SSS0 ,myThid )  cph       CALL LEF_ZERO( Qnet0 ,myThid )
77         CALL LEF_ZERO( Qsw0 ,myThid )  cph       CALL LEF_ZERO( EmPmR0 ,myThid )
78         CALL LEF_ZERO( taux1 ,myThid )  cph       CALL LEF_ZERO( SST0 ,myThid )
79         CALL LEF_ZERO( tauy1 ,myThid )  cph       CALL LEF_ZERO( SSS0 ,myThid )
80         CALL LEF_ZERO( Qnet1 ,myThid )  cph       CALL LEF_ZERO( Qsw0 ,myThid )
81         CALL LEF_ZERO( EmPmR1 ,myThid )  cph       CALL LEF_ZERO( taux1 ,myThid )
82         CALL LEF_ZERO( SST1 ,myThid )  cph       CALL LEF_ZERO( tauy1 ,myThid )
83         CALL LEF_ZERO( SSS1 ,myThid )  cph       CALL LEF_ZERO( Qnet1 ,myThid )
84         CALL LEF_ZERO( Qsw1 ,myThid )  cph       CALL LEF_ZERO( EmPmR1 ,myThid )
85        ENDIF  cph       CALL LEF_ZERO( SST1 ,myThid )
86    cph       CALL LEF_ZERO( SSS1 ,myThid )
87    cph       CALL LEF_ZERO( Qsw1 ,myThid )
88    cph      ENDIF
89    
90  C Now calculate whether it is time to update the forcing arrays  C Now calculate whether it is time to update the forcing arrays
91        rdt=1. _d 0 / deltaTclock        rdt=1. _d 0 / deltaTclock
# Line 123  C      data for the period ahead and the Line 116  C      data for the period ahead and the
116       &  'S/R EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter       &  'S/R EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter
117    
118        IF ( zonalWindFile .NE. ' '  ) THEN        IF ( zonalWindFile .NE. ' '  ) THEN
119         CALL READ_REC_XY_RS( zonalWindFile,taux0,intime0,myIter,myThid )         CALL MDSREADFIELD ( zonalWindFile, readBinaryPrec,
120         CALL READ_REC_XY_RS( zonalWindFile,taux1,intime1,myIter,myThid )       &        'RS', 1, taux0, intime0, myThid )
121           CALL MDSREADFIELD ( zonalWindFile, readBinaryPrec,
122         &        'RS', 1, taux1, intime1, myThid )
123        ENDIF        ENDIF
124        IF ( meridWindFile .NE. ' '  ) THEN        IF ( meridWindFile .NE. ' '  ) THEN
125         CALL READ_REC_XY_RS( meridWindFile,tauy0,intime0,myIter,myThid )         CALL MDSREADFIELD ( meridWindFile, readBinaryPrec,
126         CALL READ_REC_XY_RS( meridWindFile,tauy1,intime1,myIter,myThid )       &        'RS', 1, tauy0, intime0, myThid )
127           CALL MDSREADFIELD ( meridWindFile, readBinaryPrec,
128         &        'RS', 1, tauy1, intime1, myThid )
129        ENDIF        ENDIF
130        IF ( surfQFile .NE. ' '  ) THEN        IF ( surfQFile .NE. ' '  ) THEN
131         CALL READ_REC_XY_RS( surfQFile,Qnet0,intime0,myIter,myThid )         CALL MDSREADFIELD ( surfQFile, readBinaryPrec,
132         CALL READ_REC_XY_RS( surfQFile,Qnet1,intime1,myIter,myThid )       &        'RS', 1, Qnet0, intime0, myThid )
133           CALL MDSREADFIELD ( surfQFile, readBinaryPrec,
134         &        'RS', 1, Qnet1, intime1, myThid )
135        ENDIF        ENDIF
136        IF ( EmPmRfile .NE. ' '  ) THEN        IF ( EmPmRfile .NE. ' '  ) THEN
137         CALL READ_REC_XY_RS( EmPmRfile,EmPmR0,intime0,myIter,myThid )         CALL MDSREADFIELD ( EmPmRfile, readBinaryPrec,
138         CALL READ_REC_XY_RS( EmPmRfile,EmPmR1,intime1,myIter,myThid )       &        'RS', 1, EmPmR0, intime0, myThid )
139           CALL MDSREADFIELD ( EmPmRfile, readBinaryPrec,
140         &        'RS', 1, EmPmR1, intime1, myThid )
141        ENDIF        ENDIF
142        IF ( thetaClimFile .NE. ' '  ) THEN        IF ( thetaClimFile .NE. ' '  ) THEN
143         CALL READ_REC_XY_RS( thetaClimFile,SST0,intime0,myIter,myThid )         CALL MDSREADFIELD ( thetaClimFile, readBinaryPrec,
144         CALL READ_REC_XY_RS( thetaClimFile,SST1,intime1,myIter,myThid )       &        'RS', 1, SST0, intime0, myThid )
145           CALL MDSREADFIELD ( thetaClimFile, readBinaryPrec,
146         &        'RS', 1, SST1, intime1, myThid )
147        ENDIF        ENDIF
148        IF ( saltClimFile .NE. ' '  ) THEN        IF ( saltClimFile .NE. ' '  ) THEN
149         CALL READ_REC_XY_RS( saltClimFile,SSS0,intime0,myIter,myThid )         CALL MDSREADFIELD ( saltClimFile, readBinaryPrec,
150         CALL READ_REC_XY_RS( saltClimFile,SSS1,intime1,myIter,myThid )       &        'RS', 1, SSS0, intime0, myThid )
151           CALL MDSREADFIELD ( saltClimFile, readBinaryPrec,
152         &        'RS', 1, SSS1, intime1, myThid )
153        ENDIF        ENDIF
154  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
155        IF ( surfQswFile .NE. ' '  ) THEN        IF ( surfQswFile .NE. ' '  ) THEN
156         CALL READ_REC_XY_RS( surfQswFile,Qsw0,intime0,myIter,myThid )         CALL MDSREADFIELD ( surfQswFile, readBinaryPrec,
157         CALL READ_REC_XY_RS( surfQswFile,Qsw1,intime1,myIter,myThid )       &        'RS', 1, Qsw0, intime0, myThid )
158           CALL MDSREADFIELD ( surfQswFile, readBinaryPrec,
159         &        'RS', 1, Qsw1, intime1, myThid )
160        ENDIF        ENDIF
161  #endif  #endif
162    
# Line 159  C Line 166  C
166         _EXCH_XY_R4(SST1  , myThid )         _EXCH_XY_R4(SST1  , myThid )
167         _EXCH_XY_R4(SSS0  , myThid )         _EXCH_XY_R4(SSS0  , myThid )
168         _EXCH_XY_R4(SSS1  , myThid )         _EXCH_XY_R4(SSS1  , myThid )
169         _EXCH_XY_R4(taux0 , myThid )  c      _EXCH_XY_R4(taux0 , myThid )
170         _EXCH_XY_R4(taux1 , myThid )  c      _EXCH_XY_R4(taux1 , myThid )
171         _EXCH_XY_R4(tauy0 , myThid )  c      _EXCH_XY_R4(tauy0 , myThid )
172         _EXCH_XY_R4(tauy1 , myThid )  c      _EXCH_XY_R4(tauy1 , myThid )
173           CALL EXCH_UV_XY_RS(taux0,tauy0,.TRUE.,myThid)
174           CALL EXCH_UV_XY_RS(taux1,tauy1,.TRUE.,myThid)
175         _EXCH_XY_R4(Qnet0, myThid )         _EXCH_XY_R4(Qnet0, myThid )
176         _EXCH_XY_R4(Qnet1, myThid )         _EXCH_XY_R4(Qnet1, myThid )
177         _EXCH_XY_R4(EmPmR0, myThid )         _EXCH_XY_R4(EmPmR0, myThid )
# Line 184  C--   Interpolate fu,fv,Qnet,EmPmR,SST,S Line 193  C--   Interpolate fu,fv,Qnet,EmPmR,SST,S
193            SSS(i,j,bi,bj)   = bWght*SSS0(i,j,bi,bj)              SSS(i,j,bi,bj)   = bWght*SSS0(i,j,bi,bj)  
194       &                       +aWght*SSS1(i,j,bi,bj)       &                       +aWght*SSS1(i,j,bi,bj)
195            fu(i,j,bi,bj)    = -(bWght*taux0(i,j,bi,bj)            fu(i,j,bi,bj)    = -(bWght*taux0(i,j,bi,bj)
196       &                       +aWght*taux1(i,j,bi,bj))       &                         +aWght*taux1(i,j,bi,bj))
197            fv(i,j,bi,bj)    = -(bWght*tauy0(i,j,bi,bj)            fv(i,j,bi,bj)    = -(bWght*tauy0(i,j,bi,bj)
198       &                       +aWght*tauy1(i,j,bi,bj))       &                         +aWght*tauy1(i,j,bi,bj))
199            Qnet(i,j,bi,bj)  = bWght*Qnet0(i,j,bi,bj)            Qnet(i,j,bi,bj)  = bWght*Qnet0(i,j,bi,bj)
200       &                       +aWght*Qnet1(i,j,bi,bj)       &                       +aWght*Qnet1(i,j,bi,bj)
201            EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)            EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
# Line 200  C--   Interpolate fu,fv,Qnet,EmPmR,SST,S Line 209  C--   Interpolate fu,fv,Qnet,EmPmR,SST,S
209         ENDDO         ENDDO
210        ENDDO        ENDDO
211    
212    C-- Diagnostics
213    cph      IF (myThid.EQ.1 .AND. myTime.LT.62208000.) THEN
214    cph        write(*,'(a,1p7e12.4,2i6,2e12.4)')
215    cph     &   'time,SST,SSS,fu,fv,Q,E-P,i0,i1,a,b = ',
216    cph     &   myTime,
217    cph     &   SST(1,sNy,1,1),SSS(1,sNy,1,1),
218    cph     &   fu(1,sNy,1,1),fv(1,sNy,1,1),
219    cph     &   Qnet(1,sNy,1,1),EmPmR(1,sNy,1,1),
220    cph     &   intime0,intime1,aWght,bWght
221    cph        write(*,'(a,1p7e12.4)')
222    cph     &   'time,fu0,fu1,fu = ',
223    cph     &   myTime,
224    cph     &   taux0(1,sNy,1,1),taux1(1,sNy,1,1),fu(1,sNy,1,1),
225    cph     &   aWght,bWght
226    cph      ENDIF
227    
228  C endif for periodicForcing  C endif for periodicForcing
229        ENDIF        ENDIF
230    
231    #endif /* INCLUDE_EXTERNAL_FORCING_PACKAGE undef */
232    
233        RETURN        RETURN
234        END        END
235    
236    CBOP
237    C     !ROUTINE: LEF_ZERO
238    C     !INTERFACE:
239        SUBROUTINE LEF_ZERO( arr ,myThid )        SUBROUTINE LEF_ZERO( arr ,myThid )
240    C     !DESCRIPTION: \bv
241  C     This routine simply sets the argument array to zero  C     This routine simply sets the argument array to zero
242  C     Used only by EXTERNAL_FIELDS_LOAD  C     Used only by EXTERNAL_FIELDS_LOAD
243    C     \ev
244    C     !USES:
245        IMPLICIT NONE        IMPLICIT NONE
246  C     === Global variables ===  C     === Global variables ===
247  #include "SIZE.h"  #include "SIZE.h"
248  #include "EEPARAMS.h"  #include "EEPARAMS.h"
249    C     !INPUT/OUTPUT PARAMETERS:
250  C     === Arguments ===  C     === Arguments ===
251        _RS  arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RS  arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
252        INTEGER myThid        INTEGER myThid
253    C     !LOCAL VARIABLES:
254  C     === Local variables ===  C     === Local variables ===
255        INTEGER i,j,bi,bj        INTEGER i,j,bi,bj
256    CEOP
257    
258        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
259         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22