/[MITgcm]/MITgcm/pkg/land/land_write_pickup.F
ViewVC logotype

Annotation of /MITgcm/pkg/land/land_write_pickup.F

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


Revision 1.5 - (hide annotations) (download)
Mon Nov 5 15:40:24 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59k, checkpoint59j, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q
Changes since 1.4: +13 -3 lines
- add #ifdef ALLOW_MDSIO (allows to compile without pkg/mdsio)
- add few _BARRIER

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/land/land_write_pickup.F,v 1.4 2005/09/17 03:17:06 edhill Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "LAND_OPTIONS.h"
5    
6     CBOP
7 jmc 1.5 C !ROUTINE: LAND_WRITE_PICKUP
8 jmc 1.1 C !INTERFACE:
9 edhill 1.3 SUBROUTINE LAND_WRITE_PICKUP( isperm, suff,
10 jmc 1.5 I myTime, myIter, myThid )
11 jmc 1.1
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | S/R LAND_WRITE_PICKUP
15     C | o Writes current state of land package to a pickup file
16     C *==========================================================*
17     C \ev
18    
19     C !USES:
20     IMPLICIT NONE
21    
22     C == Global variables ===
23     #include "LAND_SIZE.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26     #include "LAND_PARAMS.h"
27     #include "LAND_VARS.h"
28    
29     C !INPUT/OUTPUT PARAMETERS:
30     C == Routine Arguments ==
31 edhill 1.3 C isperm :: flag for permanent or rolling checkpoint
32 jmc 1.1 C suff :: suffix for pickup file (eg. ckptA or 0000000010)
33     C myTime :: current time
34     C myIter :: time-step number
35     C myThid :: Number of this instance
36 edhill 1.3 LOGICAL isperm
37 jmc 1.1 CHARACTER*(*) suff
38     _RL myTime
39     INTEGER myIter
40     INTEGER myThid
41    
42     #ifdef ALLOW_LAND
43    
44     C !LOCAL VARIABLES:
45     C fn :: character buffer for creating filename
46     C prec :: precision of pickup files
47     C lgf :: flag to write "global" files
48 jmc 1.2 c INTEGER prec, iChar, lChar, k
49     INTEGER prec, lChar, k
50 jmc 1.1 CHARACTER*(MAX_LEN_FNAM) fn
51     LOGICAL lgf
52 jmc 1.2
53     INTEGER ILNBLNK
54     EXTERNAL ILNBLNK
55    
56 jmc 1.1 CEOP
57    
58     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
59    
60 jmc 1.2 lChar = ILNBLNK(suff)
61 edhill 1.3
62 jmc 1.5 C Going to really do some IO. Make everyone except master thread wait.
63     _BARRIER
64    
65 edhill 1.3 IF ( land_pickup_write_mdsio ) THEN
66    
67     C-- Write fields as consecutive records
68 jmc 1.1 WRITE(fn,'(A,A)') 'pickup_land.',suff(1:lChar)
69     prec = precFloat64
70     lgf = globalFiles
71    
72 jmc 1.5 #ifdef ALLOW_MDSIO
73 jmc 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',land_nLev,
74 jmc 1.2 & land_enthalp,1,myIter,myThid)
75 jmc 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',land_nLev,
76     & land_groundW,2,myIter,myThid)
77 jmc 1.2 k=2*land_nLev
78     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,
79     & land_skinT, k+1,myIter,myThid)
80     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,
81     & land_hSnow, k+2,myIter,myThid)
82     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,
83     & land_snowAge,k+3,myIter,myThid)
84 jmc 1.5 #else /* ALLOW_MDSIO */
85     STOP 'ABNORMAL END: S/R OBCS_READ_CHECKPOINT: NEEDS MSDIO PKG'
86     #endif /* ALLOW_MDSIO */
87 jmc 1.1
88 edhill 1.3 ENDIF
89    
90     #ifdef ALLOW_MNC
91     IF ( land_pickup_write_mnc ) THEN
92    
93     DO k = 1,MAX_LEN_FNAM
94     fn(k:k) = ' '
95     ENDDO
96     IF ( isperm ) THEN
97     WRITE(fn,'(A)') 'pickup_land'
98     ELSE
99     WRITE(fn,'(A,A)') 'pickup_land.',suff(1:lChar)
100     ENDIF
101     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
102     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
103     IF ( isperm ) THEN
104     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
105     ELSE
106     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
107     ENDIF
108 edhill 1.4 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
109 edhill 1.3
110     CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
111     CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
112    
113     CALL MNC_CW_RL_W('D',fn,0,0,
114     & 'land_enthalp', land_enthalp, myThid)
115     CALL MNC_CW_RL_W('D',fn,0,0,
116     & 'land_groundW', land_groundW, myThid)
117    
118     CALL MNC_CW_RL_W('D',fn,0,0,
119     & 'land_skinT', land_skinT, myThid)
120     CALL MNC_CW_RL_W('D',fn,0,0,
121     & 'land_hSnow', land_hSnow, myThid)
122     CALL MNC_CW_RL_W('D',fn,0,0,
123     & 'land_snAge', land_snowAge, myThid)
124    
125     ENDIF
126     #endif /* ALLOW_MNC */
127    
128 jmc 1.5 C-- Every one else must wait until writing is done.
129     _BARRIER
130    
131 jmc 1.1 #endif /* ALLOW_LAND */
132    
133     RETURN
134     END

  ViewVC Help
Powered by ViewVC 1.1.22