source: branches/2017/dev_v3.20_2017_transport_max/SOURCES/source_3.20/ice_th.f

Last change on this file was 39, checked in by vancop, 7 years ago

add tank mass and salt balance
File size: 6.0 KB
Line 
1      SUBROUTINE ice_th(nlay_i,nlay_s)
2
3        !!------------------------------------------------------------------
4        !!                ***         ROUTINE ice_th       ***
5        !! ** Purpose :
6        !!           Ice thermodynamics
7        !! ** Method  :
8        !!    This routine calls the thermodynamic and biological routines
9        !!
10        !! ** Arguments :
11        !!           nlay_i, nlay_s
12        !!
13        !! ** Inputs / Ouputs : (global commons)
14        !!
15        !! ** External :
16        !!
17        !! ** References : Vancoppenolle et al., JGR 2007
18        !!
19        !! ** History :
20        !!       (1) CLIO, Goosse and Fichefet, JGR, 1999.
21        !!       (2) LIM-1D, Vancoppenolle et al., JGR, 2007.
22        !!       (3) BIO-LIM, Martin Vancoppenolle, 2008
23        !!
24        !!------------------------------------------------------------------
25        !! * Arguments
26
27      INCLUDE 'type.com'
28      INCLUDE 'para.com'
29      INCLUDE 'const.com'
30      INCLUDE 'ice.com'
31      INCLUDE 'thermo.com'
32      INCLUDE 'bio.com'
33      INCLUDE 'tank.com'
34
35      ! Energy conservation
36      LOGICAL con_i
37
38      zeps0 = 1.0e-16
39      zeps1 = 1.0e-20
40      zeps2 = 1.0e-04
41
42      con_i = .true. ! conservation check in the ice or not
43      jl = 1         ! category number (temporary)
44      ji = 1         ! ji index
45
46      WRITE(numout,*) ' * ice_th : '
47      WRITE(numout,*) ' ~~~~~~~~~~ '
48      WRITE(numout,*) 
49      WRITE(numout,*) ' nlay_i : ', nlay_i
50      WRITE(numout,*) ' nlay_s : ', nlay_s
51      WRITE(numout,*) 
52!
53!-------------------------------------------------------------------------------
54!  1) Initialize sea ice
55!-------------------------------------------------------------------------------
56!
57
58      IF ( numit .EQ. nstart ) THEN
59         CALL ice_phy_ini( 1 , 1 , nlay_s, nlay_i)
60
61         IF ( c_bio_model .EQ. 'KRILL' )
62     &   CALL ice_bio_ini( 1 , 1 , nlay_i )                     ! Bio initialization - KRILL
63
64      ENDIF
65!
66!-------------------------------------------------------------------------------
67!  2) Consistency & Energetic checks
68!-------------------------------------------------------------------------------
69!
70
71      DO layer = 1, nlay_s
72         t_s_b(ji,layer)  =  MIN( tpw , t_s_b(ji,layer) )
73      END DO
74
75      DO layer = 1, nlay_i
76         tmelts           =  - tmut*s_i_b(ji,layer) + tpw
77         t_i_b(ji,layer)  =  MIN(tmelts,t_i_b(ji,layer))
78      END DO
79
80      CALL ice_th_enmelt(1,1, nlay_s, nlay_i) ! ice enthalpy
81
82      ! Initialize total heat content
83      IF ( con_i ) CALL ice_th_glohec( qt_i_in , qt_s_in ,             
84     &                                 q_i_layer_in , 1 , 1 , jl, 
85     &                                 nlay_s , nlay_i )
86
87!
88!-------------------------------------------------------------------------------
89!  3) Model routines
90!-------------------------------------------------------------------------------
91!
92      CALL forcing                                              ! Compute forcing
93
94      CALL ice_rad( nlay_s , nlay_i , 1 , 1 )                   ! Radiative transfer
95
96      CALL ice_th_diff( nlay_s , nlay_i , 1 , 1 )               ! Heat diffusion
97
98      IF ( con_i ) THEN                                         ! Conservation test
99         CALL ice_th_glohec( qt_i_fin , qt_s_fin , q_i_layer_fin ,
100     &                       1 , 1 , jl , nlay_s , nlay_i )
101         CALL ice_th_con_dif( 1 , 1 , nlay_s , nlay_i , jl )
102      ENDIF
103
104      IF ( c_gravdr .EQ. 'CW' )
105     &   CALL ice_sal_diff_CW(nlay_i,1,1)                       ! Salt transport (Cox and Weeks)
106
107      IF ( c_gravdr .EQ. 'RA' )
108     &   CALL ice_sal_diff(nlay_i,1,1)                          ! Salt transport (Rayleigh-number based)
109
110      IF ( c_gravdr .EQ. 'AD' ) 
111     &   CALL ice_sal_adv(nlay_i,1,1)                           ! Salt transport (Advection-based)
112
113      IF ( ( c_bio_model .EQ. 'KRILL' ) .AND. ln_trdiff )
114     &   CALL ice_bio_diff( 1 , 1 , nlay_i )                    ! Bio transport
115
116      IF ( c_bio_model .EQ. 'KRILL' )
117     &   CALL ice_bio_sms(nlay_i,1,1)                           ! KRILL source minus sinks
118     
119      IF ( ( c_bio_model .EQ. 'KRILL' ) .AND. ln_ikaite )
120     &   CALL ice_ikaite(nlay_i)                                ! Ikaite precipitation and dissolution
121
122      CALL ice_gas(nlay_i,1,1)                                  ! Gases
123
124      CALL ice_th_dh(nlay_s,nlay_i,1,1)                         ! Growth and melt
125
126      CALL ice_phy_remap(nlay_s,nlay_i,1,1)                     ! Remap heat and salt
127
128      IF ( con_i ) THEN                                         ! Heat and salt conservation test
129         CALL ice_th_glohec( qt_i_fin , qt_s_fin , q_i_layer_fin ,
130     &                       1 , 1 , jl, nlay_s, nlay_i )
131         CALL ice_th_con_dh(1,1,nlay_s,nlay_i,jl)
132      ENDIF
133
134      IF ( ln_trremp )     
135     &   CALL ice_bio_remap(nlay_s, nlay_i, 1, 1)               ! Remap tracers
136
137      CALL ice_bio_column(kideb,kiut,ntra_bio,ct_i_bio,cbu_i_bio,
138     &                    deltaz_i_bio, .FALSE.)
139     
140      !---------------
141      ! Chlorophyll a
142      !---------------
143      IF ( c_bio_model .EQ. 'KRILL' ) THEN
144         DO layer = 1, nlay_bio
145            chla_i_bio(layer) = cbu_i_bio(4,layer) * chlC_bio(layer) *
146     &                          c_molar
147         END DO
148      ENDIF ! c_bio_model
149
150      IF ( c_bio_model .NE. 'NOBIO' ) 
151     &   WRITE(numout,*) ' chla_i_bio : ', ( chla_i_bio(layer), 
152     &                   layer = 1, nlay_bio )
153
154      !-----------------
155      ! CALL water tank
156      !-----------------
157      CALL wat_tank
158      WRITE(numout,*) ' --- ice_th --- '
159      WRITE(numout,*) ' s_w : ', s_w
160      WRITE(numout,*) ' -------------- '
161
162!-------------------------------------------------------------------------------
163!  4) Outputs
164!-------------------------------------------------------------------------------
165!
166      !---------------
167      ! Netcdf Output
168      !---------------
169      CALL ice_output(nlay_i,nlay_s)
170
171      RETURN
172!
173!------------------------------------------------------------------------------
174!- end of ice_th
175      END
Note: See TracBrowser for help on using the repository browser.