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 | #include "dimphys.h" |
---|
29 | !#include "comsoil.h" |
---|
30 | !#include "tracer.h" |
---|
31 | !#include "surfdat.h" |
---|
32 | |
---|
33 | c Local variables |
---|
34 | c --------------- |
---|
35 | |
---|
36 | INTEGER :: ig ! Grid point (ngrid) |
---|
37 | INTEGER :: ik ! Grid point (nsoil) |
---|
38 | INTEGER :: iref ! Ice/Regolith boundary index |
---|
39 | INTEGER :: ngrid ! Number of horizontal grid points |
---|
40 | INTEGER :: nsoil ! Number of soil layers |
---|
41 | REAL :: icedepth ! Ice cover thickness (m) |
---|
42 | |
---|
43 | c Inputs |
---|
44 | c ------ |
---|
45 | |
---|
46 | REAL icecover(ngrid,nqmx) ! tracer on the surface (kg.m-2) |
---|
47 | ! (iq=igcm_h2o_ice) is surface |
---|
48 | ! water ice |
---|
49 | c Outputs |
---|
50 | c ------- |
---|
51 | |
---|
52 | REAL newtherm_i(ngrid,nsoil) ! New soil thermal inertia |
---|
53 | |
---|
54 | c Initialization |
---|
55 | c -------------- |
---|
56 | |
---|
57 | newtherm_i(1:ngrid,1:nsoil) = 0 |
---|
58 | |
---|
59 | c Creating the new soil thermal inertia table |
---|
60 | c ------------------------------------------- |
---|
61 | DO ig=1,ngrid |
---|
62 | c Calculating the ice cover thickness |
---|
63 | icedepth=icecover(ig,igcm_h2o_ice)/rho_ice |
---|
64 | c If the ice cover is too thick or watercaptag=true, |
---|
65 | c the entire column is changed : |
---|
66 | IF ((icedepth.ge.layer(nsoil)).or.(watercaptag(ig))) THEN |
---|
67 | DO ik=1,nsoil |
---|
68 | newtherm_i(ig,ik)=inert_h2o_ice |
---|
69 | ENDDO |
---|
70 | c We neglect the effect of a very thin ice cover : |
---|
71 | ELSE IF (icedepth.lt.layer(1)) THEN |
---|
72 | DO ik=1,nsoil |
---|
73 | newtherm_i(ig,ik)=inertiedat(ig,ik) |
---|
74 | ENDDO |
---|
75 | ELSE |
---|
76 | c Ice/regolith boundary index : |
---|
77 | iref=1 |
---|
78 | c Otherwise, we find the ice/regolith boundary: |
---|
79 | DO ik=1,nsoil-1 |
---|
80 | IF ((icedepth.ge.layer(ik)).and. |
---|
81 | & (icedepth.lt.layer(ik+1))) THEN |
---|
82 | iref=ik+1 |
---|
83 | EXIT |
---|
84 | ENDIF |
---|
85 | ENDDO |
---|
86 | c And we change the thermal inertia: |
---|
87 | DO ik=1,iref-1 |
---|
88 | newtherm_i(ig,ik)=inert_h2o_ice |
---|
89 | ENDDO |
---|
90 | c Transition (based on the equations of thermal conduction): |
---|
91 | newtherm_i(ig,iref)=sqrt( (layer(iref)-layer(iref-1)) / |
---|
92 | & ( ((icedepth-layer(iref-1))/inert_h2o_ice**2) + |
---|
93 | & ((layer(iref)-icedepth)/inertiedat(ig,ik)**2) ) ) |
---|
94 | c Underlying regolith: |
---|
95 | DO ik=iref+1,nsoil |
---|
96 | newtherm_i(ig,ik)=inertiedat(ig,ik) |
---|
97 | ENDDO |
---|
98 | ENDIF ! icedepth |
---|
99 | ENDDO ! ig |
---|
100 | |
---|
101 | c======================================================================= |
---|
102 | RETURN |
---|
103 | END |
---|