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

Contents of /MITgcm_contrib/dgoldberg/streamice/streamice_timestep.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:14 2014 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
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_solo_timestep.F,v 1.3 2014/06/04 13:03:11 dgoldberg Exp $
2 C $Name: $
3
4 #include "STREAMICE_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7
8 CBOP
9 SUBROUTINE STREAMICE_TIMESTEP ( myThid, myIter,
10 & iLoop, myTime )
11
12 C /============================================================\
13 C | SUBROUTINE |
14 C | o |
15 C |============================================================|
16 C | |
17 C \============================================================/
18 IMPLICIT NONE
19
20 C === Global variables ===
21 #include "SIZE.h"
22 #include "GRID.h"
23 #include "EEPARAMS.h"
24 #include "PARAMS.h"
25 #include "STREAMICE.h"
26 #ifdef ALLOW_AUTODIFF_TAMC
27 # include "tamc.h"
28 # include "STREAMICE_ADV.h"
29 # include "STREAMICE_BDRY.h"
30 # include "STREAMICE_CG.h"
31 #endif
32
33
34 INTEGER myThid, myIter, iLoop
35 _RL myTime
36 LOGICAL DIFFERENT_MULTIPLE
37 EXTERNAL DIFFERENT_MULTIPLE
38
39
40 #ifdef ALLOW_STREAMICE
41
42 INTEGER i, j, bi, bj, ki, kj
43 ! _RL Iratio, Imin_ratio, time_step_remain, local_u_max
44 ! _RL ratio, min_ratio
45 ! _RL local_v_max, time_step_int, min_time_step
46 CHARACTER*(MAX_LEN_MBUF) msgBuf
47 LOGICAL do_vel, tmp_residcheck, tmp_fpcheck
48
49 #ifdef ALLOW_AUTODIFF_TAMC
50 c**************************************
51 #include "streamice_ad_check_lev1_dir.h"
52 c**************************************
53 #endif
54
55 ! time_step_remain = deltaT
56 ! min_time_step = 1000.0
57 ! n_interm = 0
58
59 do_vel = .false.
60
61 #ifdef ALLOW_AUTODIFF_TAMC
62
63 DO bj=myByLo(myThid),myByHi(myThid)
64 DO bi=myBxLo(myThid),myBxHi(myThid)
65 DO j=1-OLy,sNy+OLy
66 DO i=1-OLx,sNx+OLx
67 STREAMICE_ufacemask(i,j,bi,bj) = 0. _d 0
68 STREAMICE_vfacemask(i,j,bi,bj) = 0. _d 0
69 ru_old_si(i,j,bi,bj) = 0. _d 0
70 rv_old_si(i,j,bi,bj) = 0. _d 0
71 zu_old_si(i,j,bi,bj) = 0. _d 0
72 zv_old_si(i,j,bi,bj) = 0. _d 0
73 ! h_after_uflux_si(i,j,bi,bj) = 0. _d 0
74 #ifdef STREAMICE_HYBRID_STRESS
75 streamice_taubx (i,j,bi,bj) = 0. _d 0
76 streamice_tauby (i,j,bi,bj) = 0. _d 0
77 #endif
78 ENDDO
79 ENDDO
80 ENDDO
81 ENDDO
82
83 #endif
84
85 CALL TIMER_START('STREAMICE_TIMESTEP [FORWARD_STEP]',
86 & myThid)
87
88 WRITE(msgBuf,'(A,I10.10,E9.2,A)')
89 & 'streamice solo_time_step: nIter',
90 & myIter, myTime/86400.0/365.0, 'seconds'
91 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
92 & SQUEEZE_RIGHT , 1)
93
94 CALL STREAMICE_DUMP( mytime, myiter, myThid )
95
96 ! NEW DIRECTIVES - DNG
97 !#ifdef ALLOW_AUTODIFF_TAMC
98 !CADJ STORE float_frac_streamice = comlev1, key = ikey_dynamics,
99 !CADJ & kind = isbyte
100 !CADJ STORE surf_el_streamice = comlev1, key = ikey_dynamics,
101 !CADJ & kind = isbyte
102 !CADJ STORE base_el_streamice = comlev1, key = ikey_dynamics,
103 !CADJ & kind = isbyte
104 !#endif
105 ! NEW DIRECTIVES - DNG
106
107 !#ifdef ALLOW_GENTIM2D_CONTROL
108 ! CALL CTRL_MAP_GENTIM2D (myTime, myIter, myThid)
109 !#endif
110
111 do_vel = DIFFERENT_MULTIPLE( streamice_vel_update,
112 & myTime, deltaT )
113
114
115 if (myIter.eq.0) then
116 CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
117 CALL WRITE_FLD_XY_RL
118 & ("surf_el_init","",surf_el_streamice,0,myThid)
119 endif
120
121 CALL STREAMICE_VELMASK_UPD (myThid)
122
123 #ifdef ALLOW_STREAMICE_FLUX_CONTROL
124 CALL STREAMICE_APPLY_FLUX_CTRL ( myTime, myIter, myThid )
125 #endif
126
127 #ifdef ALLOW_STREAMICE_TIMEDEP_FORCING
128 CALL STREAMICE_FIELDS_LOAD( myTime, myIter, myThid )
129 #endif
130
131 if (streamice_maxnliter_cpl.eq.0 .OR. myIter.eq.0) then
132
133 tmp_fpcheck = STREAMICE_chkfixedptconvergence
134 tmp_residcheck = STREAMICE_chkresidconvergence
135
136 STREAMICE_chkfixedptconvergence = .true.
137 STREAMICE_chkresidconvergence = .true.
138
139 CALL STREAMICE_VEL_SOLVE( myThid,
140 & streamice_max_nl_iter,
141 & streamice_max_cg_iter
142 & )
143
144 STREAMICE_chkfixedptconvergence = tmp_fpcheck
145 STREAMICE_chkresidconvergence = tmp_residcheck
146
147 elseif (do_vel) then
148
149 CALL STREAMICE_VEL_SOLVE( myThid,
150 & streamice_maxnliter_cpl,
151 & streamice_maxcgiter_cpl
152 & )
153 endif
154
155 if(.not.STREAMICE_diagnostic_only) THEN
156
157 CALL STREAMICE_ADVECT_THICKNESS ( myThid, myIter, deltaT )
158
159 endif
160
161 ! CALL AT END INSTEAD OF BEGINNING - DNG
162 CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
163 ! print *, "GOT HERE TIMESTEP ", H_streamice(1,50,1,1)
164 ! call write_fld_xy_rl("h_got_here","",H_streamice,0,mythid)
165 ! call write_fld_xy_rl("u_got_here","",U_streamice,0,mythid)
166 ! call write_fld_xy_rl("v_got_here","",V_streamice,0,mythid)
167
168
169 CALL TIMER_STOP('STREAMICE_TIMESTEP [FORWARD_STEP]',
170 & myThid)
171
172 #endif
173 RETURN
174 END

  ViewVC Help
Powered by ViewVC 1.1.22