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

Contents of /MITgcm/pkg/cd_code/cd_code_read_pickup.F

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


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

1 C $Header: /u/gcmpack/MITgcm/pkg/cd_code/cd_code_read_pickup.F,v 1.3 2007/08/17 19:38:18 jmc Exp $
2 C $Name: $
3
4 #include "CD_CODE_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: CD_CODE_READ_PICKUP
9
10 C !INTERFACE:
11 SUBROUTINE CD_CODE_READ_PICKUP( myIter, myThid )
12
13 C !DESCRIPTION:
14 C Read the checkpoint.
15
16 C !USES:
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "CD_CODE_VARS.h"
22 #ifdef ALLOW_MNC
23 #include "MNC_PARAMS.h"
24 #endif
25
26 C !INPUT/OUTPUT PARAMETERS:
27 INTEGER myIter
28 INTEGER myThid
29 CEOP
30
31 #ifdef ALLOW_CD_CODE
32
33 C !LOCAL VARIABLES:
34 CHARACTER*(MAX_LEN_FNAM) fn
35 CHARACTER*(10) suff
36 INTEGER prec
37
38 C Suffix for pickup files
39 IF ( pickupSuff.EQ.' ' ) THEN
40 IF ( rwSuffixType.EQ.0 ) THEN
41 WRITE(suff,'(I10.10)') myIter
42 ELSE
43 CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
44 ENDIF
45 ELSE
46 WRITE(suff,'(A10)') pickupSuff
47 ENDIF
48 prec = precFloat64
49
50 _BARRIER
51
52 #ifdef ALLOW_MNC
53 IF (useMNC .AND. pickup_read_mnc) THEN
54 C Read variables from the pickup file
55 WRITE(fn,'(A)') 'pickup_cd'
56 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
57 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
58 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
59 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
60 CALL MNC_CW_RL_R('D',fn,0,0,'uVelD',uVelD, myThid)
61 CALL MNC_CW_RL_R('D',fn,0,0,'vVelD',vVelD, myThid)
62 CALL MNC_CW_RL_R('D',fn,0,0,'Unm1',Unm1, myThid)
63 CALL MNC_CW_RL_R('D',fn,0,0,'Vnm1',Vnm1, myThid)
64 CALL MNC_CW_RL_R('D',fn,0,0,'etaNm1', etaNm1, myThid)
65 ENDIF
66 #endif /* ALLOW_MNC */
67
68 WRITE(fn,'(A,A10)') 'pickup_cd.',suff
69
70 IF (pickup_read_mdsio) THEN
71 CALL READ_REC_3D_RL( fn, prec, Nr, uVelD, 1, myIter, myThid )
72 CALL READ_REC_3D_RL( fn, prec, Nr, vVelD, 2, myIter, myThid )
73 CALL READ_REC_3D_RL( fn, prec, Nr, uNM1, 3, myIter, myThid )
74 CALL READ_REC_3D_RL( fn, prec, Nr, vNM1, 4, myIter, myThid )
75 IF ( usePickupBeforeC54 ) THEN
76 CALL READ_REC_3D_RL(fn,prec, 1, etaNm1,6*Nr+1,myIter,myThid)
77 ELSE
78 CALL READ_REC_3D_RL(fn,prec, 1, etaNm1,4*Nr+1,myIter,myThid)
79 ENDIF
80 ENDIF
81
82 C- thread synchronisation (barrier) is part of the EXCH S/R calls
83 CALL EXCH_UV_DGRID_3D_RL( uVelD,vVelD, .TRUE., Nr, myThid )
84 CALL EXCH_UV_XYZ_RL( uNM1,vNM1, .TRUE., myThid )
85 CALL EXCH_XY_RL( etaNm1, myThid )
86
87 #endif /* ALLOW_CD_CODE */
88
89 RETURN
90 END

  ViewVC Help
Powered by ViewVC 1.1.22