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