Changeset 3526 for trunk/LMDZ.COMMON/libf/evolution/NS_fast_subs_univ.F90

Timestamp:

Nov 19, 2024, 5:54:18 PM (2 days ago)

Author:

jbclement

Message:

PEM:
Removing unused or redundant Norbert Schorghofer's subroutines (follow-up of r3493) + cleaning and some modifications of related subroutines.
JBC

File:

• trunk/LMDZ.COMMON/libf/evolution/NS_fast_subs_univ.F90 (modified) (7 diffs)

trunk/LMDZ.COMMON/libf/evolution/NS_fast_subs_univ.F90

@@ -55 +55 @@
 !***********************************************************************
   use allinterfaces, except_this_one => depths_avmeth
+  use math_mod, only: deriv2_simple, deriv1_onesided, deriv1, colint
   implicit none
   integer, intent(IN) :: nz, typeT
@@ -118 +119 @@
   call deriv1(z,nz,eta(:),1.d0,eta(nz-1),ap)
   if (typeP>0 .and. typeP<nz-2) then
-     ap_one=deriv1_onesided(typeP,z,nz,eta(:))
+     call deriv1_onesided(typeP,z,nz,eta(:),ap_one)
      ! print *,typeP,ap(typeP),ap_one
      ap(typeP)=ap_one
@@ -151 +152 @@
   endif
   if (typeG>0 .and. typeT<0) then
-     cumfillabove = colint(porefill(:)/eta(:),z,nz,typeG-1,nz) 
+     call colint(porefill(:)/eta(:),z,nz,typeG-1,nz,cumfillabove) 
      newtypeG = -9
      do i=typeG,nz
         if (minval(eta(i:nz))<=0.) cycle  ! eta=0 means completely full
-        cumfill=colint(porefill(:)/eta(:),z,nz,i,nz)
+        call colint(porefill(:)/eta(:),z,nz,i,nz,cumfill)
         if (cumfill<yp(i)*18./8314.*B) then  ! usually executes on i=typeG
            if (i>typeG) then
@@ -194 +195 @@
 
 
-pure subroutine icechanges_poreonly(nz,z,typeF,typeG,avdrhoP,ypp,B,porefill)
-  use allinterfaces, except_this_one => icechanges_poreonly
-  implicit none
-  integer, intent(IN) :: nz, typeF, typeG
-  real(8), intent(IN) :: z(nz), ypp(nz), avdrhoP, B
-  real(8), intent(INOUT) :: porefill(nz)
-  integer j, erase, newtypeP, ub
-  real(8) integ
-  
-  !----retreat
-  ! avdrhoP>0 is outward loss from zdepthP
-  ! avdrhoP<0 means gain at zdepthP or no ice anywhere
-  if (avdrhoP>0.) then
-     erase=0
-     do j=1,nz
-        if (typeF>0 .and. j>=typeF) exit ! don't retreat beyond typeF
-        integ = colint(porefill(1:nz)*z(1:nz),z(1:nz),nz,1,j)
-        erase = j
-        if (integ>B*avdrhoP*18./8314.) exit
-     end do
-     if (erase>0) porefill(1:erase)=0.
-  endif
-
-  ! new depth
-  newtypeP = -9 
-  do j=1,nz
-     if (porefill(j)>0.) then
-        newtypeP = j  ! first point with ice
-        exit
-     endif
-  enddo
-
-  !----diffusive filling
-  ub = typeF
-  if (newtypeP>0 .and. typeF>0 .and. newtypeP<ub) ub=newtypeP
-  if (ub>0) then  
-     do j=ub,nz
-        ! B=Diff/(porosity*icedensity)*86400*365.24*bigstep
-        porefill(j) = porefill(j) + B*ypp(j)
-        if (porefill(j)<0.) porefill(j)=0.
-        if (porefill(j)>1.) porefill(j)=1.
-     enddo
-  end if
-  
-  !----enact bottom boundary
-  if (typeG>0) porefill(typeG:nz)=0.
-  
-end subroutine icechanges_poreonly
-
-
-
 pure subroutine icechanges(nz,z,typeF,avdrho,avdrhoP,ypp, &
      & Diff,porosity,icefrac,bigstep,zdepthT,porefill,typeG)
@@ -254 +204 @@
   use miscparameters, only : icedensity
   use allinterfaces, except_this_one => icechanges
+  use math_mod, only: colint
   implicit none
   integer, intent(IN) :: nz, typeF, typeG
@@ -293 +244 @@
         if (typeF>0 .and. j>=typeF) exit ! don't retreat beyond typeF
         if (zdepthT>=0. .and. z(j)>zdepthT) exit 
-        integ = colint(porefill(1:nz)*z(1:nz),z(1:nz),nz,1,j)
+        call colint(porefill(1:nz)*z(1:nz),z(1:nz),nz,1,j,integ)
         erase = j
         if (integ>B*avdrhoP*18./8314.) exit
@@ -332 +283 @@
   end if
 end subroutine icechanges
-
-
-subroutine assignthermalproperties(nz,thIn,rhoc, &
-     &    ti,rhocv,typeT,icefrac,porosity,porefill)
-!*********************************************************
-! assign thermal properties of soil
-!*********************************************************
-  implicit none
-  integer, intent(IN) :: nz
-  integer, intent(IN), optional :: typeT
-  real(8), intent(IN), optional :: icefrac
-  real(8), intent(IN) :: thIn, rhoc
-  real(8), intent(IN), optional :: porosity, porefill(nz)
-  real(8), intent(OUT) :: ti(nz), rhocv(nz)
-  integer j
-  real(8) newrhoc, newti, fill
-  real(8), parameter :: NULL=0.
-
-  ti(1:nz) = thIn
-  rhocv(1:nz) = rhoc
-  if (typeT>0) then 
-     call soilthprop(porosity,NULL,rhoc,thIn,2,newrhoc,newti,icefrac)
-     rhocv(typeT:nz) = newrhoc
-     ti(typeT:nz) = newti
-  endif
-  do j=1,nz 
-     fill = porefill(j)   ! off by half point
-     if (fill>0. .and. (typeT<0 .or. (typeT>0 .and. j<typeT))) then
-        call soilthprop(porosity,fill,rhoc,thIn,1,rhocv(j),ti(j),NULL)
-     endif
-  enddo
-end subroutine assignthermalproperties
-
-
-
-subroutine compactoutput(unit,porefill,nz)
-  implicit none
-  integer, intent(IN) :: unit,nz
-  real(8), intent(IN) :: porefill(nz)
-  integer j
-  do j=1,nz
-     if (porefill(j)==0.) then
-        write(unit,'(1x,f2.0)',advance='no') porefill(j)
-     else
-        write(unit,'(1x,f7.5)',advance='no') porefill(j)
-     endif
-  enddo
-  write(unit,"('')")
-end subroutine compactoutput
-