/[MITgcm]/MITgcm/pkg/atm_compon_interf/atm_cpl_read_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/atm_compon_interf/atm_cpl_read_pickup.F

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

revision 1.1 by jmc, Fri May 21 19:59:38 2004 UTC revision 1.6 by jmc, Fri Dec 25 04:38:42 2015 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "ATM_CPL_OPTIONS.h"
5    
6  CStartOfInterface  CBOP
7    C     !ROUTINE: ATM_CPL_READ_PICKUP
8    C     !INTERFACE:
9        SUBROUTINE ATM_CPL_READ_PICKUP( myIter, myThid )        SUBROUTINE ATM_CPL_READ_PICKUP( myIter, myThid )
10    
11    C     !DESCRIPTION: \bv
12  C     *==========================================================*  C     *==========================================================*
13  C     | SUBROUTINE ATM_CPL_READ_PICKUP  C     | SUBROUTINE ATM_CPL_READ_PICKUP
14  C     | o Reads fields from a pickup file for a restart  C     | o Reads fields from a pickup file for a restart
15  C     *==========================================================*  C     *==========================================================*
16  C     *==========================================================*  C     *==========================================================*
17    C     \ev
18    
19    C     !USES:
20        IMPLICIT NONE        IMPLICIT NONE
21    
22  C     == Global variables ==  C     == Global variables ==
# Line 17  C     == Global variables == Line 24  C     == Global variables ==
24  #include "EEPARAMS.h"  #include "EEPARAMS.h"
25  #include "PARAMS.h"  #include "PARAMS.h"
26  #include "CPL_PARAMS.h"  #include "CPL_PARAMS.h"
27    #include "ATMIDS.h"
28  #include "ATMCPL.h"  #include "ATMCPL.h"
29    
30  C     == Routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
31  C     myIter  :: time-step number  C     myIter  :: Current time-step number
32  C     myThid  :: Thread number for this instance of the routine  C     myThid  :: my Thread Id number
33        INTEGER myIter        INTEGER myIter
34        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
35    
36  #ifdef COMPONENT_MODULE  #ifdef COMPONENT_MODULE
37  C     == Local variables ==  C     !LOCAL VARIABLES:
38        INTEGER prec  C     fn          :: character buffer for creating filename
39    C     fp          :: precision of pickup files
40    C     filePrec    :: pickup-file precision (read from meta file)
41    C     nbFields    :: number of fields in pickup file (read from meta file)
42    C     missFldList :: List of missing fields   (attempted to read but not found)
43    C     missFldDim  :: Dimension of missing fields list array: missFldList
44    C     nMissing    :: Number of missing fields (attempted to read but not found)
45    C     j           :: loop index
46    C     nj          :: record number
47    C     ioUnit      :: temp for writing msg unit
48    C     msgBuf      :: Informational/error message buffer
49          INTEGER fp
50          INTEGER filePrec, nbFields
51          INTEGER missFldDim, nMissing
52          INTEGER j, nj, ioUnit
53          PARAMETER( missFldDim = 18 )
54        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
55          CHARACTER*(8) missFldList(missFldDim)
56          CHARACTER*(MAX_LEN_MBUF) msgBuf
57          INTEGER i, bi, bj
58    CEOP
59    
60    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
61    
62           IF ( pickupSuff.EQ.' ' ) THEN
63            WRITE(fn,'(A,I10.10)') 'pickup_cpl.',myIter
64           ELSE
65            WRITE(fn,'(A,A10)') 'pickup_cpl.',pickupSuff
66           ENDIF
67           fp = precFloat64
68    
69        WRITE(fn,'(A,I10.10)') 'pickup_cpl.',myIter         CALL READ_MFLDS_SET(
70        prec = precFloat64       I                      fn,
71         O                      nbFields, filePrec,
72         I                      Nr, myIter, myThid )
73           _BEGIN_MASTER( myThid )
74    c      IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
75           IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
76             WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ',
77         &    'pickup-file binary precision do not match !'
78             CALL PRINT_ERROR( msgBuf, myThid )
79             WRITE(msgBuf,'(A,2(A,I4))') 'ATM_CPL_READ_PICKUP: ',
80         &    'file prec.=', filePrec, ' but expecting prec.=', fp
81             CALL PRINT_ERROR( msgBuf, myThid )
82             CALL ALL_PROC_DIE( 0 )
83             STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (data-prec Pb)'
84           ENDIF
85           _END_MASTER( myThid )
86    
87        IF ( cpl_oldPickup ) THEN         IF ( nbFields.LE.0 ) THEN
88          CALL MDSREADFIELD(fn,prec,'RL',1,SSTocn    , 1,myThid)  C-      No meta-file or old meta-file without List of Fields
89          CALL MDSREADFIELD(fn,prec,'RL',1,HeatFlux  , 2,myThid)          ioUnit = errorMessageUnit
90          CALL MDSREADFIELD(fn,prec,'RL',1,tauX      , 3,myThid)          IF ( pickupStrictlyMatch ) THEN
91          CALL MDSREADFIELD(fn,prec,'RL',1,tauY      , 4,myThid)            WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
92          CALL MDSREADFIELD(fn,prec,'RL',1,EvMPrFlux , 5,myThid)       &      'no field-list found in meta-file',
93          CALL MDSREADFIELD(fn,prec,'RL',1,RunOffFlux, 6,myThid)       &      ' => cannot check for strick-matching'
94  c       CALL MDSREADFIELD(fn,prec,'RL',1,uVelGround, 7,myThid)            CALL PRINT_ERROR( msgBuf, myThid )
95  c       CALL MDSREADFIELD(fn,prec,'RL',1,vVelGround, 8,myThid)            WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
96  c       CALL MDSREADFIELD(fn,prec,'RL',1,qLatent   , 9,myThid)       &      'try with " pickupStrictlyMatch=.FALSE.,"',
97  c       CALL MDSREADFIELD(fn,prec,'RL',1,qSensible ,10,myThid)       &      ' in file: "data", NameList: "PARM03"'
98  c       CALL MDSREADFIELD(fn,prec,'RL',1,qLongwave ,11,myThid)            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
99  c       CALL MDSREADFIELD(fn,prec,'RL',1,qShortwave,12,myThid)            CALL ALL_PROC_DIE( myThid )
100        ELSE            STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
101          CALL MDSREADFIELD(fn,prec,'RL',1, ocMxlD   , 1,myThid)          ELSE
102          CALL MDSREADFIELD(fn,prec,'RL',1, SSTocn   , 2,myThid)            WRITE(msgBuf,'(4A)') 'WARNING >> ATM_CPL_READ_PICKUP: ',
103          CALL MDSREADFIELD(fn,prec,'RL',1, SSSocn   , 3,myThid)       &      ' no field-list found'
104          CALL MDSREADFIELD(fn,prec,'RL',1, vSqocn   , 4,myThid)            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
105         IF ( cpl_earlyExpImpCall ) THEN           IF ( nbFields.EQ.-1 ) THEN
106          CALL MDSREADFIELD(fn,prec,'RL',1,atmSLPr   , 5,myThid)  C-      No meta-file
107          CALL MDSREADFIELD(fn,prec,'RL',1,HeatFlux  , 6,myThid)            WRITE(msgBuf,'(4A)') 'WARNING >> ',
108          CALL MDSREADFIELD(fn,prec,'RL',1,qShortWave, 7,myThid)       &      ' try to read pickup as currently written'
109          CALL MDSREADFIELD(fn,prec,'RL',1,tauX      , 8,myThid)            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
110          CALL MDSREADFIELD(fn,prec,'RL',1,tauY      , 9,myThid)           ELSE
111          CALL MDSREADFIELD(fn,prec,'RL',1,EvMPrFlux ,10,myThid)  C-      Old meta-file without List of Fields
112          CALL MDSREADFIELD(fn,prec,'RL',1,RunOffFlux,11,myThid)            WRITE(msgBuf,'(4A)') 'WARNING >> ',
113          CALL MDSREADFIELD(fn,prec,'RL',1,RunOffEnFx,12,myThid)       &      ' try to read pickup as it used to be written'
114          CALL MDSREADFIELD(fn,prec,'RL',1,iceSaltFlx,13,myThid)            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
115          CALL MDSREADFIELD(fn,prec,'RL',1,seaIceMass,14,myThid)            WRITE(msgBuf,'(4A)') 'WARNING >> ',
116         &      ' until checkpoint65r (2015 Dec 21)'
117              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
118    c         WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
119    c    &      'no field-list found in meta-file'
120    c         CALL PRINT_ERROR( msgBuf, myThid )
121    c         CALL ALL_PROC_DIE( myThid )
122    c         STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
123             ENDIF
124            ENDIF
125         ENDIF         ENDIF
126    
127    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128    
129           IF ( nbFields.EQ.0 ) THEN
130    C---   Old way to read pickup:
131    
132    c       CALL READ_REC_3D_RL( fn, fp, 1, ocMxlD    ,  1, myIter,myThid )
133    c       CALL READ_REC_3D_RL( fn, fp, 1, SSTocn    ,  2, myIter,myThid )
134    c       CALL READ_REC_3D_RL( fn, fp, 1, SSSocn    ,  3, myIter,myThid )
135    c       CALL READ_REC_3D_RL( fn, fp, 1, vSqocn    ,  4, myIter,myThid )
136            CALL READ_REC_3D_RL( fn, fp, 1, atmSLPr   ,  5, myIter,myThid )
137            CALL READ_REC_3D_RL( fn, fp, 1, HeatFlux  ,  6, myIter,myThid )
138            CALL READ_REC_3D_RL( fn, fp, 1, qShortWave,  7, myIter,myThid )
139            CALL READ_REC_3D_RL( fn, fp, 1, tauX      ,  8, myIter,myThid )
140            CALL READ_REC_3D_RL( fn, fp, 1, tauY      ,  9, myIter,myThid )
141            CALL READ_REC_3D_RL( fn, fp, 1, EvMPrFlux , 10, myIter,myThid )
142    #ifdef ALLOW_LAND
143            CALL READ_REC_3D_RL( fn, fp, 1, RunOffFlux, 11, myIter,myThid )
144            CALL READ_REC_3D_RL( fn, fp, 1, RunOffEnFx, 12, myIter,myThid )
145    #endif /* ALLOW_LAND */
146    #ifdef ALLOW_THSICE
147            CALL READ_REC_3D_RL( fn, fp, 1, iceSaltFlx, 13, myIter,myThid )
148    c       CALL READ_REC_3D_RL( fn, fp, 1, seaIceMass, 14, myIter,myThid )
149    #endif /* ALLOW_THSICE */
150    #ifdef ALLOW_AIM
151            IF ( atm_cplExch_DIC ) THEN
152    c        CALL READ_REC_3D_RL( fn,fp, 1, flxCO2ocn , 15, myIter,myThid )
153             CALL READ_REC_3D_RL( fn,fp, 1, airCO2    , 16, myIter,myThid )
154             CALL READ_REC_3D_RL( fn,fp, 1, sWSpeed   , 17, myIter,myThid )
155    # ifdef ALLOW_THSICE
156    c        CALL READ_REC_3D_RL( fn,fp, 1, fracIce   , 18, myIter,myThid )
157    # endif /* ALLOW_THSICE */
158            ENDIF
159    #endif /* ALLOW_AIM */
160    
161           ELSE
162    C---   New way to read ATM_CPL pickup:
163            nj = 0
164    C---    read ATM_CPL 3-D fields for restart
165            nj = nj*Nr
166    
167    C---    read ATM_CPL 2-D fields for restart
168            CALL READ_MFLDS_3D_RL( 'SLPress ', atmSLPr,
169         &                                 nj, fp, 1 , myIter, myThid )
170            CALL READ_MFLDS_3D_RL( 'qHeatFlx', HeatFlux,
171         &                                 nj, fp, 1 , myIter, myThid )
172            CALL READ_MFLDS_3D_RL( 'qShortW ', qShortWave,
173         &                                 nj, fp, 1 , myIter, myThid )
174            CALL READ_MFLDS_3D_RL( 'surfTauX', tauX,
175         &                                 nj, fp, 1 , myIter, myThid )
176            CALL READ_MFLDS_3D_RL( 'surfTauY', tauY,
177         &                                 nj, fp, 1 , myIter, myThid )
178            CALL READ_MFLDS_3D_RL( 'Evp-Prec', EvMPrFlux,
179         &                                 nj, fp, 1 , myIter, myThid )
180    #ifdef ALLOW_LAND
181            IF ( atm_cplExch_RunOff ) THEN
182             CALL READ_MFLDS_3D_RL('RunOffFx', RunOffFlux,
183         &                                 nj, fp, 1 , myIter, myThid )
184             CALL READ_MFLDS_3D_RL('RnOfEnFx', RunOffEnFx,
185         &                                 nj, fp, 1 , myIter, myThid )
186            ENDIF
187    #endif /* ALLOW_LAND */
188    #ifdef ALLOW_THSICE
189            IF ( atm_cplExch1W_sIce ) THEN
190             CALL READ_MFLDS_3D_RL('saltFlux', iceSaltFlx,
191         &                                 nj, fp, 1 , myIter, myThid )
192            ENDIF
193    c       IF ( atm_cplExch_SaltPl ) THEN
194    c        CALL READ_MFLDS_3D_RL('sltPlmFx', saltPlmFlx,
195    c    &                                 nj, fp, 1 , myIter, myThid )
196    c       ENDIF
197    #endif /* ALLOW_THSICE */
198    #ifdef ALLOW_AIM
199            IF ( atm_cplExch_DIC ) THEN
200             CALL READ_MFLDS_3D_RL('atm-CO2 ', airCO2,
201         &                                 nj, fp, 1 , myIter, myThid )
202             CALL READ_MFLDS_3D_RL('wndSpeed', sWSpeed,
203         &                                 nj, fp, 1 , myIter, myThid )
204            ENDIF
205    #endif /* ALLOW_AIM */
206    
207    C--    end: new way to read pickup file
208           ENDIF
209    
210    C--    Check for missing fields:
211           nMissing = missFldDim
212           CALL READ_MFLDS_CHECK(
213         O                     missFldList,
214         U                     nMissing,
215         I                     myIter, myThid )
216           IF ( nMissing.GT.missFldDim ) THEN
217             WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ',
218         &     'missing fields list has been truncated to', missFldDim
219             CALL PRINT_ERROR( msgBuf, myThid )
220             CALL ALL_PROC_DIE( myThid )
221             STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (list-size Pb)'
222           ENDIF
223           IF ( nMissing.GE.1 ) THEN
224            ioUnit = errorMessageUnit
225            DO j=1,nMissing
226             WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
227         &       'cannot restart without field "',missFldList(nj),'"'
228             CALL PRINT_ERROR( msgBuf, myThid )
229            ENDDO
230            CALL ALL_PROC_DIE( myThid )
231            STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
232           ENDIF
233    
234    C--    Update overlap regions:
235    
236    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
237    
238          IF ( cpl_oldPickup ) THEN
239            _BARRIER
240    C-    EmP & RunOff were (before checkpoint59h) in m/s , but are now in kg/m2/s:
241            DO bj = myByLo(myThid), myByHi(myThid)
242             DO bi = myBxLo(myThid), myBxHi(myThid)
243              DO j=1-OLy,sNy+OLy
244               DO i=1-OLx,sNx+OLx
245                EvMPrFlux (i,j,bi,bj) = EvMPrFlux (i,j,bi,bj)*rhoConstFresh
246    #ifdef ALLOW_LAND
247                RunOffFlux(i,j,bi,bj) = RunOffFlux(i,j,bi,bj)*rhoConstFresh
248    #endif /* ALLOW_LAND */
249               ENDDO
250              ENDDO
251             ENDDO
252            ENDDO
253        ENDIF        ENDIF
254    
255  #endif /* COMPONENT_MODULE */  #endif /* COMPONENT_MODULE */
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22