source: branches/2016/dev_v3.20_2016_gravity_drainage/SOURCES/source_3.20/ice_phy_ini.f @ 24

Last change on this file since 24 was 9, checked in by vancop, 8 years ago

New Gravity Drainage Scheme v1

File size: 6.5 KB
Line 
1      SUBROUTINE ice_phy_ini(kideb,kiut, nlay_s, nlay_i)
2
3      ! BIO-LIM1D, 2008 (M. Vancoppenolle)
4      ! update 2014, v3.04
5
6      ! This routine initializes ice variables
7     
8!------------------------------------------------------------------------------!
9
10      INCLUDE 'type.com'
11      INCLUDE 'para.com'
12      INCLUDE 'const.com'
13      INCLUDE 'ice.com'
14      INCLUDE 'thermo.com'
15      INCLUDE 'bio.com'
16
17      CHARACTER(len=10) :: 
18     &   filenc='init.nc'
19
20      REAL(4)        zini(1)  ! forcing field dummy array
21      REAL(4)        zzi(maxnlay), zti(maxnlay), zsi(maxnlay) ! forcing field dummy array
22      REAL(4)        zdsi(maxnlay), zno3(maxnlay), zpo4(maxnlay)
23      REAL(4)        zdaf(maxnlay)
24
25      REAL(8), DIMENSION (maxnlay) :: 
26     &   zsh_i0              ,   !: old ice salt content (ppt.m-2)
27     &   zsh_i1                  !: new ice salt content (ppt.m-2)
28
29      REAL(8), DIMENSION (maxnlay) :: 
30     &   zqh_i0              ,   !: old ice heat content (J.m-2)
31     &   zqh_i1                  !: new ice heat content (J.m-2)
32
33      REAL(8), DIMENSION (maxnlay+2) ::
34     &   zthick0                 !: thickness of old layers
35
36      REAL(8), DIMENSION (6)       :: 
37     &   zp
38
39      WRITE(numout,*) ' * ice_phy_ini : '
40      WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
41      WRITE(numout,*) 
42
43      zeps = 1.0e-10
44      ji = 1
45
46!
47!------------------------------------------------------------------------------|
48!  1) Case of a NETCDF file
49!------------------------------------------------------------------------------|
50!
51      !-----------
52      ! Open file
53      !-----------
54      CALL CF_OPEN  (filenc,id) ! open forcing file
55
56      !-----------
57      ! Read data
58      !-----------
59      zn = 0.0
60      CALL CF_READ1D ( filenc, 'nlay', 1, 1, zini )
61      zn = REAL(zini(1))
62
63      zj_d = 0.0
64      CALL CF_READ1D ( filenc, 'j_d', 1, 1, zini )
65      zj_d = REAL(zini(1))
66
67      CALL CF_READ1D ( filenc, 'h_s', 1, 1, zini)
68      ht_s_b(ji) = REAL(zini(1))
69       
70
71      CALL CF_READ1D ( filenc, 'h_i', 1, 1, zini)
72      ht_i_b(ji) = REAL(zini(1))
73
74      CALL CF_READ1D ( filenc, 't_s', 1, 1, zini)
75      t_s_b(ji,1) = REAL(zini(1))
76
77      CALL CF_READ1D ( filenc, 't_su', 1, 1, zini)
78      t_su_b(ji) = REAL(zini(1))
79
80      DO layer = 1, INT(zn)
81         CALL CF_READ1D ( filenc, 'z_i', layer, 1, zini)
82         zzi(layer) = zini(1)
83         CALL CF_READ1D ( filenc, 't_i', layer, 1, zini)
84         zti(layer) = zini(1)
85         CALL CF_READ1D ( filenc, 's_i', layer, 1, zini)
86         zsi(layer) = zini(1)
87      END DO
88
89      CALL CF_CLOSE (filenc) ! close nc file
90
91      IF ( c_sbr .EQ. 'LIN' ) THEN
92
93         t_bo_b(ji)   =  273.15-tmut*oce_sal 
94
95      ENDIF
96
97      IF ( c_sbr .EQ. 'NTZ' ) THEN
98
99         zp(1) = -0.0210;      zp(2) = -0.0015
100         zp(3) = 2.3631d-05;   zp(4) = -1.8129d-07
101         zp(5) = 5.8694d-10;   zp(6) = -6.7021d-13
102
103         t_bo_b(ji)   = 273.15
104         DO ii = 1, 6
105            t_bo_b(ji) = t_bo_b(ji) + zp(ii)*oce_sal**ii
106         ENDDO
107
108      ENDIF
109
110      IF ( c_sbr .EQ. 'WEA' ) THEN
111
112         zp(1) = -0.0571;      zp(2) = -5.7866e-05
113         zp(3) = -3.0716e-07;  zp(4) = 1.4240e-10
114         zp(5) = 2.1844e-12;   zp(6) = -1.7638e-14
115
116         t_bo_b(ji)   = 273.15
117         DO ii = 1, 6
118            t_bo_b(ji) = t_bo_b(ji) + zp(ii)*oce_sal**ii
119         ENDDO
120
121      ENDIF
122
123
124      !----------------------
125      ! Interpolate profiles
126      !----------------------
127
128            !------
129            ! Snow
130            !------
131            CALL ice_phy_grid(1,1,nlay_s,ht_s_b(ji), .FALSE., "sno" )   ! compute the physical grid
132
133            !-----
134            ! Ice
135            !-----
136            CALL ice_phy_grid(1,1,nlay_i,ht_i_b(ji), .FALSE., "ice" )   ! compute the physical grid
137
138            ! grid indexes for redistribution
139            ntop0  = 1 
140            nbot0  = INT(zn)
141            ntop1  = 1
142            nbot1  = nlay_i
143
144            !--- Salinity
145            zm0(0) = 0.0         ! layer interfaces cotes
146            DO layer = 1, nbot0-1
147               zm0(layer) = REAL( zzi(layer) + zzi(layer+1) ) / 2.
148            END DO
149            zm0(nbot0) = ht_i_b(ji)
150
151            DO layer = 1, nbot0  !layer thickness and salt content
152               zthick0(layer) = zm0(layer)-zm0(layer-1)
153               zsh_i0(layer) = rhog*zthick0(layer)*REAL(zsi(layer)) !mass of salt
154            END DO
155
156            CALL ice_phy_relay( nbot0 , nbot1 , ntop0 , ntop1 , 
157     &                       zthick0, deltaz_i_phy, zsh_i0 , zsh_i1 )
158
159            DO layer = 1, nlay_i
160               s_i_b(ji,layer) = zsh_i1(layer) / 
161     &         (rhog*deltaz_i_phy(layer))
162            END DO
163
164            DO layer = 1, nbot0  ! heat content
165               ztmelts    =   - tmut * REAL(zsi(layer)) + tpw 
166               zq         = rhog * ( cpg * ( ztmelts -REAL(zti(layer)) )
167     &                      + lfus*( 1.0 - (ztmelts-tpw) / 
168     &                        MIN( (REAL( zti(layer) ) -tpw),-zeps) ) 
169     &                      - cpw      * ( ztmelts-tpw  ) ) 
170               zqh_i0(layer) = zq * zthick0(layer)
171           END DO
172           CALL ice_phy_relay( nbot0 , nbot1 , ntop0 , ntop1 , 
173     &                       zthick0, deltaz_i_phy, zqh_i0 , zqh_i1 )
174
175           DO layer = 1, nlay_i
176              zq = zqh_i1(layer) / MAX( deltaz_i_phy(layer) , zeps )
177              ztmelts = -tmut*s_i_b(ji,layer) + tpw
178              aaa = cpg
179              bbb = (cpw-cpg)*(ztmelts-tpw) + zq / rhog - lfus
180              ccc = lfus * (ztmelts-tpw)
181              discrim = SQRT( bbb*bbb - 4.0*aaa*ccc )
182              t_i_b(ji,layer) = tpw + (- bbb - discrim) / ( 2.0*aaa )
183           END DO
184
185!
186!------------------------------------------------------------------------------|
187! x) Write in output file
188!------------------------------------------------------------------------------|
189
190            WRITE(numout,*) ' --- Initial values --- '
191            WRITE(numout,*) ' '
192            WRITE(numout,*) ' Surface temperature t_su : ', t_su_b(ji)
193            WRITE(numout,*) ' Basal   temperature t_bo : ', t_bo_b(ji)
194            WRITE(numout,*) ' Snow temperature    t_s  : ', t_s_b(ji,1)
195            WRITE(numout,*) ' Ice temperatures    t_i  : ', 
196     &                      ( t_i_b(ji,jk), jk = 1, nlay_i )
197            WRITE(numout,*) ' Ice salinities      s_i  : ', 
198     &                      ( s_i_b(ji,jk), jk = 1, nlay_i )
199            WRITE(numout,*) ' Ice thickness       ht_i_b : ', ht_i_b(ji)
200            WRITE(numout,*) ' Snow depth          ht_s_b : ', ht_s_b(ji)
201            WRITE(numout,*) ' '
202
203!------------------------------------------------------------------------------|
204!- end of ice_phy_ini
205!
206      RETURN
207      END
Note: See TracBrowser for help on using the repository browser.