/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_write_pickup.F
ViewVC logotype

Contents of /MITgcm_contrib/dgoldberg/streamice/streamice_write_pickup.F

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


Revision 1.1 - (show annotations) (download)
Wed Aug 27 19:29:15 2014 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
Error occurred while calculating annotation data.
updating contrib streamice repo with latest files, and separated out convergence checks; and parameterised maximum iteration counts and interface w shelfice for coupling

1 C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_write_pickup.F,v 1.3 2014/03/30 18:00:23 jmc Exp $
2 C $Name: $
3
4 #include "STREAMICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: STREAMICE_WRITE_PICKUP
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE STREAMICE_WRITE_PICKUP( permPickup,
11 & suff, myTime, myIter, myThid )
12
13 C !DESCRIPTION:
14 C Writes current state of passive tracers to a pickup file
15
16 C !USES: ===============================================================
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "STREAMICE.h"
22
23 C !INPUT PARAMETERS: ===================================================
24 C permPickup :: write a permanent pickup
25 C suff :: suffix for pickup file (eg. ckptA or 0000000010)
26 C myTime :: model time
27 C myIter :: time-step number
28 C myThid :: thread number
29 LOGICAL permPickup
30 CHARACTER*(*) suff
31 _RL myTime
32 INTEGER myIter
33 INTEGER myThid
34
35 C !OUTPUT PARAMETERS: ==================================================
36 C none
37
38 #ifdef ALLOW_STREAMICE
39 C === Functions ====
40 INTEGER ILNBLNK
41 EXTERNAL ILNBLNK
42
43 C !LOCAL VARIABLES: ====================================================
44 C j :: loop index / field number
45 C nj :: record number
46 C fp :: pickup-file precision
47 C glf :: local flag for "globalFiles"
48 C fn :: character buffer for creating filename
49 C nWrFlds :: number of fields being written
50 C listDim :: dimension of "wrFldList" local array
51 C wrFldList :: list of written fields
52 C msgBuf :: Informational/error message buffer
53 INTEGER j, nj, fp, lChar
54 LOGICAL glf
55 _RL timList(1)
56 CHARACTER*(MAX_LEN_FNAM) fn
57 INTEGER listDim, nWrFlds
58 PARAMETER( listDim = 12 )
59 CHARACTER*(8) wrFldList(listDim)
60 CHARACTER*(MAX_LEN_MBUF) msgBuf
61 CEOP
62
63 lChar = ILNBLNK(suff)
64 IF ( lChar.EQ.0 ) THEN
65 WRITE(fn,'(2A)') 'pickup_streamice'
66 ELSE
67 WRITE(fn,'(2A)') 'pickup_streamice.',suff(1:lChar)
68 ENDIF
69 fp = precFloat64
70 j = 0
71
72 C Firstly, write 3-D fields as consecutive records,
73
74 #ifdef STREAMICE_HYBRID_STRESS
75 C record number < 0 : a hack not to write meta files now:
76 j = j + 1
77 CALL WRITE_REC_3D_RL( fn, fp, Nr, visc_streamice_full,
78 & -j, myIter, myThid )
79 IF (j.LE.listDim) wrFldList(j) = 'visc3d '
80 #endif /* STREAMICE_HYBRID_STRESS */
81
82 C- switch to 2-D fields:
83 nj = -j*Nr
84
85 j = j + 1
86 nj = nj-1
87 CALL WRITE_REC_3D_RL( fn, fp, 1, area_shelf_streamice,
88 & nj, myIter, myThid )
89 IF (j.LE.listDim) wrFldList(j) = 'SI_area '
90
91 j = j + 1
92 nj = nj-1
93 CALL WRITE_REC_3D_RS( fn, fp, 1, STREAMICE_hmask,
94 & nj, myIter, myThid )
95 IF (j.LE.listDim) wrFldList(j) = 'SI_hmask'
96
97 j = j + 1
98 nj = nj-1
99 CALL WRITE_REC_3D_RL( fn, fp, 1, U_streamice,
100 & nj, myIter, myThid )
101 IF (j.LE.listDim) wrFldList(j) = 'SI_uvel '
102
103 j = j + 1
104 nj = nj-1
105 CALL WRITE_REC_3D_RL( fn, fp, 1, V_streamice,
106 & nj, myIter, myThid )
107 IF (j.LE.listDim) wrFldList(j) = 'SI_vvel '
108
109 j = j + 1
110 nj = nj-1
111 CALL WRITE_REC_3D_RL( fn, fp, 1, H_streamice,
112 & nj, myIter, myThid )
113 IF (j.LE.listDim) wrFldList(j) = 'SI_thick'
114
115 j = j + 1
116 nj = nj-1
117 CALL WRITE_REC_3D_RL( fn, fp, 1, tau_beta_eff_streamice,
118 & nj, myIter, myThid )
119 IF (j.LE.listDim) wrFldList(j) = 'SI_betaF'
120
121 j = j + 1
122 nj = nj-1
123 CALL WRITE_REC_3D_RL( fn, fp, 1, visc_streamice,
124 & nj, myIter, myThid )
125 IF (j.LE.listDim) wrFldList(j) = 'SI_visc '
126
127 #ifdef STREAMICE_HYBRID_STRESS
128 j = j + 1
129 nj = nj-1
130 CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_taubx,
131 & nj, myIter, myThid )
132 IF (j.LE.listDim) wrFldList(j) = 'SI_taubx'
133
134 j = j + 1
135 nj = nj-1
136 CALL WRITE_REC_3D_RL( fn, fp, 1, streamice_tauby,
137 & nj, myIter, myThid )
138 IF (j.LE.listDim) wrFldList(j) = 'SI_tauby'
139 #endif
140
141 c j = j + 1
142 c nj = nj-1
143 c CALL WRITE_REC_3D_RL( fn, fp, 1, myPa_Surf2,
144 c & nj, myIter, myThid )
145 c IF (j.LE.listDim) wrFldList(j) = 'myPaSur2'
146
147 C--------------------------
148 nWrFlds = j
149 IF ( nWrFlds.GT.listDim ) THEN
150 WRITE(msgBuf,'(2A,I5,A)') 'STREAMICE_WRITE_PICKUP: ',
151 & 'trying to write ',nWrFlds,' fields'
152 CALL PRINT_ERROR( msgBuf, myThid )
153 WRITE(msgBuf,'(2A,I5,A)') 'STREAMICE_WRITE_PICKUP: ',
154 & 'field-list dimension (listDim=',listDim,') too small'
155 CALL PRINT_ERROR( msgBuf, myThid )
156 CALL ALL_PROC_DIE( myThid )
157 STOP 'ABNORMAL END: S/R STREAMICE_WRITE_PICKUP (list-size Pb)'
158 ENDIF
159 #ifdef ALLOW_MDSIO
160 C uses this specific S/R to write (with more informations) only meta files
161 j = 1
162 nj = ABS(nj)
163 IF ( nWrFlds*Nr .EQ. nj ) THEN
164 j = Nr
165 nj = nWrFlds
166 ENDIF
167 glf = globalFiles
168 timList(1) = myTime
169 CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
170 & 0, 0, j, ' ',
171 & nWrFlds, wrFldList,
172 & 1, timList, oneRL,
173 & nj, myIter, myThid )
174 #endif /* ALLOW_MDSIO */
175 C--------------------------
176
177 #endif /* ALLOW_STREAMICE */
178
179 RETURN
180 END

  ViewVC Help
Powered by ViewVC 1.1.22