source: trunk/LMDZ.MARS/libf/phymars/soil_tifeedback.F @ 3026

Last change on this file since 3026 was 1268, checked in by aslmd, 11 years ago

LMDZ.MARS. related to r1266. forgot to remove a few now-obsolete dimensions.h includes in Mars physics.

  • Property svn:executable set to *
File size: 3.5 KB
Line 
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
8c=======================================================================
9c   Description :
10c       Surface water ice / Thermal inertia feedback.
11c
12c   When surface water-ice is thick enough, this routine creates a new
13c   soil thermal inertia with three different layers :
14c   - One layer of surface water ice (the thickness is given
15c     by the variable icecover (in kg of ice per m2) and the thermal
16c     inertia is prescribed by inert_h2o_ice (see surfdat_h));
17c   - A transitional layer of mixed thermal inertia;
18c   - A last layer of regolith below the ice cover whose thermal inertia
19c     is equal to inertiedat.
20c
21c   To use the model :
22c       SET THE tifeedback LOGICAL TO ".true." in callphys.def.
23c
24c   Author: J.-B. Madeleine Mars 2008 - Updated November 2012
25c=======================================================================
26
27c Local variables
28c ---------------
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
37c Inputs
38c ------
39
40      REAL icecover(ngrid,nqmx)         ! tracer on the surface (kg.m-2)
41                                        ! (iq=igcm_h2o_ice) is surface
42                                        ! water ice
43c Outputs
44c -------
45
46      REAL newtherm_i(ngrid,nsoil)    ! New soil thermal inertia
47
48c Initialization
49c --------------
50
51      newtherm_i(1:ngrid,1:nsoil) = 0
52
53c Creating the new soil thermal inertia table
54c -------------------------------------------
55      DO ig=1,ngrid
56c       Calculating the ice cover thickness
57        icedepth=icecover(ig,igcm_h2o_ice)/rho_ice
58c       If the ice cover is too thick or watercaptag=true,
59c         the entire column is changed :
60        IF ((icedepth.ge.layer(nsoil)).or.(watercaptag(ig))) THEN
61          DO ik=1,nsoil
62               newtherm_i(ig,ik)=inert_h2o_ice
63          ENDDO
64c       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
70c         Ice/regolith boundary index :
71          iref=1
72c         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
80c         And we change the thermal inertia:
81          DO ik=1,iref-1
82            newtherm_i(ig,ik)=inert_h2o_ice
83          ENDDO
84c         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) ) )
88c         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
95c=======================================================================
96      RETURN
97      END
Note: See TracBrowser for help on using the repository browser.