/[MITgcm]/MITgcm/pkg/cd_code/cd_code_checkpoint.F
ViewVC logotype

Annotation of /MITgcm/pkg/cd_code/cd_code_checkpoint.F

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

Revision 1.8 - (hide annotations) (download)
Sat Sep 17 03:17:06 2005 UTC (18 years, 8 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint58l_post, checkpoint58e_post, checkpoint57v_post, checkpoint57s_post, checkpoint58b_post, checkpoint58m_post, checkpoint57y_post, checkpoint58g_post, checkpoint57x_post, checkpoint58n_post, checkpoint58h_post, checkpoint58j_post, checkpoint57y_pre, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint58o_post, checkpoint57z_post, checkpoint58c_post, checkpoint58k_post, checkpoint58p_post, checkpoint58q_post
Changes since 1.7: +4 -2 lines 
 o fix mnc checkpoint writing problem reported by Baylor -- now works
   correctly with all the MLAdjust inputs
1 edhill 1.8 C $Header: /u/gcmpack/MITgcm/pkg/cd_code/cd_code_checkpoint.F,v 1.7 2005/09/10 18:30:06 edhill Exp $
2 heimbach 1.1 C $Name: $
3    
4     #include "CD_CODE_OPTIONS.h"
5    
6 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP
8     C !ROUTINE: CD_CODE_READ_CHECKPOINT
9    
10     C !INTERFACE:
11 heimbach 1.1 SUBROUTINE CD_CODE_READ_CHECKPOINT( myIter, myThid )
12    
13 edhill 1.4 C !DESCRIPTION:
14     C Read the checkpoint.
15    
16     C !USES:
17 heimbach 1.1 IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21 edhill 1.6 #ifdef ALLOW_MNC
22     #include "MNC_PARAMS.h"
23     #endif
24 heimbach 1.1 #include "CD_CODE_VARS.h"
25    
26 edhill 1.4 C !INPUT/OUTPUT PARAMETERS:
27 heimbach 1.1 INTEGER myIter
28     INTEGER myThid
29 edhill 1.4 CEOP
30 heimbach 1.1
31 jmc 1.3 #ifdef ALLOW_CD_CODE
32    
33 heimbach 1.1 C !LOCAL VARIABLES:
34     CHARACTER*(MAX_LEN_FNAM) fn
35     CHARACTER*(10) suff
36     INTEGER prec
37    
38 edhill 1.4 C Suffix for pickup files
39 heimbach 1.1 IF (pickupSuff.EQ.' ') THEN
40     WRITE(suff,'(I10.10)') myIter
41     ELSE
42     WRITE(suff,'(A10)') pickupSuff
43     ENDIF
44    
45     _BARRIER
46     _BEGIN_MASTER( myThid )
47    
48     prec = precFloat64
49    
50 edhill 1.4 #ifdef ALLOW_MNC
51     IF (useMNC .AND. pickup_read_mnc) THEN
52     C Read variables from the pickup file
53 edhill 1.7 WRITE(fn,'(A)') 'pickup_cd'
54 edhill 1.4 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
55     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
56 edhill 1.8 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
57     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
58 edhill 1.4 CALL MNC_CW_RL_R('D',fn,0,0,'uVelD',uVelD, myThid)
59     CALL MNC_CW_RL_R('D',fn,0,0,'vVelD',vVelD, myThid)
60     CALL MNC_CW_RL_R('D',fn,0,0,'Unm1',Unm1, myThid)
61     CALL MNC_CW_RL_R('D',fn,0,0,'Vnm1',Vnm1, myThid)
62     CALL MNC_CW_RL_R('D',fn,0,0,'etaNm1', etaNm1, myThid)
63     ENDIF
64     #endif /* ALLOW_MNC */
65    
66 edhill 1.7 WRITE(fn,'(A,A10)') 'pickup_cd.',suff
67    
68 edhill 1.4 IF (pickup_read_mdsio) THEN
69     CALL MDSREADFIELD(fn,prec,'RL',Nr,uVelD, 1,myThid)
70     CALL MDSREADFIELD(fn,prec,'RL',Nr,vVelD, 2,myThid)
71     CALL MDSREADFIELD(fn,prec,'RL',Nr,uNM1, 3,myThid)
72     CALL MDSREADFIELD(fn,prec,'RL',Nr,vNM1, 4,myThid)
73     IF ( usePickupBeforeC54 ) THEN
74     CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,6*Nr+1,myThid)
75     ELSE
76     CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,4*Nr+1,myThid)
77     ENDIF
78 jmc 1.3 ENDIF
79 heimbach 1.1
80 jmc 1.2 _END_MASTER( myThid )
81     _BARRIER
82    
83 heimbach 1.1 _EXCH_XYZ_R8( uVelD, myThid )
84     _EXCH_XYZ_R8( vVelD, myThid )
85     CALL EXCH_UV_XYZ_RL(uNM1,vNM1,.TRUE.,myThid)
86     _EXCH_XY_R8( etaNm1, myThid )
87    
88     #endif /* ALLOW_CD_CODE */
89    
90 jmc 1.2 RETURN
91     END
92 heimbach 1.1
93 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
94     CBOP
95     C !ROUTINE: CD_CODE_WRITE_CHECKPOINT
96 heimbach 1.1
97 edhill 1.4 C !INTERFACE:
98     SUBROUTINE CD_CODE_WRITE_CHECKPOINT(
99     I prec,
100     I lgf,
101     I permCheckPoint,
102     I myIter,
103     I myThid )
104 heimbach 1.1
105 edhill 1.4 C !DESCRIPTION:
106     C Read the pickup.
107 heimbach 1.1
108 edhill 1.4 C !USES:
109 heimbach 1.1 IMPLICIT NONE
110     #include "SIZE.h"
111     #include "EEPARAMS.h"
112     #include "PARAMS.h"
113 edhill 1.6 #ifdef ALLOW_MNC
114     #include "MNC_PARAMS.h"
115     #endif
116 heimbach 1.1 #include "CD_CODE_VARS.h"
117    
118 edhill 1.4 C !INPUT/OUTPUT PARAMETERS:
119 heimbach 1.1 INTEGER prec
120     LOGICAL lgf
121     LOGICAL permCheckPoint
122     INTEGER myIter
123     INTEGER myThid
124 edhill 1.4 CEOP
125 heimbach 1.1
126 jmc 1.3 #ifdef ALLOW_CD_CODE
127    
128 heimbach 1.1 C !LOCAL VARIABLES:
129     CHARACTER*(MAX_LEN_FNAM) fn
130    
131 edhill 1.4 IF ( permCheckPoint ) THEN
132 edhill 1.7 WRITE(fn,'(A)') 'pickup_cd'
133 edhill 1.4 ELSE
134     WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
135     ENDIF
136 edhill 1.7
137 edhill 1.4 #ifdef ALLOW_MNC
138     IF (useMNC .AND. pickup_write_mnc) THEN
139     C Read variables from the pickup file
140     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
141     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
142 edhill 1.7 IF ( permCheckPoint ) THEN
143     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
144     ELSE
145     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
146     ENDIF
147 edhill 1.8 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
148 edhill 1.4 CALL MNC_CW_RL_W('D',fn,0,0,'uVelD',uVelD, myThid)
149     CALL MNC_CW_RL_W('D',fn,0,0,'vVelD',vVelD, myThid)
150     CALL MNC_CW_RL_W('D',fn,0,0,'Unm1',Unm1, myThid)
151     CALL MNC_CW_RL_W('D',fn,0,0,'Vnm1',Vnm1, myThid)
152     CALL MNC_CW_RL_W('D',fn,0,0,'etaNm1', etaNm1, myThid)
153     ENDIF
154     #endif /* ALLOW_MNC */
155    
156 edhill 1.7 IF ( permCheckPoint ) THEN
157     WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
158     ELSE
159     WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
160     ENDIF
161    
162 edhill 1.4 IF (pickup_write_mdsio) THEN
163 heimbach 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVelD,1,myIter,myThid)
164     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVelD,2,myIter,myThid)
165     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uNM1, 3,myIter,myThid)
166     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vNM1, 4,myIter,myThid)
167 jmc 1.3 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaNm1,4*Nr+1,
168 edhill 1.4 & myIter,myThid)
169     ENDIF
170 heimbach 1.1
171     #endif /* ALLOW_CD_CODE */
172    
173     RETURN
174     END
  ViewVC Help
Powered by ViewVC 1.1.22