Head

GCC Code Coverage Report

Directory:	./		Exec	Total	Coverage
File:	phylmd/plevel.F90	Lines:	26	27	96.3 %
Date:	2023-06-30 12:56:34	Branches:	33	44	75.0 %



! $Header$

! ================================================================
! ================================================================
SUBROUTINE plevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
  ! ================================================================
  ! ================================================================
  USE netcdf
  USE dimphy
#ifdef CPP_IOIPSL
  USE phys_state_var_mod, ONLY: missing_val_nf90
#endif
#ifdef CPP_XIOS
  USE wxios, ONLY: missing_val
#endif
  IMPLICIT NONE

  ! ================================================================

  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
  ! pression donnee (pres)

  ! INPUT:  ilon ----- nombre de points
  ! ilev ----- nombre de couches
  ! lnew ----- true si on doit reinitialiser les poids
  ! pgcm ----- pressions modeles
  ! pres ----- pression vers laquelle on interpolle
  ! Qgcm ----- champ GCM
  ! Qpres ---- champ interpolle au niveau pres

  ! ================================================================

  ! arguments :
  ! -----------

  INTEGER ilon, ilev
  LOGICAL lnew

  REAL pgcm(ilon, ilev)
  REAL qgcm(ilon, ilev)
  REAL pres
  REAL qpres(ilon)

  ! local :
  ! -------

  ! ym      INTEGER lt(klon), lb(klon)
  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)

  ! ym      save lt,lb,ptop,pbot,aist,aisb
  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb
  REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb
  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
  REAL, SAVE :: ptop, pbot
  !$OMP THREADPRIVATE(ptop, pbot)
  LOGICAL, SAVE :: first = .TRUE.
  !$OMP THREADPRIVATE(first)
  INTEGER i, k

! REAL missing_val
#ifndef CPP_XIOS
  REAL :: missing_val
#endif

! missing_val = nf90_fill_real

#ifndef CPP_XIOS
      missing_val=missing_val_nf90
#endif

  IF (first) THEN
    ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon))
    first = .FALSE.
  END IF

  ! =====================================================================
  IF (lnew) THEN
    ! on r�nitialise les r�ndicages et les poids
    ! =====================================================================


    ! Chercher les 2 couches les plus proches du niveau a obtenir

    ! Eventuellement, faire l'extrapolation a partir des deux couches
    ! les plus basses ou les deux couches les plus hautes:
    DO i = 1, klon
      IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN
        lt(i) = ilev ! 2
        lb(i) = ilev - 1 ! 1
      ELSE
        lt(i) = 2
        lb(i) = 1
      END IF
    END DO
    DO k = 1, ilev - 1
      DO i = 1, klon
        pbot = pgcm(i, k)
        ptop = pgcm(i, k+1)
        IF (ptop<=pres .AND. pbot>=pres) THEN
          lt(i) = k + 1
          lb(i) = k
        END IF
      END DO
    END DO

    ! Interpolation lineaire:

    DO i = 1, klon
      ! interpolation en logarithme de pression:

      ! ...   Modif . P. Le Van    ( 20/01/98) ....
      ! Modif Fr��ic Hourdin (3/01/02)

      aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
      aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
    END DO


  END IF ! lnew

  ! ======================================================================
  ! inteprollation
  ! ======================================================================

  DO i = 1, klon
    qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
  END DO

  ! Je mets les vents a zero quand je rencontre une montagne
  DO i = 1, klon
    IF (pgcm(i,1)<pres) THEN
      qpres(i) = missing_val
    END IF
  END DO


  RETURN
END SUBROUTINE plevel


Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1
2			! $Header$
3
4			! ================================================================
5			! ================================================================
6		2592	SUBROUTINE plevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
7			! ================================================================
8			! ================================================================
9			USE netcdf
10			USE dimphy
11			#ifdef CPP_IOIPSL
12			USE phys_state_var_mod, ONLY: missing_val_nf90
13			#endif
14			#ifdef CPP_XIOS
15			USE wxios, ONLY: missing_val
16			#endif
17			IMPLICIT NONE
18
19			! ================================================================
20
21			! Interpoler des champs 3-D u, v et g du modele a un niveau de
22			! pression donnee (pres)
23
24			! INPUT: ilon ----- nombre de points
25			! ilev ----- nombre de couches
26			! lnew ----- true si on doit reinitialiser les poids
27			! pgcm ----- pressions modeles
28			! pres ----- pression vers laquelle on interpolle
29			! Qgcm ----- champ GCM
30			! Qpres ---- champ interpolle au niveau pres
31
32			! ================================================================
33
34			! arguments :
35			! -----------
36
37			INTEGER ilon, ilev
38			LOGICAL lnew
39
40			REAL pgcm(ilon, ilev)
41			REAL qgcm(ilon, ilev)
42			REAL pres
43			REAL qpres(ilon)
44
45			! local :
46			! -------
47
48			! ym INTEGER lt(klon), lb(klon)
49			! ym REAL ptop, pbot, aist(klon), aisb(klon)
50
51			! ym save lt,lb,ptop,pbot,aist,aisb
52			INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb
53			REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb
54			!$OMP THREADPRIVATE(lt,lb,aist,aisb)
55			REAL, SAVE :: ptop, pbot
56			!$OMP THREADPRIVATE(ptop, pbot)
57			LOGICAL, SAVE :: first = .TRUE.
58			!$OMP THREADPRIVATE(first)
59			INTEGER i, k
60
61			! REAL missing_val
62			#ifndef CPP_XIOS
63			REAL :: missing_val
64			#endif
65
66			! missing_val = nf90_fill_real
67
68			#ifndef CPP_XIOS
69			missing_val=missing_val_nf90
70			#endif
71
72	✓✓	2592	IF (first) THEN
73	✓✗✗✓ ✗✓✗✓ ✗✓✓✗ ✗✓✗✓ ✗✓✗✓	1	ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon))
74		1	first = .FALSE.
75			END IF
76
77			! =====================================================================
78	✓✓	2592	IF (lnew) THEN
79			! on r�nitialise les r�ndicages et les poids
80			! =====================================================================
81
82
83			! Chercher les 2 couches les plus proches du niveau a obtenir
84
85			! Eventuellement, faire l'extrapolation a partir des deux couches
86			! les plus basses ou les deux couches les plus hautes:
87	✓✓	573120	DO i = 1, klon
88	✓✓	573120	IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN
89		425559	lt(i) = ilev ! 2
90		425559	lb(i) = ilev - 1 ! 1
91			ELSE
92		146985	lt(i) = 2
93		146985	lb(i) = 1
94			END IF
95			END DO
96	✓✓	22752	DO k = 1, ilev - 1
97	✓✓	22065696	DO i = 1, klon
98		22042944	pbot = pgcm(i, k)
99		22042944	ptop = pgcm(i, k+1)
100	✓✓✓✓	22065120	IF (ptop<=pres .AND. pbot>=pres) THEN
101		572544	lt(i) = k + 1
102		572544	lb(i) = k
103			END IF
104			END DO
105			END DO
106
107			! Interpolation lineaire:
108
109	✓✓	573120	DO i = 1, klon
110			! interpolation en logarithme de pression:
111
112			! ... Modif . P. Le Van ( 20/01/98) ....
113			! Modif Fr��ic Hourdin (3/01/02)
114
115		572544	aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
116		573120	aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
117			END DO
118
119
120			END IF ! lnew
121
122			! ======================================================================
123			! inteprollation
124			! ======================================================================
125
126	✓✓	2579040	DO i = 1, klon
127		2579040	qpres(i) = qgcm(i, lb(i))aisb(i) + qgcm(i, lt(i))aist(i)
128			END DO
129
130			! Je mets les vents a zero quand je rencontre une montagne
131	✓✓	2579040	DO i = 1, klon
132	✗✓	2579040	IF (pgcm(i,1)<pres) THEN
133			qpres(i) = missing_val
134			END IF
135			END DO
136
137
138		2592	RETURN
139			END SUBROUTINE plevel