/[MITgcm]/MITgcm/verification/bottom_ctrl_5x5/code_ad/dummy_in_hfac.F
ViewVC logotype

Contents of /MITgcm/verification/bottom_ctrl_5x5/code_ad/dummy_in_hfac.F

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


Revision 1.1 - (show annotations) (download)
Wed Jun 7 02:00:01 2006 UTC (14 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint59, checkpoint58i_post, checkpoint58o_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58m_post
Adding verification for 5x5 box (4-layer) bottom topography control

1 #include "CPP_OPTIONS.h"
2
3 subroutine dummy_in_hfac( myname, myIter, myThid )
4 IMPLICIT NONE
5 C /==========================================================\
6 C | SUBROUTINE dummy_in_hfac |
7 C |==========================================================|
8 C == Global variables ===
9
10 #include "SIZE.h"
11 #include "EEPARAMS.h"
12 #include "PARAMS.h"
13
14 C == Routine arguments ==
15 C myThid - Thread number for this instance of the routine.
16 INTEGER myThid
17 INTEGER myIter
18 CHARACTER*(*) myname
19
20 call TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
21
22 call TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
23
24 end
25
26 CBOP
27 C !ROUTINE: addummy_in_hfac
28 C !INTERFACE:
29 subroutine addummy_in_hfac( myname, myIter, myThid )
30
31 C !DESCRIPTION: \bv
32 C *==========================================================*
33 C | SUBROUTINE addummy_in_hfac |
34 C *==========================================================*
35 C Extract adjoint variable from TAMC/TAF-generated
36 C adjoint common blocks, contained in adcommon.h
37 C and write fields to file;
38 C Make sure common blocks in adcommon.h are up-to-date
39 C w.r.t. current adjoint code.
40 C *==========================================================*
41 C | SUBROUTINE addummy_in_hfac |
42 C *==========================================================*
43 C \ev
44
45 C !USES:
46 IMPLICIT NONE
47
48 C == Global variables ===
49 #include "SIZE.h"
50 #include "EEPARAMS.h"
51 #include "PARAMS.h"
52 #ifdef ALLOW_AUTODIFF_MONITOR
53 #include "adcommon.h"
54 #endif
55
56 LOGICAL DIFFERENT_MULTIPLE
57 EXTERNAL DIFFERENT_MULTIPLE
58 INTEGER IO_ERRCOUNT
59 EXTERNAL IO_ERRCOUNT
60
61 C !INPUT/OUTPUT PARAMETERS:
62 C == Routine arguments ==
63 C myThid - Thread number for this instance of the routine.
64 integer myThid
65 integer myIter
66 CHARACTER*(1) myname
67
68 #ifdef ALLOW_AUTODIFF_MONITOR
69 C !LOCAL VARIABLES:
70 c == local variables ==
71 C suff - Hold suffix part of a filename
72 C beginIOErrCount - Begin and end IO error counts
73 C endIOErrCount
74 C msgBuf - Error message buffer
75 CHARACTER*(MAX_LEN_FNAM) suff
76 INTEGER beginIOErrCount
77 INTEGER endIOErrCount
78 CHARACTER*(MAX_LEN_MBUF) msgBuf
79 _RL mytime
80 CHARACTER*(5) myfullname
81
82 c == end of interface ==
83 CEOP
84
85 #ifdef ALLOW_DEPTH_CONTROL
86
87 mytime = 0.
88
89 call TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
90
91 IF (
92 & DIFFERENT_MULTIPLE(dumpFreq,mytime,
93 & mytime-deltaTClock)
94 & ) THEN
95
96 _BARRIER
97 _BEGIN_MASTER( myThid )
98
99 C-- Set suffix for this set of data files.
100 WRITE(suff,'(I10.10)') myIter
101 writeBinaryPrec = writeStatePrec
102
103 C-- Read IO error counter
104 beginIOErrCount = IO_ERRCOUNT(myThid)
105
106 IF ( myname .eq. 'C' ) THEN
107 myfullname = 'hFacC'
108 CALL WRITE_FLD_XYZ_RL ( 'ADJhFacC.', suff, adhfacc,
109 & myIter, myThid)
110 ELSE IF ( myname .eq. 'W' ) THEN
111 myfullname = 'hFacW'
112 CALL WRITE_FLD_XYZ_RL ( 'ADJhFacW.', suff, adhfacw,
113 & myIter, myThid)
114 ELSE IF ( myname .eq. 'S' ) THEN
115 myfullname = 'hFacS'
116 CALL WRITE_FLD_XYZ_RL ( 'ADJhFacS.', suff, adhfacs,
117 & myIter, myThid)
118 ELSE
119 write(*,*) 'addummy_in_hfac: no valid myname specified'
120 END IF
121 C-- Reread IO error counter
122 endIOErrCount = IO_ERRCOUNT(myThid)
123
124 C-- Check for IO errors
125 IF ( endIOErrCount .NE. beginIOErrCount ) THEN
126 WRITE(msgBuf,'(A)') 'S/R WRITE_STATE'
127 CALL PRINT_ERROR( msgBuf, 1 )
128 WRITE(msgBuf,'(A)') 'Error writing out model state'
129 CALL PRINT_ERROR( msgBuf, 1 )
130 WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
131 CALL PRINT_ERROR( msgBuf, 1 )
132 ELSE
133 WRITE(msgBuf,'(A,I10)')
134 & '// ad'//myfullname//' written, timestep', myIter
135 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
136 & SQUEEZE_RIGHT, 1 )
137 WRITE(msgBuf,'(A)') ' '
138 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
139 & SQUEEZE_RIGHT, 1 )
140 ENDIF
141
142 _END_MASTER( myThid )
143 _BARRIER
144
145 ENDIF
146
147 call TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
148 #endif /* ALLOW_DEPTH_CONTROL */
149 #endif ALLOW_AUTODIFF_MONITOR
150
151 end

  ViewVC Help
Powered by ViewVC 1.1.22