forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
streamice_dump_ad.F
135 lines (116 loc) · 4.29 KB
/
streamice_dump_ad.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_dump_ad.F,v 1.2 2014/05/25 08:16:14 dgoldberg Exp $
C $Name: $
#include "AD_CONFIG.h"
#include "PACKAGES_CONFIG.h"
#include "STREAMICE_OPTIONS.h"
CBOP
C !ROUTINE: adstreamice_dump
C !INTERFACE:
subroutine adstreamice_dump( mytime, myiter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | SUBROUTINE adstreamice_dump |
C *==========================================================*
C Extract adjoint variable from TAMC/TAF-generated
C adjoint common blocks, contained in adcommon.h
C and write fields to file;
C Make sure common blocks in adcommon.h are up-to-date
C w.r.t. current adjoint code.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "STREAMICE.h"
#include "GRID.h"
#ifdef ALLOW_AUTODIFF_MONITOR
# include "adcommon.h"
#endif
LOGICAL DIFFERENT_MULTIPLE
EXTERNAL DIFFERENT_MULTIPLE
INTEGER IO_ERRCOUNT
EXTERNAL IO_ERRCOUNT
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C myIter - iteration counter for this thread
C myTime - time counter for this thread
C myThid - Thread number for this instance of the routine.
integer myThid
integer myiter
_RL mytime
#if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
C !LOCAL VARIABLES:
c == local variables ==
C suff - Hold suffix part of a filename
C beginIOErrCount - Begin and end IO error counts
C endIOErrCount
C msgBuf - Error message buffer
CHARACTER*(MAX_LEN_FNAM) suff
INTEGER beginIOErrCount
INTEGER endIOErrCount
CHARACTER*(MAX_LEN_MBUF) msgBuf
double precision :: area_shelf_streamice_ad(1-olx:snx+olx,1-oly:
$sny+oly,nsx,nsy)
double precision :: b_glen_ad(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
double precision :: bdot_streamice_ad(1-olx:snx+olx,1-oly:sny+oly,
$nsx,nsy)
double precision :: c_basal_friction_ad(1-olx:snx+olx,1-oly:sny+
$oly,nsx,nsy)
double precision :: float_frac_streamice_ad(1-olx:snx+olx,1-oly:
$sny+oly,nsx,nsy)
double precision :: h_streamice_ad(1-olx:snx+olx,1-oly:sny+oly,
$nsx,nsy)
double precision :: surf_el_streamice_ad(1-olx:snx+olx,1-oly:sny+
$oly,nsx,nsy)
double precision :: tau_beta_eff_streamice_ad(1-olx:snx+olx,1-oly:
$sny+oly,nsx,nsy)
double precision :: u_streamice_ad(1-olx:snx+olx,1-oly:sny+oly,
$nsx,nsy)
double precision :: v_streamice_ad(1-olx:snx+olx,1-oly:sny+oly,
$nsx,nsy)
double precision :: visc_streamice_ad(1-olx:snx+olx,1-oly:sny+oly,
$nsx,nsy)
common /streamice_fields_rl_ad/ h_streamice_ad, u_streamice_ad,
$v_streamice_ad, visc_streamice_ad, tau_beta_eff_streamice_ad,
$float_frac_streamice_ad, surf_el_streamice_ad,
$area_shelf_streamice_ad, c_basal_friction_ad, b_glen_ad,
$bdot_streamice_ad
#ifdef USE_ALT_RLOW
double precision :: r_low_si_ad(1-olx:snx+olx,1-oly:sny+oly,nsx,
$nsy)
common /streamice_rlow_ad/ r_low_si_ad
#endif
c == end of interface ==
CEOP
IF (
& DIFFERENT_MULTIPLE(streamice_adjDump,mytime,deltaTClock)
& ) THEN
C-- Set suffix for this set of data files.
WRITE(suff,'(I10.10)') myIter
writeBinaryPrec = writeStatePrec
C-- Read IO error counter
beginIOErrCount = IO_ERRCOUNT(myThid)
CALL WRITE_REC_3D_RL(
& 'ADJc_basal_friction.'//suff, writeBinaryPrec,
& 1, c_basal_friction_ad, 1, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJh_streamice.'//suff, writeBinaryPrec,
& 1, h_streamice_ad, 1, myIter, myThid )
#ifdef USE_ALT_RLOW
CALL WRITE_REC_3D_RL(
& 'ADJr_low.'//suff, writeBinaryPrec,
& 1, r_low_si_ad, 1, myIter, myThid )
#endif
CALL WRITE_REC_3D_RL(
& 'ADJb_glen.'//suff, writeBinaryPrec,
& 1, b_glen_ad, 1, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJbdot.'//suff, writeBinaryPrec,
& 1, bdot_streamice_ad, 1, myIter, myThid )
ENDIF
#endif /* ALLOW_ADJOINT_RUN */
RETURN
END