/[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.7 - (hide annotations) (download)
Sat Sep 10 18:30:06 2005 UTC (18 years, 8 months ago) by edhill
Branch: MAIN
Changes since 1.6: +18 -4 lines 
 o various changes to mnc including:
   - all files use the new "BASENAME[[.ITER].{t|f}NUM].nc" format
   - output can now be grouped so that all files within a group
       change the ITER portion of their names in lock-step together
   - can now read ("global") PER-FACE (in addition to PER-TILE) files
       and works with both EXCH1 and EXCH2 (but needs more testing)
   - writing works for all verification test cases w/ g77 on Linux
1 edhill 1.7 C $Header: /u/gcmpack/MITgcm/pkg/cd_code/cd_code_checkpoint.F,v 1.6 2004/10/13 04:37:37 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.7 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
57 edhill 1.4 CALL MNC_CW_RL_R('D',fn,0,0,'uVelD',uVelD, myThid)
58     CALL MNC_CW_RL_R('D',fn,0,0,'vVelD',vVelD, myThid)
59     CALL MNC_CW_RL_R('D',fn,0,0,'Unm1',Unm1, myThid)
60     CALL MNC_CW_RL_R('D',fn,0,0,'Vnm1',Vnm1, myThid)
61     CALL MNC_CW_RL_R('D',fn,0,0,'etaNm1', etaNm1, myThid)
62     ENDIF
63     #endif /* ALLOW_MNC */
64    
65 edhill 1.7 WRITE(fn,'(A,A10)') 'pickup_cd.',suff
66    
67 edhill 1.4 IF (pickup_read_mdsio) THEN
68     CALL MDSREADFIELD(fn,prec,'RL',Nr,uVelD, 1,myThid)
69     CALL MDSREADFIELD(fn,prec,'RL',Nr,vVelD, 2,myThid)
70     CALL MDSREADFIELD(fn,prec,'RL',Nr,uNM1, 3,myThid)
71     CALL MDSREADFIELD(fn,prec,'RL',Nr,vNM1, 4,myThid)
72     IF ( usePickupBeforeC54 ) THEN
73     CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,6*Nr+1,myThid)
74     ELSE
75     CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,4*Nr+1,myThid)
76     ENDIF
77 jmc 1.3 ENDIF
78 heimbach 1.1
79 jmc 1.2 _END_MASTER( myThid )
80     _BARRIER
81    
82 heimbach 1.1 _EXCH_XYZ_R8( uVelD, myThid )
83     _EXCH_XYZ_R8( vVelD, myThid )
84     CALL EXCH_UV_XYZ_RL(uNM1,vNM1,.TRUE.,myThid)
85     _EXCH_XY_R8( etaNm1, myThid )
86    
87     #endif /* ALLOW_CD_CODE */
88    
89 jmc 1.2 RETURN
90     END
91 heimbach 1.1
92 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
93     CBOP
94     C !ROUTINE: CD_CODE_WRITE_CHECKPOINT
95 heimbach 1.1
96 edhill 1.4 C !INTERFACE:
97     SUBROUTINE CD_CODE_WRITE_CHECKPOINT(
98     I prec,
99     I lgf,
100     I permCheckPoint,
101     I myIter,
102     I myThid )
103 heimbach 1.1
104 edhill 1.4 C !DESCRIPTION:
105     C Read the pickup.
106 heimbach 1.1
107 edhill 1.4 C !USES:
108 heimbach 1.1 IMPLICIT NONE
109     #include "SIZE.h"
110     #include "EEPARAMS.h"
111     #include "PARAMS.h"
112 edhill 1.6 #ifdef ALLOW_MNC
113     #include "MNC_PARAMS.h"
114     #endif
115 heimbach 1.1 #include "CD_CODE_VARS.h"
116    
117 edhill 1.4 C !INPUT/OUTPUT PARAMETERS:
118 heimbach 1.1 INTEGER prec
119     LOGICAL lgf
120     LOGICAL permCheckPoint
121     INTEGER myIter
122     INTEGER myThid
123 edhill 1.4 CEOP
124 heimbach 1.1
125 jmc 1.3 #ifdef ALLOW_CD_CODE
126    
127 heimbach 1.1 C !LOCAL VARIABLES:
128     CHARACTER*(MAX_LEN_FNAM) fn
129    
130 edhill 1.4 IF ( permCheckPoint ) THEN
131 edhill 1.7 WRITE(fn,'(A)') 'pickup_cd'
132 edhill 1.4 ELSE
133     WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
134     ENDIF
135 edhill 1.7
136 edhill 1.4 #ifdef ALLOW_MNC
137     IF (useMNC .AND. pickup_write_mnc) THEN
138     C Read variables from the pickup file
139     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
140     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
141 edhill 1.7 IF ( permCheckPoint ) THEN
142     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
143     ELSE
144     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
145     ENDIF
146 edhill 1.4 CALL MNC_CW_RL_W('D',fn,0,0,'uVelD',uVelD, myThid)
147     CALL MNC_CW_RL_W('D',fn,0,0,'vVelD',vVelD, myThid)
148     CALL MNC_CW_RL_W('D',fn,0,0,'Unm1',Unm1, myThid)
149     CALL MNC_CW_RL_W('D',fn,0,0,'Vnm1',Vnm1, myThid)
150     CALL MNC_CW_RL_W('D',fn,0,0,'etaNm1', etaNm1, myThid)
151     ENDIF
152     #endif /* ALLOW_MNC */
153    
154 edhill 1.7 IF ( permCheckPoint ) THEN
155     WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
156     ELSE
157     WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
158     ENDIF
159    
160 edhill 1.4 IF (pickup_write_mdsio) THEN
161 heimbach 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVelD,1,myIter,myThid)
162     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVelD,2,myIter,myThid)
163     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uNM1, 3,myIter,myThid)
164     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vNM1, 4,myIter,myThid)
165 jmc 1.3 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaNm1,4*Nr+1,
166 edhill 1.4 & myIter,myThid)
167     ENDIF
168 heimbach 1.1
169     #endif /* ALLOW_CD_CODE */
170    
171     RETURN
172     END
  ViewVC Help
Powered by ViewVC 1.1.22