/[MITgcm]/MITgcm/pkg/bling/bling_read_pickup.F
ViewVC logotype

Contents of /MITgcm/pkg/bling/bling_read_pickup.F

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


Revision 1.3 - (show annotations) (download)
Fri Mar 24 23:34:13 2017 UTC (7 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.2: +11 -6 lines
use new S/R RW_GET_SUFFIX to get file suffix (according to "rwSuffixType")

1 C $Header: /u/gcmpack/MITgcm/pkg/bling/bling_read_pickup.F,v 1.2 2016/09/12 20:00:28 mmazloff Exp $
2 C $Name: $
3
4 #include "BLING_OPTIONS.h"
5
6 CBOP
7 subroutine BLING_READ_PICKUP(
8 O pH_isLoaded,
9 I myIter, myThid )
10
11 C ==========================================================
12 C | subroutine bling_read_pickup
13 C | o Read BLING arrays from a pickup file
14 C ==========================================================
15
16 IMPLICIT NONE
17
18 C === Global variables ===
19 #include "SIZE.h"
20 #include "EEPARAMS.h"
21 #include "PARAMS.h"
22 #include "BLING_VARS.h"
23
24 C == Routine arguments ==
25 C myThid :: my Thread Id number
26 LOGICAL pH_isLoaded
27 INTEGER myIter
28 INTEGER myThid
29
30 #ifdef ALLOW_BLING
31
32 C !FUNCTIONS
33
34 C !LOCAL VARIABLES:
35 CHARACTER*(10) suff
36 CHARACTER*(MAX_LEN_FNAM) fn, filNam
37 CHARACTER*(MAX_LEN_MBUF) msgBuf
38 LOGICAL useCurrentDir, fileExist
39 INTEGER fp, ioUnit
40 CEOP
41
42 pH_isLoaded =.FALSE.
43 ioUnit = errorMessageUnit
44
45 C-- pickup file name :
46 IF (pickupSuff.EQ.' ') THEN
47 IF ( rwSuffixType.EQ.0 ) THEN
48 WRITE(fn,'(A,I10.10)') 'pickup_bling.', myIter
49 ELSE
50 CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
51 WRITE(fn,'(A,A)') 'pickup_bling.', myIter
52 ENDIF
53 ELSE
54 WRITE(fn,'(A,A10)') 'pickup_bling.', pickupSuff
55 ENDIF
56 fp = precFloat64
57
58 C-- First check if pickup file exist
59 #ifdef ALLOW_MDSIO
60 useCurrentDir = .FALSE.
61 CALL MDS_CHECK4FILE(
62 I fn, '.data', 'BLING_READ_PICKUP',
63 O filNam, fileExist,
64 I useCurrentDir, myThid )
65 #else
66 STOP 'ABNORMAL END: S/R BLING_READ_PICKUP: Needs MDSIO pkg'
67 #endif
68
69 IF ( fileExist ) THEN
70 C-- Read pickup file
71 CALL READ_REC_3D_RL( fn, fp, Nr, pH, 1, myIter, myThid )
72 pH_isLoaded = .TRUE.
73
74 CALL READ_REC_3D_RL( fn, fp, Nr, irr_mem, 2, myIter, myThid )
75 CALL READ_REC_3D_RL( fn, fp, Nr, chl, 3, myIter, myThid )
76 CALL READ_REC_3D_RL( fn, fp, Nr, phyto_sm, 4, myIter, myThid )
77 CALL READ_REC_3D_RL( fn, fp, Nr, phyto_lg, 5, myIter, myThid )
78 CALL READ_REC_3D_RL( fn, fp, Nr, phyto_diaz, 6, myIter, myThid )
79
80 _EXCH_XYZ_RL( pH, myThid )
81 _EXCH_XYZ_RL( irr_mem, myThid )
82 _EXCH_XYZ_RL( chl, myThid )
83 _EXCH_XYZ_RL( phyto_sm, myThid )
84 _EXCH_XYZ_RL( phyto_lg, myThid )
85 _EXCH_XYZ_RL( phyto_diaz, myThid )
86
87 ELSE
88 pH_isLoaded = .FALSE.
89 IF ( pickupStrictlyMatch ) THEN
90 WRITE(msgBuf,'(4A)') 'BLING_READ_PICKUP: ',
91 & 'try with " pickupStrictlyMatch=.FALSE.,"',
92 & ' in file: "data", NameList: "PARM03"'
93 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
94 STOP 'ABNORMAL END: S/R BLING_READ_PICKUP'
95 ELSE
96 WRITE(msgBuf,'(2A)') 'WARNING >> BLING_READ_PICKUP: ',
97 & 'will restart from approximated pH'
98 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
99 ENDIF
100 ENDIF
101
102 #endif /* ALLOW_BLING */
103
104 RETURN
105 END

  ViewVC Help
Powered by ViewVC 1.1.22