[834] | 1 | SUBROUTINE soil_tifeedback(ngrid,nsoil,icecover,newtherm_i) |
---|
| 2 | IMPLICIT NONE |
---|
| 3 | |
---|
| 4 | c======================================================================= |
---|
| 5 | c Description : |
---|
| 6 | c Surface water ice / Thermal inertia feedback. |
---|
| 7 | c |
---|
| 8 | c When surface water-ice is thick enough, this routine creates a new |
---|
| 9 | c soil thermal inertia with three different layers : |
---|
| 10 | c - One layer of surface water ice (the thickness is given |
---|
| 11 | c by the variable icecover (in kg of ice per m2) and the thermal |
---|
| 12 | c inertia is prescribed by inert_h2o_ice (see surfdat.h and inifis)); |
---|
| 13 | c - A transitional layer of mixed thermal inertia; |
---|
| 14 | c - A last layer of regolith below the ice cover whose thermal inertia |
---|
| 15 | c is equal to inertiedat. |
---|
| 16 | c |
---|
| 17 | c To use the model : |
---|
| 18 | c SET THE tifeedback LOGICAL TO ".true." in callphys.def. |
---|
| 19 | c |
---|
| 20 | c Author: J.-B. Madeleine Mars 2008 - Updated November 2012 |
---|
| 21 | c======================================================================= |
---|
| 22 | |
---|
| 23 | #include "dimensions.h" |
---|
| 24 | #include "dimphys.h" |
---|
| 25 | #include "comsoil.h" |
---|
| 26 | #include "tracer.h" |
---|
| 27 | #include "surfdat.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 | ! last one (iq=nqmx) 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 |
---|
[857] | 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 |
---|
[834] | 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 |
---|