1 | SUBROUTINE soil_tifeedback(ngrid,nsoil,icecover,newtherm_i) |
---|
2 | |
---|
3 | use tracer_mod, only: nqmx, igcm_h2o_ice, rho_ice |
---|
4 | use comsoil_h, only: layer, inertiedat |
---|
5 | use surfdat_h, only: watercaptag, inert_h2o_ice |
---|
6 | IMPLICIT NONE |
---|
7 | |
---|
8 | c======================================================================= |
---|
9 | c Description : |
---|
10 | c Surface water ice / Thermal inertia feedback. |
---|
11 | c |
---|
12 | c When surface water-ice is thick enough, this routine creates a new |
---|
13 | c soil thermal inertia with three different layers : |
---|
14 | c - One layer of surface water ice (the thickness is given |
---|
15 | c by the variable icecover (in kg of ice per m2) and the thermal |
---|
16 | c inertia is prescribed by inert_h2o_ice (see surfdat_h)); |
---|
17 | c - A transitional layer of mixed thermal inertia; |
---|
18 | c - A last layer of regolith below the ice cover whose thermal inertia |
---|
19 | c is equal to inertiedat. |
---|
20 | c |
---|
21 | c To use the model : |
---|
22 | c SET THE tifeedback LOGICAL TO ".true." in callphys.def. |
---|
23 | c |
---|
24 | c Author: J.-B. Madeleine Mars 2008 - Updated November 2012 |
---|
25 | c======================================================================= |
---|
26 | |
---|
27 | #include "dimensions.h" |
---|
28 | |
---|
29 | c Local variables |
---|
30 | c --------------- |
---|
31 | |
---|
32 | INTEGER :: ig ! Grid point (ngrid) |
---|
33 | INTEGER :: ik ! Grid point (nsoil) |
---|
34 | INTEGER :: iref ! Ice/Regolith boundary index |
---|
35 | INTEGER :: ngrid ! Number of horizontal grid points |
---|
36 | INTEGER :: nsoil ! Number of soil layers |
---|
37 | REAL :: icedepth ! Ice cover thickness (m) |
---|
38 | |
---|
39 | c Inputs |
---|
40 | c ------ |
---|
41 | |
---|
42 | REAL icecover(ngrid,nqmx) ! tracer on the surface (kg.m-2) |
---|
43 | ! (iq=igcm_h2o_ice) is surface |
---|
44 | ! water ice |
---|
45 | c Outputs |
---|
46 | c ------- |
---|
47 | |
---|
48 | REAL newtherm_i(ngrid,nsoil) ! New soil thermal inertia |
---|
49 | |
---|
50 | c Initialization |
---|
51 | c -------------- |
---|
52 | |
---|
53 | newtherm_i(1:ngrid,1:nsoil) = 0 |
---|
54 | |
---|
55 | c Creating the new soil thermal inertia table |
---|
56 | c ------------------------------------------- |
---|
57 | DO ig=1,ngrid |
---|
58 | c Calculating the ice cover thickness |
---|
59 | icedepth=icecover(ig,igcm_h2o_ice)/rho_ice |
---|
60 | c If the ice cover is too thick or watercaptag=true, |
---|
61 | c the entire column is changed : |
---|
62 | IF ((icedepth.ge.layer(nsoil)).or.(watercaptag(ig))) THEN |
---|
63 | DO ik=1,nsoil |
---|
64 | newtherm_i(ig,ik)=inert_h2o_ice |
---|
65 | ENDDO |
---|
66 | c We neglect the effect of a very thin ice cover : |
---|
67 | ELSE IF (icedepth.lt.layer(1)) THEN |
---|
68 | DO ik=1,nsoil |
---|
69 | newtherm_i(ig,ik)=inertiedat(ig,ik) |
---|
70 | ENDDO |
---|
71 | ELSE |
---|
72 | c Ice/regolith boundary index : |
---|
73 | iref=1 |
---|
74 | c Otherwise, we find the ice/regolith boundary: |
---|
75 | DO ik=1,nsoil-1 |
---|
76 | IF ((icedepth.ge.layer(ik)).and. |
---|
77 | & (icedepth.lt.layer(ik+1))) THEN |
---|
78 | iref=ik+1 |
---|
79 | EXIT |
---|
80 | ENDIF |
---|
81 | ENDDO |
---|
82 | c And we change the thermal inertia: |
---|
83 | DO ik=1,iref-1 |
---|
84 | newtherm_i(ig,ik)=inert_h2o_ice |
---|
85 | ENDDO |
---|
86 | c Transition (based on the equations of thermal conduction): |
---|
87 | newtherm_i(ig,iref)=sqrt( (layer(iref)-layer(iref-1)) / |
---|
88 | & ( ((icedepth-layer(iref-1))/inert_h2o_ice**2) + |
---|
89 | & ((layer(iref)-icedepth)/inertiedat(ig,ik)**2) ) ) |
---|
90 | c Underlying regolith: |
---|
91 | DO ik=iref+1,nsoil |
---|
92 | newtherm_i(ig,ik)=inertiedat(ig,ik) |
---|
93 | ENDDO |
---|
94 | ENDIF ! icedepth |
---|
95 | ENDDO ! ig |
---|
96 | |
---|
97 | c======================================================================= |
---|
98 | RETURN |
---|
99 | END |
---|