/[MITgcm]/MITgcm/pkg/dic/dic_read_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/dic/dic_read_pickup.F

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

revision 1.1 by dfer, Tue Mar 11 20:56:14 2008 UTC revision 1.4 by dfer, Mon Apr 7 20:31:16 2008 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
 #include "GCHEM_OPTIONS.h"  
4  #include "DIC_OPTIONS.h"  #include "DIC_OPTIONS.h"
5    
6        SUBROUTINE DIC_READ_PICKUP( myIter, myThid )        SUBROUTINE DIC_READ_PICKUP(
7         O                            pH_isLoaded,
8         I                            myIter, myThid )
9    
10        IMPLICIT NONE        IMPLICIT NONE
11  C     === Global variables ===  C     === Global variables ===
12  #include "SIZE.h"  #include "SIZE.h"
13  #include "EEPARAMS.h"  #include "EEPARAMS.h"
14  #include "PARAMS.h"  #include "PARAMS.h"
15  #include "DIC_ABIOTIC.h"  #include "DIC_VARS.h"
16    
17  C     == Routine arguments ==  C     == Routine arguments ==
18  C     myThid -  Number of this instance of DIC_READ_CHECKPOINT  C     myThid  :: my Thread Id number
19          LOGICAL ph_isLoaded
20        INTEGER myIter        INTEGER myIter
21        INTEGER myThid        INTEGER myThid
22    
23  #ifdef ALLOW_DIC  #ifdef ALLOW_DIC
24  #ifdef DIC_BIOTIC  #ifdef DIC_BIOTIC
25    
26    C     !FUNCTIONS
27          INTEGER  IFNBLNK, ILNBLNK
28          EXTERNAL IFNBLNK, ILNBLNK
29    
30  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
31  C     == Local variables ==  C     == Local variables ==
32        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn, dFileName
33        CHARACTER*(10) suff        CHARACTER*(MAX_LEN_MBUF) msgBuf
34        INTEGER prec        LOGICAL fileExist, shareExist
35          INTEGER fp, iL, i, ioUnit
36    
37          COMMON / LOCAL_DIC_PICKUP / shareExist
38  CEOP  CEOP
39    
40  C--   Suffix for pickup files        ph_isLoaded =.FALSE.
41          ioUnit = errorMessageUnit
42    
43    C--   pickup file name :
44        IF (pickupSuff.EQ.' ') THEN        IF (pickupSuff.EQ.' ') THEN
45           WRITE(suff,'(I10.10)') myIter          WRITE(fn,'(A,I10.10)') 'pickup_dic.', myIter
46        ELSE        ELSE
47           WRITE(suff,'(A10)') pickupSuff          WRITE(fn,'(A,A10)') 'pickup_dic.', pickupSuff
48        ENDIF        ENDIF
49          fp = precFloat64
50    
51        _BARRIER        _BARRIER
52          _BEGIN_MASTER( myThid )
53    
54        prec = precFloat64  C--   First check if pickup file exist
55          fileExist = .FALSE.
56          iL = ILNBLNK(fn)
57          IF ( .NOT.fileExist ) THEN
58    C-    look for file = {fn}
59            WRITE(dFileName,'(A)') fn(1:iL)
60            i = iL
61            INQUIRE( FILE=dFileName, EXIST=fileExist )
62          ENDIF
63          IF ( .NOT.fileExist ) THEN
64    C-    look for file = {fn}'.data'
65            WRITE(dFileName,'(2A)') fn(1:iL), '.data'
66            i = iL + 5
67            INQUIRE( FILE=dFileName, EXIST=fileExist )
68          ENDIF
69          IF ( .NOT.fileExist ) THEN
70    C-    look for file = {fn}'.001.001.data'
71            WRITE(dFileName,'(2A)') fn(1:iL), '.001.001.data'
72            i = iL + 5 + 8
73            INQUIRE( FILE=dFileName, EXIST=fileExist )
74          ENDIF
75          shareExist = fileExist
76    
77        WRITE(fn,'(A,A10)') 'pickup_dic.',suff        IF ( .NOT.fileExist ) THEN
78        CALL READ_REC_3D_RL( fn, prec, 1, pH, 1, myIter, myThid )          WRITE(msgBuf,'(4A)') 'WARNING >> DIC_READ_PICKUP: file: ',
79         &          fn(1:iL), ' , .data , ', dFileName(1:i)
80            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
81            WRITE(msgBuf,'(A)')
82         &           'WARNING >> DIC_READ_PICKUP: Files DO not exist'
83            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
84          ENDIF
85    
86        _EXCH_XY_R8( pH, myThid )        _END_MASTER( myThid )
87          _BARRIER
88    
89          IF ( shareExist ) THEN
90    C--   Read pickup file
91            CALL READ_REC_3D_RL( fn, fp, 1, pH, 1, myIter, myThid )
92            pH_isLoaded = .TRUE.
93    
94            _EXCH_XY_R8( pH, myThid )
95          ELSE
96            pH_isLoaded = .FALSE.
97            IF ( pickupStrictlyMatch ) THEN
98              WRITE(msgBuf,'(4A)') 'DIC_READ_PICKUP: ',
99         &      'try with " pickupStrictlyMatch=.FALSE.,"',
100         &      ' in file: "data", NameList: "PARM03"'
101              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
102              STOP 'ABNORMAL END: S/R DIC_READ_PICKUP'
103            ELSE
104              WRITE(msgBuf,'(4A)') 'DIC_READ_PICKUP: ',
105         &      'will restart from approximated pH'
106              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
107            ENDIF
108          ENDIF
109    
110  #endif /*  DIC_BIOTIC  */  #endif /*  DIC_BIOTIC  */
111  #endif /*  ALLOW_DIC  */  #endif /*  ALLOW_DIC  */
112    
113        RETURN        RETURN
114        END        END
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22