GCC Code Coverage Report

Directory: ./
File: phys/plevel_new.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 29 29 100.0%
Branches: 40 54 74.1%
Line Branch Exec Source
1
2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17
3 ! 15:41:51 fairhead Exp $
4
5 ! ================================================================
6 ! ================================================================
7 8160 SUBROUTINE plevel_new(ilon, ilev, klevstd, lnew, pgcm, pres, qgcm, qpres)
8 ! ================================================================
9 ! ================================================================
10 USE netcdf
11 USE dimphy
12 USE phys_state_var_mod, ONLY: missing_val_nf90
13
14 IMPLICIT NONE
15
16 ! ================================================================
17
18 ! Interpoler des champs 3-D u, v et g du modele a un niveau de
19 ! pression donnee (pres)
20
21 ! INPUT: ilon ----- nombre de points
22 ! ilev ----- nombre de couches
23 ! lnew ----- true si on doit reinitialiser les poids
24 ! pgcm ----- pressions modeles
25 ! pres ----- pression vers laquelle on interpolle
26 ! Qgcm ----- champ GCM
27 ! Qpres ---- champ interpolle au niveau pres
28
29 ! ================================================================
30
31 ! arguments :
32 ! -----------
33
34 INTEGER ilon, ilev, klevstd
35 LOGICAL lnew
36
37 REAL pgcm(ilon, ilev)
38 REAL qgcm(ilon, ilev)
39 REAL pres(klevstd)
40 REAL qpres(ilon, klevstd)
41
42 ! local :
43 ! -------
44
45 ! ym INTEGER lt(klon), lb(klon)
46 ! ym REAL ptop, pbot, aist(klon), aisb(klon)
47
48 ! ym save lt,lb,ptop,pbot,aist,aisb
49 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:, :) :: lt, lb
50 REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: aist, aisb
51 !$OMP THREADPRIVATE(lt,lb,aist,aisb)
52 REAL, SAVE :: ptop, pbot
53 !$OMP THREADPRIVATE(ptop, pbot)
54 LOGICAL, SAVE :: first = .TRUE.
55 INTEGER :: nlev
56 !$OMP THREADPRIVATE(first)
57 INTEGER i, k
58
59 ! REAL missing_val
60 REAL :: missing_val
61
62 ! missing_val = nf90_fill_real
63
64 missing_val=missing_val_nf90
65
66
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 8159 times.
 8160 IF (first) THEN
67
5/10
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
 1 ALLOCATE (lt(klon,klevstd), lb(klon,klevstd))
68
9/18
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 13 taken 1 times.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 16 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
 3 ALLOCATE (aist(klon,klevstd), aisb(klon,klevstd))
69 1 first = .FALSE.
70 END IF
71
72 ! =====================================================================
73
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 7200 times.
 8160 IF (lnew) THEN
74 ! on reinitialise les reindicages et les poids
75 ! =====================================================================
76
77
78 ! Chercher les 2 couches les plus proches du niveau a obtenir
79
80 ! Eventuellement, faire l'extrapolation a partir des deux couches
81 ! les plus basses ou les deux couches les plus hautes:
82
83
84
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 16320 times.
 17280 DO nlev = 1, klevstd
85
2/2
✓ Branch 0 taken 16222080 times.
✓ Branch 1 taken 16320 times.
 16238400 DO i = 1, klon
86
2/2
✓ Branch 0 taken 10928938 times.
✓ Branch 1 taken 5293142 times.
 16238400 IF (abs(pres(nlev)-pgcm(i,ilev))<abs(pres(nlev)-pgcm(i,1))) THEN
87 10928938 lt(i, nlev) = ilev ! 2
88 10928938 lb(i, nlev) = ilev - 1 ! 1
89 ELSE
90 5293142 lt(i, nlev) = 2
91 5293142 lb(i, nlev) = 1
92 END IF
93 END DO
94
2/2
✓ Branch 0 taken 620160 times.
✓ Branch 1 taken 16320 times.
 636480 DO k = 1, ilev - 1
95
2/2
✓ Branch 0 taken 616439040 times.
✓ Branch 1 taken 620160 times.
 617075520 DO i = 1, klon
96 616439040 pbot = pgcm(i, k)
97 616439040 ptop = pgcm(i, k+1)
98
4/4
✓ Branch 0 taken 369245604 times.
✓ Branch 1 taken 247193436 times.
✓ Branch 2 taken 15508671 times.
✓ Branch 3 taken 353736933 times.
 617059200 IF (ptop<=pres(nlev) .AND. pbot>=pres(nlev)) THEN
99 15508671 lt(i, nlev) = k + 1
100 15508671 lb(i, nlev) = k
101 END IF
102 END DO
103 END DO
104
105 ! Interpolation lineaire:
106
2/2
✓ Branch 0 taken 16222080 times.
✓ Branch 1 taken 16320 times.
 16239360 DO i = 1, klon
107 ! interpolation en logarithme de pression:
108
109 ! ... Modif . P. Le Van ( 20/01/98) ....
110 ! Modif Frederic Hourdin (3/01/02)
111
112 aist(i, nlev) = log(pgcm(i,lb(i,nlev))/pres(nlev))/log(pgcm(i,lb(i, &
113 16222080 nlev))/pgcm(i,lt(i,nlev)))
114 aisb(i, nlev) = log(pres(nlev)/pgcm(i,lt(i,nlev)))/log(pgcm(i,lb(i, &
115 16238400 nlev))/pgcm(i,lt(i,nlev)))
116 END DO
117 END DO
118
119 END IF ! lnew
120
121 ! ======================================================================
122 ! inteprollation
123 ! ET je mets les vents a zero quand je rencontre une montagne
124 ! ======================================================================
125
126
2/2
✓ Branch 0 taken 138720 times.
✓ Branch 1 taken 8160 times.
 146880 DO nlev = 1, klevstd
127
2/2
✓ Branch 0 taken 137887680 times.
✓ Branch 1 taken 138720 times.
 138034560 DO i = 1, klon
128
2/2
✓ Branch 0 taken 6264339 times.
✓ Branch 1 taken 131623341 times.
 138026400 IF (pgcm(i,1)<pres(nlev)) THEN
129 6264339 qpres(i, nlev) = missing_val
130 ELSE
131 qpres(i, nlev) = qgcm(i, lb(i,nlev))*aisb(i, nlev) + &
132 131623341 qgcm(i, lt(i,nlev))*aist(i, nlev)
133 END IF
134 END DO
135 END DO
136
137
138 8160 RETURN
139 END SUBROUTINE plevel_new
140