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

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

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


Revision 1.5 - (hide annotations) (download)
Thu Apr 10 00:49:25 2008 UTC (16 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint61b, checkpoint61c, checkpoint61a
Changes since 1.4: +14 -4 lines
fix for case where tiled pickup files are in different directory
 (e.g.: using "rank_XX" dir in coupled set-up).

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

  ViewVC Help
Powered by ViewVC 1.1.22