/[MITgcm]/MITgcm/pkg/seaice/seaice_do_diags.F
ViewVC logotype

Contents of /MITgcm/pkg/seaice/seaice_do_diags.F

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

Revision 1.5 - (show annotations) (download)
Tue Feb 18 05:33:55 2003 UTC (21 years, 2 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint48f_post, checkpoint48i_post, checkpoint50d_pre, checkpoint50e_post, checkpoint50c_post, checkpoint48h_post, checkpoint50c_pre, checkpoint50b_pre, checkpoint49, checkpoint48g_post, checkpoint50, checkpoint50d_post, checkpoint50b_post, checkpoint50f_post, checkpoint50f_pre, checkpoint50a_post, checkpoint50e_pre
Changes since 1.4: +9 -5 lines 
Merging from release1_p12:
o Modifications for using pkg/exf with pkg/seaice
  - improved description of the various forcing configurations
  - added basic radiation bulk formulae to pkg/exf
  - units/sign fix for evap computation in exf_getffields.F
  - updated verification/global_with_exf/results/output.txt
o Added pkg/sbo for computing IERS Special Bureau for the Oceans
  (SBO) core products, including oceanic mass, center-of-mass,
  angular, and bottom pressure (see pkg/sbo/README.sbo).
o Lower bound for viscosity/diffusivity in pkg/kpp/kpp_routines.F
  to avoid negative values in shallow regions.
  - updated verification/natl_box/results/output.txt
  - updated verification/lab_sea/results/output.txt
o MPI gather, scatter: eesupp/src/gather_2d.F and scatter_2d.F
o Added useSingleCpuIO option (see PARAMS.h).
o Updated useSingleCpuIO option in mdsio_writefield.F to
  work with multi-field files, e.g., for single-file pickup.
o pkg/seaice:
  - bug fix in growth.F: QNET for no shortwave case
  - added HeffFile for specifying initial sea-ice thickness
  - changed SEAICE_EXTERNAL_FLUXES wind stress implementation
o Added missing /* */ to CPP comments in pkg/seaice, pkg/exf,
  kpp_transport_t.F, forward_step.F, and the_main_loop.F
o pkg/seaice:
  - adjoint-friendly modifications
  - added a SEAICE_WRITE_PICKUP at end of the_model_main.F
1 C $Header:
2
3 #include "SEAICE_OPTIONS.h"
4
5 SUBROUTINE SEAICE_DO_DIAGS( myTime, myIter, myThid )
6 C /==========================================================\
7 C | SUBROUTINE SEAICE_DO_DIAGS |
8 C | o Do SEAICE diagnostic output. |
9 C \==========================================================/
10 IMPLICIT NONE
11
12 C === Global variables ===
13 #include "SIZE.h"
14 #include "EEPARAMS.h"
15 #include "PARAMS.h"
16 #include "FFIELDS.h"
17 #include "SEAICE_DIAGS.h"
18 #include "SEAICE_PARAMS.h"
19 #include "SEAICE_FFIELDS.h"
20 #include "SEAICE.h"
21
22 C == Routine arguments ==
23 C myTime - Current time of simulation ( s )
24 C myIter - Iteration number
25 C myThid - Number of this instance of SEAICE_DO_DIAGS
26 _RL myTime
27 INTEGER myIter
28 INTEGER myThid
29
30 #ifdef ALLOW_SEAICE
31
32 C == Local variables ==
33 CHARACTER*(MAX_LEN_MBUF) suff
34 LOGICAL DIFFERENT_MULTIPLE
35 EXTERNAL DIFFERENT_MULTIPLE
36 INTEGER i, j, k, bi, bj
37 _RS arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nSx,nSy)
38
39 IF (SEAICEwriteState) THEN
40
41 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,
42 & myTime-deltaTClock) ) THEN
43
44 WRITE(suff,'(I10.10)') myIter
45 _BARRIER
46 _BEGIN_MASTER( myThid )
47 CALL WRITE_FLD_XY_RS( 'FU.',suff,fu,myIter,myThid)
48 CALL WRITE_FLD_XY_RS( 'FV.',suff,fv,myIter,myThid)
49 CALL WRITE_FLD_XY_RS( 'EmPmR.',suff,EmPmR,myIter,myThid)
50 CALL WRITE_FLD_XY_RS( 'Qnet.',suff,Qnet,myIter,myThid)
51 CALL WRITE_FLD_XY_RS( 'Qsw.',suff,Qsw,myIter,myThid)
52 _END_MASTER( myThid )
53 _BARRIER
54
55 DO bj=myByLo(myThid),myByHi(myThid)
56 DO bi=myBxLo(myThid),myBxHi(myThid)
57 DO j=1,sNy
58 DO i=1,sNx
59 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
60 ENDDO
61 ENDDO
62 ENDDO
63 ENDDO
64 _BARRIER
65 _BEGIN_MASTER( myThid )
66 CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
67 _END_MASTER( myThid )
68 _BARRIER
69
70 DO bj=myByLo(myThid),myByHi(myThid)
71 DO bi=myBxLo(myThid),myBxHi(myThid)
72 DO j=1,sNy
73 DO i=1,sNx
74 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
75 ENDDO
76 ENDDO
77 ENDDO
78 ENDDO
79 _BARRIER
80 _BEGIN_MASTER( myThid )
81 CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
82 _END_MASTER( myThid )
83 _BARRIER
84
85 DO bj=myByLo(myThid),myByHi(myThid)
86 DO bi=myBxLo(myThid),myBxHi(myThid)
87 DO j=1,sNy
88 DO i=1,sNx
89 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
90 ENDDO
91 ENDDO
92 ENDDO
93 ENDDO
94 _BARRIER
95 _BEGIN_MASTER( myThid )
96 CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
97 _END_MASTER( myThid )
98 _BARRIER
99
100 DO bj=myByLo(myThid),myByHi(myThid)
101 DO bi=myBxLo(myThid),myBxHi(myThid)
102 DO j=1,sNy
103 DO i=1,sNx
104 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
105 ENDDO
106 ENDDO
107 ENDDO
108 ENDDO
109 _BARRIER
110 _BEGIN_MASTER( myThid )
111 CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
112 _END_MASTER( myThid )
113 _BARRIER
114
115 #ifdef SEAICE_DEBUG
116 c CALL PLOT_FIELD_XYRS( uwind ,'Current uwind ' , myIter, myThid )
117 c CALL PLOT_FIELD_XYRS( vwind ,'Current vwind ' , myIter, myThid )
118 c CALL PLOT_FIELD_XYRS( atemp ,'Current atemp ' , myIter, myThid )
119 c CALL PLOT_FIELD_XYRS( aqh ,'Current aqh ' , myIter, myThid )
120 c CALL PLOT_FIELD_XYRS( lwdown,'Current lwdown ', myIter, myThid )
121 c CALL PLOT_FIELD_XYRS( swdown,'Current swdown ', myIter, myThid )
122 CALL PLOT_FIELD_XYRL( fu ,'Current fu ' , myIter, myThid )
123 CALL PLOT_FIELD_XYRL( fv ,'Current fv ' , myIter, myThid )
124 CALL PLOT_FIELD_XYRL( Qnet ,'Current Qnet ' , myIter, myThid )
125 CALL PLOT_FIELD_XYRL( evap ,'Current evap ' , myIter, myThid )
126 #endif
127
128 ENDIF
129 ENDIF
130
131 C----------------------------------------------------------------
132 C Do SEAICE time averaging.
133 C----------------------------------------------------------------
134
135 #ifdef ALLOW_TIMEAVE
136
137 C-- Time-cumulations
138 DO bj = myByLo(myThid), myByHi(myThid)
139 DO bi = myBxLo(myThid), myBxHi(myThid)
140 DO j=1,sNy
141 DO i=1,sNx
142 FUtave(i,j,1,bi,bj) =
143 & FUtave(i,j,1,bi,bj) +FU(i,j,bi,bj) *deltaTclock
144 FVtave(i,j,1,bi,bj) =
145 & FVtave(i,j,1,bi,bj) +FV(i,j,bi,bj) *deltaTclock
146 EmPmRtave(i,j,1,bi,bj)=
147 & EmPmRtave(i,j,1,bi,bj)+EmPmR(i,j,bi,bj) *deltaTclock
148 QNETtave(i,j,1,bi,bj) =
149 & QNETtave(i,j,1,bi,bj) +QNET(i,j,bi,bj) *deltaTclock
150 QSWtave(i,j,1,bi,bj) =
151 & QSWtave(i,j,1,bi,bj) +QSW(i,j,bi,bj) *deltaTclock
152 UICEtave(i,j,1,bi,bj) =
153 & UICEtave(i,j,1,bi,bj) +UICE(i,j,1,bi,bj)*deltaTclock
154 VICEtave(i,j,1,bi,bj) =
155 & VICEtave(i,j,1,bi,bj) +VICE(i,j,1,bi,bj)*deltaTclock
156 HEFFtave(i,j,1,bi,bj) =
157 & HEFFtave(i,j,1,bi,bj) +HEFF(i,j,1,bi,bj)*deltaTclock
158 AREAtave(i,j,1,bi,bj) =
159 & AREAtave(i,j,1,bi,bj) +AREA(i,j,1,bi,bj)*deltaTclock
160 ENDDO
161 ENDDO
162 DO k=1,Nr
163 SEAICE_TimeAve(k,bi,bj)=SEAICE_TimeAve(k,bi,bj)+deltaTclock
164 ENDDO
165 ENDDO
166 ENDDO
167
168 C Dump files and restart average computation if needed
169 IF ( myIter.NE.nIter0 .AND.
170 & DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,myTime-deltaTClock)
171 & ) THEN
172
173 C Normalize by integrated time
174 DO bj = myByLo(myThid), myByHi(myThid)
175 DO bi = myBxLo(myThid), myBxHi(myThid)
176 CALL TIMEAVE_NORMALIZ(FUtave ,SEAICE_timeave, 1,
177 & bi,bj,myThid)
178 CALL TIMEAVE_NORMALIZ(FVtave ,SEAICE_timeave, 1,
179 & bi,bj,myThid)
180 CALL TIMEAVE_NORMALIZ(EmPmRtave,SEAICE_timeave, 1,
181 & bi,bj,myThid)
182 CALL TIMEAVE_NORMALIZ(QNETtave ,SEAICE_timeave, 1,
183 & bi,bj,myThid)
184 CALL TIMEAVE_NORMALIZ(QSWtave ,SEAICE_timeave, 1,
185 & bi,bj,myThid)
186 CALL TIMEAVE_NORMALIZ(UICEtave ,SEAICE_timeave, 1,
187 & bi,bj,myThid)
188 CALL TIMEAVE_NORMALIZ(VICEtave ,SEAICE_timeave, 1,
189 & bi,bj,myThid)
190 CALL TIMEAVE_NORMALIZ(HEFFtave ,SEAICE_timeave, 1,
191 & bi,bj,myThid)
192 CALL TIMEAVE_NORMALIZ(AREAtave ,SEAICE_timeave, 1,
193 & bi,bj,myThid)
194 ENDDO
195 ENDDO
196
197 WRITE(suff,'(I10.10)') myIter
198 _BARRIER
199 _BEGIN_MASTER( myThid )
200 CALL WRITE_FLD_XY_RL('FUtave.' ,suff,FUtave ,myIter,myThid)
201 CALL WRITE_FLD_XY_RL('FVtave.' ,suff,FVtave ,myIter,myThid)
202 CALL WRITE_FLD_XY_RL('EmPmRtave.',suff,EmPmRtave,myIter,myThid)
203 CALL WRITE_FLD_XY_RL('QNETtave.' ,suff,QNETtave ,myIter,myThid)
204 CALL WRITE_FLD_XY_RL('QSWtave.' ,suff,QSWtave ,myIter,myThid)
205 CALL WRITE_FLD_XY_RL('UICEtave.' ,suff,UICEtave ,myIter,myThid)
206 CALL WRITE_FLD_XY_RL('VICEtave.' ,suff,VICEtave ,myIter,myThid)
207 CALL WRITE_FLD_XY_RL('HEFFtave.' ,suff,HEFFtave ,myIter,myThid)
208 CALL WRITE_FLD_XY_RL('AREAtave.' ,suff,AREAtave ,myIter,myThid)
209 _END_MASTER( myThid )
210 _BARRIER
211
212 C Reset averages to zero
213 DO bj = myByLo(myThid), myByHi(myThid)
214 DO bi = myBxLo(myThid), myBxHi(myThid)
215 CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
216 CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
217 CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
218 CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
219 CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
220 CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
221 CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
222 CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
223 CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
224 DO k=1,Nr
225 SEAICE_TimeAve(k,bi,bj)=ZERO
226 ENDDO
227 ENDDO
228 ENDDO
229
230 ENDIF
231
232 #endif /* ALLOW_TIMEAVE */
233
234 #endif /* ALLOW_SEAICE */
235
236 RETURN
237 END
  ViewVC Help
Powered by ViewVC 1.1.22