/[MITgcm]/MITgcm/pkg/thsice/thsice_write_pickup.F
ViewVC logotype

Annotation of /MITgcm/pkg/thsice/thsice_write_pickup.F

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


Revision 1.4 - (hide annotations) (download)
Sat Nov 5 00:57:00 2005 UTC (18 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.3: +1 -5 lines
remove unused common block

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_write_pickup.F,v 1.3 2005/09/17 03:17:06 edhill Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "THSICE_OPTIONS.h"
5     CBOP
6     C !ROUTINE: THSICE_WRITE_PICKUP
7     C !INTERFACE:
8     SUBROUTINE THSICE_WRITE_PICKUP(
9     I prec, lgf, permCheckPoint,
10     I myIter, myThid )
11    
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | S/R THSICE_WRITE_PICKUP
15     C | o Write thsice pickup file
16     C *==========================================================*
17     C \ev
18    
19     C !USES:
20     IMPLICIT NONE
21    
22     C === Global variables ===
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26     #include "THSICE_PARAMS.h"
27     #include "THSICE_VARS.h"
28    
29     C !INPUT/OUTPUT PARAMETERS:
30     C == Routine arguments ==
31     INTEGER prec
32     LOGICAL lgf
33     LOGICAL permCheckPoint
34     INTEGER myIter
35     INTEGER myThid
36     CEOP
37    
38     #ifdef ALLOW_THSICE
39    
40     C == Local variables ==
41     CHARACTER*(MAX_LEN_FNAM) fn
42    
43 edhill 1.2 IF ( permCheckPoint ) THEN
44     WRITE(fn,'(A,I10.10)') 'pickup_ic.',myIter
45     ELSE
46     WRITE(fn,'(A,A)') 'pickup_ic.',checkPtSuff(nCheckLev)
47     ENDIF
48 jmc 1.1
49 edhill 1.2 IF ( thSIce_pickup_write_mdsio ) THEN
50 jmc 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,iceMask, 1,
51     & myIter,myThid)
52     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,iceHeight, 2,
53     & myIter,myThid)
54     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,snowHeight,3,
55     & myIter,myThid)
56     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tsrf, 4, myIter,myThid)
57     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tice1, 5, myIter,myThid)
58     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Tice2, 6, myIter,myThid)
59     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Qice1, 7, myIter,myThid)
60     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,Qice2, 8, myIter,myThid)
61     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,snowAge,9, myIter,myThid)
62    
63 edhill 1.2 IF ( stepFwd_oceMxL ) THEN
64 jmc 1.1 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,tOceMxL,10,myIter,myThid)
65     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,sOceMxL,11,myIter,myThid)
66 edhill 1.2 ENDIF
67     ENDIF
68    
69     #ifdef ALLOW_MNC
70     IF ( thSIce_pickup_write_mnc ) THEN
71 edhill 1.3 IF ( permCheckPoint ) THEN
72     WRITE(fn,'(A)') 'pickup_ic'
73     ELSE
74     WRITE(fn,'(A,A)') 'pickup_ic.',checkPtSuff(nCheckLev)
75     ENDIF
76     C First ***define*** the file group name
77     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
78     IF ( permCheckPoint ) THEN
79     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
80     ELSE
81     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
82     ENDIF
83     C Then set the actual unlimited dimension
84     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
85 edhill 1.2 CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
86     C CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
87     CALL MNC_CW_RL_W('D',fn,0,0,'iceMask', iceMask, myThid)
88     CALL MNC_CW_RL_W('D',fn,0,0,'iceHeight', iceHeight, myThid)
89     CALL MNC_CW_RL_W('D',fn,0,0,'snowHeight',snowHeight,myThid)
90     CALL MNC_CW_RL_W('D',fn,0,0,'Tsrf', Tsrf, myThid)
91     CALL MNC_CW_RL_W('D',fn,0,0,'Tice1', Tice1, myThid)
92     CALL MNC_CW_RL_W('D',fn,0,0,'Tice2', Tice1, myThid)
93     CALL MNC_CW_RL_W('D',fn,0,0,'Qice1', Qice1, myThid)
94     CALL MNC_CW_RL_W('D',fn,0,0,'Qice2', Qice2, myThid)
95     CALL MNC_CW_RL_W('D',fn,0,0,'snowAge', snowAge, myThid)
96     IF ( stepFwd_oceMxL ) THEN
97     CALL MNC_CW_RL_W('D',fn,0,0,'tOceMxL',tOceMxL,myThid)
98     CALL MNC_CW_RL_W('D',fn,0,0,'sOceMxL',sOceMxL,myThid)
99     ENDIF
100     ENDIF
101     #endif /* ALLOW_MNC */
102 jmc 1.1
103     #endif /* ALLOW_THSICE */
104     RETURN
105     END
106 edhill 1.2
107     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22