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

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

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


Revision 1.24 - (show annotations) (download)
Mon Jul 5 20:05:07 2004 UTC (19 years, 11 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint57b_post, checkpoint56b_post, checkpoint54d_post, checkpoint54e_post, checkpoint55, checkpoint57, checkpoint56, checkpoint54f_post, checkpoint55i_post, checkpoint55c_post, checkpoint57a_post, checkpoint54b_post, checkpoint55g_post, checkpoint55d_post, checkpoint54a_pre, checkpoint55d_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint55b_post, checkpoint55f_post, checkpoint56a_post, checkpoint56c_post, checkpoint57a_pre, checkpoint55a_post, checkpoint55e_post, checkpoint54c_post
Changes since 1.23: +1 -2 lines
o require forcing_In_AB=.FALSE. and remove surfaceTendencyTice from pkg/seaice
  - modified verification/lab_sea and natl_box_adjoint accordingly

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_model.F,v 1.23 2004/05/05 07:15:41 dimitri Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SEAICE_MODEL
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE seaice_model( myTime, myIter, myThid )
11
12 C !DESCRIPTION: \bv
13 C /===========================================================\
14 C | SUBROUTINE SEAICE_MODEL |
15 C | o Time stepping of a dynamic/thermodynamic sea ice model. |
16 C | Dynamics solver: Zhang/Hibler, JGR, 102, 8691-8702, 1997 |
17 C | Thermodynamics: Hibler, MWR, 108, 1943-1973, 1980 |
18 C | Rheology: Hibler, JPO, 9, 815- 846, 1979 |
19 C | Snow: Zhang et al. , JPO, 28, 191- 217, 1998 |
20 C | Parallel forward ice model written by Jinlun Zhang PSC/UW|
21 C | & coupled into MITgcm by Dimitris Menemenlis (JPL) 2/2001|
22 C | zhang@apl.washington.edu / menemenlis@jpl.nasa.gov |
23 C |===========================================================|
24 C \===========================================================/
25 IMPLICIT NONE
26 c \ev
27
28 C !USES: ===============================================================
29 C === Global variables ===
30 #include "SIZE.h"
31 #include "EEPARAMS.h"
32 #include "DYNVARS.h"
33 #include "PARAMS.h"
34 #include "GRID.h"
35 #include "FFIELDS.h"
36 #include "SEAICE.h"
37 #include "SEAICE_PARAMS.h"
38
39 #ifdef SEAICE_EXTERNAL_FORCING
40 # include "SEAICE_FFIELDS.h"
41 #endif
42
43 #ifdef ALLOW_AUTODIFF_TAMC
44 # include "tamc.h"
45 #endif
46
47 C !INPUT PARAMETERS: ===================================================
48 C === Routine arguments ===
49 C myTime - Simulation time
50 C myIter - Simulation timestep number
51 C myThid - Thread no. that called this routine.
52 _RL myTime
53 INTEGER myIter
54 INTEGER myThid
55 CEndOfInterface
56
57 #ifdef ALLOW_SEAICE
58
59 C !LOCAL VARIABLES: ====================================================
60 C === Local variables ===
61 C i,j,bi,bj - Loop counters
62 INTEGER i, j, bi, bj
63 LOGICAL DIFFERENT_MULTIPLE
64 EXTERNAL DIFFERENT_MULTIPLE
65 CEOP
66
67 #ifdef SEAICE_EXTERNAL_FORCING
68 C-- Atmospheric state and runoff are from
69 C pkg/exf, which does not update edges.
70 CALL EXCH_UV_XY_RL(uwind,vwind,.TRUE.,myThid)
71 _EXCH_XY_R8( atemp, myThid )
72 _EXCH_XY_R8( aqh, myThid )
73 _EXCH_XY_R8( lwdown, myThid )
74 _EXCH_XY_R8( swdown, mythid )
75 _EXCH_XY_R8( precip, myThid )
76 _EXCH_XY_R8( evap, myThid )
77 _EXCH_XY_R8( runoff, myThid )
78 #else /* SEAICE_EXTERNAL_FORCING */
79 C-- Load atmospheric state and runoff.
80 CALL SEAICE_GET_FORCING ( myTime, myIter, myThid )
81 #endif /* SEAICE_EXTERNAL_FORCING */
82
83 C-- Compute proxy for geostrophic velocity,
84 DO bj=myByLo(myThid),myByHi(myThid)
85 DO bi=myBxLo(myThid),myBxHi(myThid)
86 DO j=0,sNy+1
87 DO i=0,sNx+1
88 GWATX(I,J,bi,bj)=HALF*(uVel(i,j,KGEO(I,J,bi,bj),bi,bj)
89 & +uVel(i,j-1,KGEO(I,J,bi,bj),bi,bj))
90 GWATY(I,J,bi,bj)=HALF*(vVel(i,j,KGEO(I,J,bi,bj),bi,bj)
91 & +vVel(i-1,j,KGEO(I,J,bi,bj),bi,bj))
92 #ifdef SEAICE_DEBUG
93 c write(*,'(2i4,2i2,f7.1,7f12.3)')
94 c & ,i,j,bi,bj,UVM(I,J,bi,bj)
95 c & ,GWATX(I,J,bi,bj),GWATY(I,J,bi,bj)
96 c & ,uVel(i+1,j,3,bi,bj),uVel(i+1,j+1,3,bi,bj)
97 c & ,vVel(i,j+1,3,bi,bj),vVel(i+1,j+1,3,bi,bj)
98 #endif
99 ENDDO
100 ENDDO
101 ENDDO
102 ENDDO
103
104 #ifdef ALLOW_AUTODIFF_TAMC
105 CADJ STORE uwind = comlev1, key = ikey_dynamics
106 CADJ STORE vwind = comlev1, key = ikey_dynamics
107 CADJ STORE heff = comlev1, key = ikey_dynamics
108 # ifdef SEAICE_ALLOW_DYNAMICS
109 CADJ STORE area = comlev1, key = ikey_dynamics
110 # endif
111 #endif /* ALLOW_AUTODIFF_TAMC */
112
113 C solve ice momentum equations and calculate ocean surface stress
114 IF ( DIFFERENT_MULTIPLE(
115 & SEAICE_deltaTdyn,myTime,myTime-SEAICE_deltaTtherm) ) THEN
116 CALL TIMER_START('DYNSOLVER [SEAICE_MODEL]',myThid)
117 CALL DYNSOLVER ( myTime, myIter, myThid )
118 CALL TIMER_STOP ('DYNSOLVER [SEAICE_MODEL]',myThid)
119 ENDIF
120
121 #ifdef ALLOW_AUTODIFF_TAMC
122 # ifdef SEAICE_ALLOW_DYNAMICS
123 CADJ STORE heff = comlev1, key = ikey_dynamics
124 CADJ STORE area = comlev1, key = ikey_dynamics
125 CADJ STORE uice = comlev1, key = ikey_dynamics
126 CADJ STORE vice = comlev1, key = ikey_dynamics
127 # endif
128 #endif /* ALLOW_AUTODIFF_TAMC */
129 C NOW DO ADVECTION
130 CALL ADVECT( UICE, VICE, HEFF, HEFFM, myThid )
131 CALL ADVECT( UICE, VICE, AREA, HEFFM, myThid )
132
133 C NOW DO GROWTH
134 C MUST CALL GROWTH ONLY AFTER CALLING ADVECTION
135 CALL GROWTH( myTime, myIter, myThid)
136
137 C-- Update overlap regions for a bunch of stuff
138 _BARRIER
139 CALL SEAICE_EXCH( HEFF, myThid )
140 CALL SEAICE_EXCH( AREA, myThid )
141 CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
142 _EXCH_XY_R4(EmPmR, myThid )
143 _EXCH_XY_R4(Qnet , myThid )
144 #ifdef SHORTWAVE_HEATING
145 _EXCH_XY_R4(Qsw , myThid )
146 #endif
147 _EXCH_XYZ_R8(theta , myThid )
148
149 C-- Sea ice diagnostics.
150 C <= moved to S/R do_the_model_io with other pkgs
151
152 C-- Write sea ice restart files
153 C <= moved to S/R packages_write_pickup with other pkgs
154
155 C---------------------------------------------------
156 C OOH NOOOO we need to move the whole stuff
157 C---------------------------------------------------
158 #ifdef ALLOW_AUTODIFF_TAMC
159 CRG CADJ store UICE,VICE,AREA,HEFF,fu,fv,EmPmR,Qnet,Qsw = comlev1_bibj
160 #endif
161
162 C-- Call sea-ice cost function routine
163 CRG CALL SEAICE_COST( myTime, myIter, myThid )
164
165 #endif /* ALLOW_SEAICE */
166
167 RETURN
168 END

  ViewVC Help
Powered by ViewVC 1.1.22