subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil) use comsoil_h implicit none !====================================================================== ! Author: Ehouarn Millour (07/2006) ! ! Purpose: Read and/or initialise soil depths and properties ! ! This subroutine reads from a NetCDF file (opened by the caller) ! of "startfi.nc" format. ! The various actions and variable read/initialized are: ! 1. Check out the number of soil layers (in datafile); if it isn't equal ! to nsoil, then some interpolation will be required ! Also check if data in file "startfi.nc" is in older format (ie: ! thermal inertia was depth-independent; and there was no "depth" ! coordinate. ! Read/build layer (and midlayer) depths ! 2. Read volumetric specific heat (or initialise it to default value) ! 3. Read Thermal inertia ! 4. Read soil temperatures ! 5. Interpolate thermal inertia and temperature on the new grid, if ! necessary !====================================================================== #include "dimensions.h" #include "dimphys.h" #include "netcdf.inc" !====================================================================== ! arguments ! --------- ! inputs: integer nid ! Input Netcdf file ID integer ngrid ! # of horizontal grid points integer nsoil ! # of soil layers integer sta ! # at which reading starts real tsurf(ngrid) ! surface temperature ! output: real tsoil(ngrid,nsoilmx) ! soil temperature !====================================================================== ! local variables: integer ierr ! status (returned by NetCDF functions) integer nvarid ! ID of NetCDF variable integer dimid ! ID of NetCDF dimension integer dimlen ! length along the "depth" dimension integer ndims ! # of dimensions of read data integer ig,iloop ! loop counters logical :: olddepthdef=.false. ! flag logical :: interpol=.false. ! flag: true if interpolation will be requiered ! to store "old" values real,dimension(:),allocatable :: surfinertia !surface thermal inertia real,dimension(:),allocatable :: oldmlayer real,dimension(:,:),allocatable :: oldinertiedat real,dimension(:,:),allocatable :: oldtsoil ! for interpolation real,dimension(:),allocatable :: oldgrid real,dimension(:),allocatable :: oldval real,dimension(:),allocatable :: newval real alpha,lay1 ! coefficients for building layers real xmin,xmax ! to display min and max of a field real,parameter :: default_volcapa=1.e6 integer, dimension(2) :: sta2d integer, dimension(2) :: siz2d !====================================================================== !! this is defined in comsoil_h IF (.not.ALLOCATED(layer)) . ALLOCATE(layer(nsoilmx)) IF (.not.ALLOCATED(mlayer)) . ALLOCATE(mlayer(0:nsoilmx-1)) IF (.not.ALLOCATED(inertiedat)) . ALLOCATE(inertiedat(ngrid,nsoilmx)) !! this is defined in dimphys.h sta = cursor ! 1. Depth coordinate ! ------------------- ! 1.1 Start by reading how many layers of soil there are ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid) if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem reading ' call abort endif ierr=NF_INQ_DIMLEN(nid,dimid,dimlen) if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem getting ', & 'length' call abort endif if (dimlen.ne.nsoil) then write(*,*)'soil_settings: Interpolation of soil temperature ', & 'and thermal inertia will be required!' ! if dimlen doesn't match nsoil, then interpolation of ! soil temperatures and thermal inertia will be requiered interpol=.true. endif sta2d = (/sta,1/) siz2d = (/ngrid,dimlen/) ! 1.2 Find out the # of dimensions was defined as using ! (in ye old days, thermal inertia was only given at the "surface") ! Look for thermal inertia data ierr=NF_INQ_VARID(nid, "inertiedat", nvarid) if (ierr.NE.NF_NOERR) then write(*,*)'soil_settings: Field not found!' call abort endif ! Read the # of dimensions was defined as using ierr=NF_INQ_VARNDIMS(nid,nvarid,ndims) ! if (ndims.eq.1) then we have the "old 2D-surface" format ! 1.3 Read depths values or set olddepthdef flag and values if (ndims.eq.1) then ! we know that there is none write(*,*)'soil_settings: no field expected' write(*,*)'building one mimicking old definitions' olddepthdef=.true. interpol=.true. ! allocate oldmlayer if (.not.allocated(oldmlayer)) then allocate(oldmlayer(dimlen),stat=ierr) if (ierr.ne.0) then write(*,*) 'soil_settings: failed allocation of oldmlayer!' stop endif endif do iloop=1,dimlen oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.) enddo else ! Look for depth ierr=NF_INQ_VARID(nid,"soildepth",nvarid) if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Field not found!' call abort endif ! read coordinate if (interpol) then !put values in oldmlayer if (.not.allocated(oldmlayer)) then allocate(oldmlayer(dimlen),stat=ierr) endif #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldmlayer) #else ierr = NF_GET_VAR_REAL(nid,nvarid,oldmlayer) #endif if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif else ! put values in mlayer #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer) #else ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer) #endif if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif endif !of if (interpol) endif !of if (ndims.eq.1) ! 1.4 Build mlayer(), if necessary if (interpol) then ! default mlayer distribution, following a power law: ! mlayer(k)=lay1*alpha**(k-1/2) lay1=2.e-4 !mars case (nsoilmx=18) ! lay1=3.e-2 !earth case (nsoilmx=13) alpha=2 do iloop=0,nsoil-1 mlayer(iloop)=lay1*(alpha**(iloop-0.5)) enddo endif ! 1.5 Build layer(); following the same law as mlayer() ! Assuming layer distribution follows mid-layer law: ! layer(k)=lay1*alpha**(k-1) lay1=sqrt(mlayer(0)*mlayer(1)) alpha=mlayer(1)/mlayer(0) do iloop=1,nsoil layer(iloop)=lay1*(alpha**(iloop-1)) enddo ! 2. Volumetric heat capacity (note: it is declared in comsoil.h) ! --------------------------- ! "volcapa" is (so far) 0D and written in "controle" table of startfi file ! volcapa is read or set when "controle" is read (see tabfi.F) ! Just in case, we check here that it is not zero. If it is, we ! set it to "default_volcapa" if (volcapa.le.0.0) then write(*,*)'soil_settings: Warning, volcapa = ',volcapa write(*,*)' That doesn t seem right' write(*,*)' Initializing Volumetric heat capacity to ', & default_volcapa volcapa=default_volcapa endif ! Look for it ! ierr=NF_INQ_VARID(nid,"volcapa",nvarid) ! if (ierr.NE.NF_NOERR) then ! write(*,*)'soil_settings: Field not found!' ! write(*,*)'Initializing Volumetric heat capacity to ', ! & default_volcapa ! volcapa=default_volcapa ! else !#ifdef NC_DOUBLE ! ierr = NF_GET_VAR_DOUBLE(nid,nvarid,volcapa) !#else ! ierr = NF_GET_VAR_REAL(nid,nvarid,volcapa) !#endif ! if (ierr.ne.NF_NOERR) then ! write(*,*)'soil_settings: Problem while reading ' ! call abort ! endif ! endif ! 3. Thermal inertia (note: it is declared in comsoil.h) ! ------------------ ! 3.1 Look (again) for thermal inertia data (to reset nvarid) ierr=NF_INQ_VARID(nid, "inertiedat", nvarid) if (ierr.NE.NF_NOERR) then write(*,*)'soil_settings: Field not found!' call abort endif ! 3.2 Knowing the # of dimensions was defined as using, ! read/build thermal inertia if (ndims.eq.1) then ! "old 2D-surface" format write(*,*)'soil_settings: Thermal inertia is only given as surfac &e data!' ! Read Surface thermal inertia allocate(surfinertia(ngrid)) #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid, sta, ngrid, surfinertia) #else ierr = NF_GET_VARA_REAL(nid, nvarid, sta, ngrid, surfinertia) #endif if (ierr.NE.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif write(*,*)' => Building soil thermal inertia (using reference sur &face thermal inertia)' do iloop=1,nsoil inertiedat(:,iloop)=surfinertia(:) enddo deallocate(surfinertia) else ! "3D surface+depth" format if (interpol) then ! put values in oldinertiedat if (.not.allocated(oldinertiedat)) then allocate(oldinertiedat(ngrid,dimlen),stat=ierr) if (ierr.ne.0) then write(*,*) 'soil_settings: failed allocation of ', & 'oldinertiedat!' stop endif endif #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,oldinertiedat) #else ierr = NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,oldinertiedat) #endif if (ierr.NE.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif else ! put values in therm_i #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,inertiedat) #else ierr = NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,inertiedat) #endif if (ierr.NE.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif endif ! of if (interpol) endif ! of if (ndims.eq.1) ! 4. Read soil temperatures ! ------------------------- ierr=NF_INQ_VARID(nid,"tsoil",nvarid) if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Field not found!' write(*,*)' => Building from surface values ' do iloop=1,nsoil tsoil(:,iloop)=tsurf(:) enddo else ! found if (interpol) then ! put values in oldtsoil if (.not.allocated(oldtsoil)) then allocate(oldtsoil(ngrid,dimlen),stat=ierr) if (ierr.ne.0) then write(*,*) 'soil_settings: failed allocation of ', & 'oldtsoil!' stop endif endif #ifdef NC_DOUBLE ierr=NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,oldtsoil) #else ierr=NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,oldtsoil) #endif if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif else ! put values in tsoil #ifdef NC_DOUBLE ierr=NF_GET_VARA_DOUBLE(nid,nvarid,sta2d,siz2d,tsoil) #else ierr=NF_GET_VARA_REAL(nid,nvarid,sta2d,siz2d,tsoil) #endif if (ierr.ne.NF_NOERR) then write(*,*)'soil_settings: Problem while reading ' call abort endif endif ! of if (interpol) endif ! 5. If necessary, interpolate soil temperatures and thermal inertias ! ------------------------------------------------------------------- if (olddepthdef) then ! tsoil needs to be interpolated, but not therm_i allocate(oldgrid(dimlen+1)) allocate(oldval(dimlen+1)) allocate(newval(nsoil)) do ig=1,ngrid ! copy values oldval(1)=tsurf(ig) oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen) ! build vertical coordinate oldgrid(1)=0. ! ground oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)* & (inertiedat(ig,1)/volcapa) ! interpolate call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil) ! copy result in tsoil tsoil(ig,:)=newval(:) enddo ! cleanup deallocate(oldgrid) deallocate(oldval) deallocate(newval) interpol=.false. ! no need for interpolation any more endif !of if (olddepthdef) if (interpol) then write(*,*)'soil_settings: Vertical interpolation along new grid' ! interpolate soil temperatures and thermal inertias if (.not.allocated(oldgrid)) then allocate(oldgrid(dimlen+1)) allocate(oldval(dimlen+1)) allocate(newval(nsoil)) endif ! thermal inertia do ig=1,ngrid ! copy data oldval(1:dimlen)=oldinertiedat(ig,dimlen) ! interpolate call interp_line(oldmlayer,oldval,dimlen,mlayer,newval,nsoil) !copy result in inertiedat inertiedat(ig,:)=newval(:) enddo ! soil temperature ! vertical coordinate oldgrid(1)=0.0 oldgrid(2:dimlen+1)=oldmlayer(1:dimlen) do ig=1,ngrid ! data oldval(1)=tsurf(ig) oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen) ! interpolate call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil) ! copy result in inertiedat tsoil(ig,:)=newval(:) enddo !cleanup deallocate(oldgrid) deallocate(oldval) deallocate(newval) deallocate(oldinertiedat) deallocate(oldtsoil) endif ! of if (interpol) ! 6. Report min and max values of soil temperatures and thermal inertias ! ---------------------------------------------------------------------- write(*,*) write(*,*)'Soil volumetric heat capacity:',volcapa xmin = MINVAL(inertiedat) xmax = MAXVAL(inertiedat) write(*,*)'Soil thermal inertia :',xmin,xmax xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINVAL(tsoil) xmax = MAXVAL(tsoil) write(*,*)'Soil temperature :',xmin,xmax end