/[MITgcm]/MITgcm/pkg/ptracers/ptracers_read_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_read_pickup.F

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

revision 1.9 by jmc, Fri Jan 25 23:18:42 2008 UTC revision 1.15 by jmc, Thu Mar 8 17:05:44 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "GAD_OPTIONS.h"
5  #include "PTRACERS_OPTIONS.h"  #include "PTRACERS_OPTIONS.h"
6    
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
7  CBOP  CBOP
8  C     !ROUTINE: PTRACERS_READ_PICKUP  C     !ROUTINE: PTRACERS_READ_PICKUP
9    
# Line 14  C     !DESCRIPTION: Line 14  C     !DESCRIPTION:
14  C     Reads current state of passive tracers from a pickup file  C     Reads current state of passive tracers from a pickup file
15    
16  C     !USES:  C     !USES:
17    #include "PTRACERS_MOD.h"
18        IMPLICIT NONE        IMPLICIT NONE
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "EEPARAMS.h"  #include "EEPARAMS.h"
21  #include "PARAMS.h"  #include "PARAMS.h"
22    #include "GAD.h"
23  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
24  #include "PTRACERS_PARAMS.h"  #include "PTRACERS_PARAMS.h"
25  #include "PTRACERS_RESTART.h"  #include "PTRACERS_START.h"
26  #include "PTRACERS_FIELDS.h"  #include "PTRACERS_FIELDS.h"
27    
28  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 51  C     msgBuf      :: Informational/error Line 53  C     msgBuf      :: Informational/error
53        INTEGER missFldDim, nMissing        INTEGER missFldDim, nMissing
54        INTEGER nj, ioUnit        INTEGER nj, ioUnit
55        PARAMETER( missFldDim = 2*PTRACERS_num )        PARAMETER( missFldDim = 2*PTRACERS_num )
56        CHARACTER*(MAX_LEN_MBUF) fn        CHARACTER*(MAX_LEN_FNAM) fn
57        CHARACTER*(8) fldName, missFldList(missFldDim)        CHARACTER*(8) fldName, missFldList(missFldDim)
58        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
59    #ifdef PTRACERS_ALLOW_DYN_STATE
60          INTEGER n
61    #endif
62  CEOP  CEOP
63    
64        _BARRIER  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
65    
66  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
67        IF ( PTRACERS_pickup_read_mnc ) THEN        IF ( PTRACERS_pickup_read_mnc ) THEN
# Line 68  C       Read variables from the pickup f Line 73  C       Read variables from the pickup f
73          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
74            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
75       &         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)       &         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)
76            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
77       &                     Nr, myThid )       &                     Nr, myThid )
78          ENDDO          ENDDO
79          CALL MNC_CW_SET_UDIM(fn, 2, myThid)          CALL MNC_CW_SET_UDIM(fn, 2, myThid)
80          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
81            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
82       &         pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)       &         pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
83            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
84       &                     Nr, myThid )       &                     Nr, myThid )
85          ENDDO          ENDDO
86        ENDIF        ENDIF
87          IF ( useMNC .AND. PTRACERS_pickup_read_mnc ) THEN
88           DO iTracer = 1, PTRACERS_numInUse
89            IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
90             WRITE(msgBuf,'(3A)')'PTRACERS_READ_PICKUP: MNC not yet coded',
91         &                       ' for SOM advection',
92         &                       ' => read bin file instead'
93             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
94         &                       SQUEEZE_RIGHT, myThid)
95            ENDIF
96           ENDDO
97          ENDIF
98  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
99    
100        IF ( PTRACERS_pickup_read_mdsio ) THEN        IF ( PTRACERS_pickup_read_mdsio ) THEN
# Line 151  C       Read fields as consecutive recor Line 167  C       Read fields as consecutive recor
167          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
168            iRec = iTracer            iRec = iTracer
169            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
170       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),       O         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
171       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
172            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
173       &                     Nr, myThid )       &                     Nr, myThid )
174          ENDDO          ENDDO
175    
# Line 161  C       Read historical tendencies as co Line 177  C       Read historical tendencies as co
177  c       DO iTracer = 1,PTRACERS_numInUse  c       DO iTracer = 1,PTRACERS_numInUse
178  c         iRec = iTracer + PTRACERS_num  c         iRec = iTracer + PTRACERS_num
179  c         CALL READ_REC_3D_RL( fn, prec, Nr,  c         CALL READ_REC_3D_RL( fn, prec, Nr,
180  c    O         gPtr(1-Olx,1-Oly,1,1,1,iTracer),  c    O         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
181  c    I         iRec, myIter, myThid )  c    I         iRec, myIter, myThid )
182  c         CALL EXCH_3D_RL( gPtr(1-Olx,1-Oly,1,1,1,iTracer),  c         CALL EXCH_3D_RL( gPtr(1-OLx,1-OLy,1,1,1,iTracer),
183  c    &                     Nr, myThid )  c    &                     Nr, myThid )
184  c       ENDDO  c       ENDDO
185          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
186            iRec = iTracer + PTRACERS_num*2            iRec = iTracer + PTRACERS_num*2
187            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
188       O         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),       O         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
189       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
190            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
191       &                     Nr, myThid )       &                     Nr, myThid )
192          ENDDO          ENDDO
193    
# Line 184  C       tracers, with write_pickup dumpi Line 200  C       tracers, with write_pickup dumpi
200          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
201            iRec = 2*iTracer -1            iRec = 2*iTracer -1
202            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
203       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),       O         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
204       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
205            iRec = 2*iTracer            iRec = 2*iTracer
206            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
207       O         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),       O         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
208       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
209            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
210       &                     Nr, myThid )       &                     Nr, myThid )
211            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
212       &                     Nr, myThid )       &                     Nr, myThid )
213          ENDDO          ENDDO
214    
# Line 203  C---   New way to read ptracer pickup: Line 219  C---   New way to read ptracer pickup:
219  C---    read pTracer 3-D fields for restart  C---    read pTracer 3-D fields for restart
220            fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//'   '            fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//'   '
221            CALL READ_MFLDS_3D_RL( fldName,            CALL READ_MFLDS_3D_RL( fldName,
222       O                     pTracer(1-Olx,1-Oly,1,1,1,iTracer),       O                     pTracer(1-OLx,1-OLy,1,1,1,iTracer),
223       &                     nj, prec, Nr, myIter, myThid )       &                     nj, prec, Nr, myIter, myThid )
224            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
225       &                     Nr, myThid )       &                     Nr, myThid )
226          ENDDO          ENDDO
227          DO iTracer = 1, PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
# Line 213  C---    read pTracer 3-D tendencies for Line 229  C---    read pTracer 3-D tendencies for
229           IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN           IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
230            fldName = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'            fldName = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'
231            CALL READ_MFLDS_3D_RL( fldName,            CALL READ_MFLDS_3D_RL( fldName,
232       O                     gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),       O                     gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
233       &                     nj, prec, Nr, myIter, myThid )       &                     nj, prec, Nr, myIter, myThid )
234            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),            CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
235       &                     Nr, myThid )       &                     Nr, myThid )
236           ENDIF           ENDIF
237          ENDDO          ENDDO
# Line 239  C--    Check for missing fields: Line 255  C--    Check for missing fields:
255       I                     missFldList,       I                     missFldList,
256       I                     nMissing, nbFields,       I                     nMissing, nbFields,
257       I                     myIter, myThid )       I                     myIter, myThid )
258         _BARRIER  
259    #ifdef PTRACERS_ALLOW_DYN_STATE
260    C--   Read pickup file with 2nd.Order moment fields
261           DO iTracer = 1, PTRACERS_numInUse
262            IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
263    
264             IF (pickupSuff .EQ. ' ') THEN
265               WRITE(fn,'(3A,I10.10)') 'pickup_somTRAC',
266         &                     PTRACERS_ioLabel(iTracer),'.', myIter
267             ELSE
268               WRITE(fn,'(3A,A10)') 'pickup_somTRAC',
269         &                     PTRACERS_ioLabel(iTracer),'.', pickupSuff
270             ENDIF
271             WRITE(msgBuf,'(A,I3,A)')'PTRACERS_READ_PICKUP: iTracer = ',
272         &                      iTracer,
273         &                      ' : reading 2nd-order moments from file '
274             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
275         &                      SQUEEZE_RIGHT, myThid)
276             CALL PRINT_MESSAGE( fn, standardMessageUnit,
277         &                      SQUEEZE_RIGHT, myThid)
278             prec = precFloat64
279    C        Read 2nd Order moments as consecutive records
280             DO n=1,nSOM
281               iRec = n
282               CALL READ_REC_3D_RL( fn, prec, Nr,
283         O               _Ptracers_som(:,:,:,:,:,n,iTracer),
284         I               iRec, myIter, myThid )
285             ENDDO
286             CALL GAD_EXCH_SOM( _Ptracers_som(:,:,:,:,:,:,iTracer),
287         &                      Nr, myThid )
288            ENDIF
289           ENDDO
290    #endif /* PTRACERS_ALLOW_DYN_STATE */
291    
292  C--   end: pickup_read_mdsio  C--   end: pickup_read_mdsio
293        ENDIF        ENDIF
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22