/[MITgcm]/MITgcm/pkg/grdchk/grdchk_print.F
ViewVC logotype

Contents of /MITgcm/pkg/grdchk/grdchk_print.F

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

Revision 1.9 - (show annotations) (download)
Mon Oct 27 22:32:55 2003 UTC (20 years, 6 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint52l_pre, hrcube4, hrcube5, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint52d_pre, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint52j_pre, checkpoint54d_post, checkpoint54e_post, checkpoint62c, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint52l_post, checkpoint52k_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint52, checkpoint58f_post, checkpoint52f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint54f_post, checkpoint62a, checkpoint62e, checkpoint62d, checkpoint58y_post, checkpoint51t_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint57t_post, checkpoint55c_post, checkpoint52e_pre, checkpoint57v_post, checkpoint57f_post, checkpoint52e_post, checkpoint53d_post, checkpoint60, checkpoint61, checkpoint62, checkpoint57a_post, checkpoint57h_pre, checkpoint52b_pre, checkpoint54b_post, checkpoint58w_post, checkpoint57h_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55g_post, checkpoint51q_post, checkpoint52b_post, checkpoint52c_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint52f_pre, checkpoint55d_post, checkpoint58e_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint58n_post, checkpoint51r_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint52d_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint52a_pre, checkpoint62b, checkpoint58v_post, checkpoint52i_post, checkpoint52h_pre, checkpoint56a_post, checkpoint58l_post, checkpoint53f_post, checkpoint57h_done, checkpoint52j_post, checkpoint57j_post, checkpoint57f_pre, checkpoint61f, checkpoint58g_post, branch-netcdf, checkpoint58x_post, checkpoint61n, checkpoint52n_post, checkpoint53b_pre, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint51o_post, checkpoint61q, checkpoint57k_post, checkpoint53b_post, checkpoint52a_post, checkpoint57w_post, checkpoint61e, checkpoint58i_post, ecco_c52_e35, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint61g, checkpoint61d, checkpoint54c_post, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint51p_post, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint51u_post
Branch point for: branch-nonh, netcdf-sm0
Changes since 1.8: +4 -4 lines 
o cleaning ALLOW_GRADIENT_CHECK -> ALLOW_GRDCHK
o cleaning some ALLOW_TANGENTLINEAR_RUN -> ALLOW_AUTODIFF
o bug fix in find_alpha.F for MDJWF:
  - modif. to alpha = 1/D*( dN/dT - rho*dD/Dt) to account for
    change rho -> rho-rhoConst
  - replace call find_rho to find_rhonum
1 C
2 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_print.F,v 1.8 2003/10/23 04:41:41 edhill Exp $
3 C $Name: $
4
5 #include "AD_CONFIG.h"
6 #include "CPP_OPTIONS.h"
7
8
9 subroutine grdchk_print(
10 I ichknum,
11 I ierr_grdchk,
12 I mythid
13 & )
14
15 c ==================================================================
16 c SUBROUTINE grdchk_print
17 c ==================================================================
18 c
19 c o Print the results of the gradient check.
20 c
21 c started: Christian Eckert eckert@mit.edu 08-Mar-2000
22 c continued: heimbach@mit.edu: 13-Jun-2001
23 c
24 c ==================================================================
25 c SUBROUTINE grdchk_print
26 c ==================================================================
27
28 implicit none
29
30 c == global variables ==
31
32 #include "EEPARAMS.h"
33 #include "SIZE.h"
34 #include "GRID.h"
35 #include "grdchk.h"
36
37 c == routine arguments ==
38
39 integer ichknum
40 integer ierr_grdchk
41 integer mythid
42
43 #ifdef ALLOW_GRDCHK
44 c == local variables ==
45
46 _RL fcref
47 _RL fcpertplus, fcpertminus
48 _RL xxmemo_ref
49 _RL xxmemo_pert
50 _RL gfd
51 _RL adxxmemo
52 _RL ftlxxmemo
53 _RL ratio_ad
54 _RL ratio_ftl
55
56 integer i
57 integer itile
58 integer jtile
59 integer itilepos
60 integer jtilepos
61 integer layer
62 integer icomp
63 integer ierr
64
65 integer numchecks
66
67 character*(max_len_mbuf) msgbuf
68
69 c == end of interface ==
70
71 c-- Print header.
72 write(msgbuf,'(a)')
73 &' '
74 call print_message( msgbuf, standardmessageunit,
75 & SQUEEZE_RIGHT , mythid)
76 write(msgbuf,'(a)')
77 &'// ======================================================='
78 call print_message( msgbuf, standardmessageunit,
79 & SQUEEZE_RIGHT , mythid)
80 write(msgbuf,'(a)')
81 &'// Gradient check results >>> START <<<'
82 call print_message( msgbuf, standardmessageunit,
83 & SQUEEZE_RIGHT , mythid)
84 write(msgbuf,'(a)')
85 &'// ======================================================='
86 call print_message( msgbuf, standardmessageunit,
87 & SQUEEZE_RIGHT , mythid)
88 write(msgbuf,'(a)')
89 &' '
90 call print_message( msgbuf, standardmessageunit,
91 & SQUEEZE_RIGHT , mythid)
92 write(msgbuf,'(a)')
93 &' '
94 call print_message( msgbuf, standardmessageunit,
95 & SQUEEZE_RIGHT , mythid)
96
97 write(msgbuf,'(a,e10.3)')
98 &' EPS = ',grdchk_eps
99 call print_message( msgbuf, standardmessageunit,
100 & SQUEEZE_RIGHT , mythid)
101
102 write(msgbuf,'(a,7(1x,a15))')
103 & 'grdchk output: ', 'procId', 'I', 'ITILEPOS', 'JTILEPOS',
104 & 'LAYER', 'X(I)', 'X(I)+/-EPS'
105 call print_message( msgbuf, standardmessageunit,
106 & SQUEEZE_RIGHT , mythid)
107 #ifdef ALLOW_TANGENTLINEAR_RUN
108 write(msgbuf,'(a,7(1x,a15))')
109 & 'grdchk output: ', ' ', 'FC', 'FC1', 'FC2',
110 & 'FC1-FC2/(2*EPS)', 'TLM GRAD(FC)', '1-FDGRD/TLMGRD'
111 #else
112 write(msgbuf,'(a,7(1x,a15))')
113 & 'grdchk output: ', ' ', 'FC', 'FC1', 'FC2',
114 & 'FC1-FC2/(2*EPS)', 'ADJ GRAD(FC)', '1-FDGRD/ADGRD'
115 #endif
116 call print_message( msgbuf, standardmessageunit,
117 & SQUEEZE_RIGHT , mythid)
118
119 c-- Individual checks.
120 if ( ierr_grdchk .eq. 0 ) then
121 numchecks = ichknum
122 else
123 numchecks = maxgrdchecks
124 endif
125
126 do i = 1, numchecks
127 xxmemo_ref = xxmemref (i)
128 xxmemo_pert = xxmempert (i)
129 adxxmemo = adxxmem (i)
130 ftlxxmemo = ftlxxmem (i)
131 fcref = fcrmem (i)
132 fcpertplus = fcppmem (i)
133 fcpertminus = fcpmmem (i)
134 gfd = gfdmem (i)
135 ratio_ad = ratioadmem (i)
136 ratio_ftl = ratioftlmem (i)
137 itile = bimem (i)
138 jtile = bjmem (i)
139 itilepos = ilocmem (i)
140 jtilepos = jlocmem (i)
141 layer = klocmem (i)
142 icomp = icompmem(i)
143 ierr = ierrmem (i)
144
145 write(msgbuf,'(A,5(I16),2(1x,D15.9))')
146 & 'grdchk output: ',
147 & myprocid, i, itilepos, jtilepos, layer,
148 & xxmemo_ref, xxmemo_pert
149 call print_message( msgbuf, standardmessageunit,
150 & SQUEEZE_RIGHT , mythid)
151 if ( ierr .eq. 0 ) then
152 #ifdef ALLOW_TANGENTLINEAR_RUN
153 write(msgbuf,'(A,1(1x,a15),6(1x,D15.9))')
154 & 'grdchk output: ', ' ',
155 & fcref, fcpertplus, fcpertminus,
156 & gfd, ftlxxmemo, ratio_ftl
157 #else
158 write(msgbuf,'(A,1(1x,a15),6(1x,D15.9))')
159 & 'grdchk output: ', ' ',
160 & fcref, fcpertplus, fcpertminus,
161 & gfd, adxxmemo, ratio_ad
162 #endif
163 call print_message( msgbuf, standardmessageunit,
164 & SQUEEZE_RIGHT , mythid)
165 else
166 if ( ierr .eq. -1 ) then
167 write(msgbuf,'(a)')
168 & ' Component does not exist (zero)'
169 else if ( ierr .eq. -2 ) then
170 write(msgbuf,'(a)')
171 & ' Component does not exist (negative)'
172 else if ( ierr .eq. -3 ) then
173 write(msgbuf,'(a)')
174 & ' Component does not exist (too large)'
175 else if ( ierr .eq. -4 ) then
176 write(msgbuf,'(a)')
177 & ' Component does not exist (land point)'
178 endif
179 call print_message( msgbuf, standardmessageunit,
180 & SQUEEZE_RIGHT , mythid)
181 endif
182 write(msgbuf,'(a)')
183 & ' '
184 call print_message( msgbuf, standardmessageunit,
185 & SQUEEZE_RIGHT , mythid)
186 enddo
187
188 c-- Print final lines.
189 write(msgbuf,'(a)')
190 &' '
191 call print_message( msgbuf, standardmessageunit,
192 & SQUEEZE_RIGHT , mythid)
193 write(msgbuf,'(a)')
194 &'// ======================================================='
195 call print_message( msgbuf, standardmessageunit,
196 & SQUEEZE_RIGHT , mythid)
197 write(msgbuf,'(a)')
198 &'// Gradient check results >>> END <<<'
199 call print_message( msgbuf, standardmessageunit,
200 & SQUEEZE_RIGHT , mythid)
201 write(msgbuf,'(a)')
202 &'// ======================================================='
203 call print_message( msgbuf, standardmessageunit,
204 & SQUEEZE_RIGHT , mythid)
205 write(msgbuf,'(a)')
206 &' '
207 call print_message( msgbuf, standardmessageunit,
208 & SQUEEZE_RIGHT , mythid)
209
210 #endif /* ALLOW_GRDCHK */
211
212 return
213 end
214
  ViewVC Help
Powered by ViewVC 1.1.22