vertical_grid_nat.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE vertical_grid_nat(PDG1,PT1,PDG2,PT2)
!##########################################
!
USE modd_surf_par,   ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
!
REAL, DIMENSION(:,:), INTENT(IN)  :: pdg1  ! input vertical grid
REAL, DIMENSION(:,:), INTENT(IN)  :: pt1  ! input temperatures
REAL, DIMENSION(:,:), INTENT(IN)  :: pdg2  ! output vertical grid
REAL, DIMENSION(:,:), INTENT(OUT) :: pt2  ! output temperatures
!
!* 0.2 Declaration of local variables
!
REAL,    DIMENSION(SIZE(PDG1,1),SIZE(PDG1,2)) :: zdzg1
REAL,    DIMENSION(SIZE(PDG2,1),SIZE(PDG2,2)) :: zsum
!
REAL,    DIMENSION(SIZE(PDG1,1),SIZE(PDG1,2),SIZE(PDG2,2)) :: zwght
REAL,    DIMENSION(SIZE(PDG1,1),SIZE(PDG1,2)) :: zsum_wght
!
REAL :: zwork
!
INTEGER :: ini, inl1, inl2
INTEGER :: jl1, jl2, ji ! loop counter
!
REAL(KIND=JPRB) :: zhook_handle
!-----------------------------------------------------------------------------
IF (lhook) CALL dr_hook('VERTICAL_GRID_NAT',0,zhook_handle)
!
ini =SIZE(pt1,1)
inl1=SIZE(pt1,2)
inl2=SIZE(pt2,2)
!
pt2(:,:)   = 0.0
zsum(:,:)   = 0.0
zsum_wght(:,:)   = 0.0
zwght(:,:,:) = 0.0
!
zdzg1(:,1)=pdg1(:,1)
DO jl1=2,inl1
   zdzg1(:,jl1)=pdg1(:,jl1)-pdg1(:,jl1-1)
END DO
!
DO jl2=1,inl2
   DO jl1=1,inl1
      DO ji=1,ini
!
         IF(pt1(ji,jl1)/=xundef)THEN
!
           zwght(ji,jl1,jl2)=min(zdzg1(ji,jl1),max(0.0,pdg2(ji,jl2)-pdg1(ji,jl1)+zdzg1(ji,jl1)))
           zwght(ji,jl1,jl2)=max(0.0,zwght(ji,jl1,jl2)-zsum_wght(ji,jl1))
!
           pt2(ji,jl2)=pt2(ji,jl2)+zwght(ji,jl1,jl2)*pt1(ji,jl1)
           zsum(ji,jl2)=zsum(ji,jl2)+zwght(ji,jl1,jl2)
!
           zsum_wght(ji,jl1)=zsum_wght(ji,jl1)+zwght(ji,jl1,jl2)
!
         ENDIF
!
      END DO
   END DO
END DO
!
WHERE(zsum(:,:)>0.0)
      pt2(:,:)=pt2(:,:)/zsum(:,:)
ELSEWHERE
      pt2(:,:)=xundef
ENDWHERE
!
!SIMPLE EXTRAPOLATION
!
DO jl2=2,inl2
   DO ji=1,ini
      IF(pt2(ji,1)/=xundef.AND.pt2(ji,jl2)==xundef)THEN
         pt2(ji,jl2)=pt2(ji,jl2-1)
      ENDIF
   END DO
END DO
!
IF (lhook) CALL dr_hook('VERTICAL_GRID_NAT',1,zhook_handle)
!-----------------------------------------------------------------------------
END SUBROUTINE vertical_grid_nat