GCC Code Coverage Report

Directory: ./
File: rad/suphy.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 9 9 100.0%
Branches: 2 4 50.0%
Line Branch Exec Source
1 1 SUBROUTINE SUPHY(KULOUT)
2
3 USE YOMCT0 , ONLY : NCONF
4 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
5
6 !**** *SUPHY* - Calls physic specific set-up routines
7
8 ! Purpose.
9 ! --------
10 ! Calls set-up routines specific to the different physics
11 ! packages that can be used in the IFS/ARPEGE model
12
13 !** Interface.
14 ! ----------
15 ! *CALL* *SUPHY(KULOUT)
16
17 ! Explicit arguments :
18 ! --------------------
19 ! KULOUT : Logical unit for the output
20
21 ! Implicit arguments :
22 ! --------------------
23 ! COMMON YOMPHY, YOEPHY
24
25 ! Method.
26 ! -------
27 ! See documentation
28
29 ! Externals.
30 ! ----------
31
32 ! SUPHEC
33 ! SUPHMF
34 ! SUPHYFL
35 ! SUHLPH
36 !
37 ! Reference.
38 ! ----------
39 ! ECMWF Research Department documentation of the IFS
40
41 ! or
42
43 ! Documentation ARPEGE (depending on which physics will be used)
44
45 ! Author.
46 ! -------
47 ! Mats Hamrud and Philippe Courtier *ECMWF*
48 ! J.-F. Geleyn for the ARPEGE rewriting.
49
50 ! Modifications.
51 ! --------------
52 ! Original : 87-10-15
53 ! ARPEGE extension 90-9-1
54 ! ARPEGE modification 90-11-24
55 ! Modified by M. Deque 91-02-28 (key for Ozone)
56 ! Modified by M. Deque 91-03-18 (key for Negative humidity)
57 ! Modified by M. Deque 91-04-01 (keys for cloudiness and wavedrag)
58 ! Modified by J.-F. Geleyn 91-06-15 (call to SUPHMF and SUPHEC)
59 ! Modified by J.-J. Morcrette 91-11-12
60 ! Modified by K. YESSAD (MAY 2000): remove call to EC physics setup
61 ! in a 2D model because some dimensionings are inconsistent and
62 ! generate aborts, and because 2D models are purely adiabatic ones.
63 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
64 ! B.Sass 01-June-2006 (call setup for HIRLAM physics)
65 ! ------------------------------------------------------------------
66
67 USE PARKIND1 ,ONLY : JPIM ,JPRB
68
69 IMPLICIT NONE
70
71 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
72 LOGICAL :: LLSHW, LLVEQ, LL2D
73 REAL(KIND=JPRB) :: ZHOOK_HANDLE
74
75 INTERFACE
76 SUBROUTINE SUPHEC(KULOUT)
77 USE PARKIND1 ,ONLY : JPIM ,JPRB
78 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
79 END SUBROUTINE SUPHEC
80 END INTERFACE
81 INTERFACE
82 SUBROUTINE SUPHMF(KULOUT)
83 USE PARKIND1 ,ONLY : JPIM ,JPRB
84 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
85 END SUBROUTINE SUPHMF
86 END INTERFACE
87 INTERFACE
88 subroutine suhlph(kulout)
89 use parkind1 ,only : jpim ,jprb
90 integer (kind=jpim),intent(in) :: kulout
91 end subroutine suhlph
92 END INTERFACE
93 INTERFACE
94 SUBROUTINE SUPHYFL
95 END SUBROUTINE SUPHYFL
96 END INTERFACE
97 INTERFACE
98 SUBROUTINE SUMTS
99 END SUBROUTINE SUMTS
100 END INTERFACE
101
102 ! ------------------------------------------------------------------
103
104 !* 0. Set-up LL2D (2D model switch).
105 ! ------------------------------
106
107
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('SUPHY',0,ZHOOK_HANDLE)
108 LLSHW=NCONF == 201.OR.NCONF == 421.OR.NCONF == 521
109 LLVEQ=NCONF == 202.OR.NCONF == 422.OR.NCONF == 522
110 LL2D=LLSHW.OR.LLVEQ
111
112 ! ------------------------------------------------------------------
113
114 !* 1. Call initialization of specific physics' commons.
115 ! -------------------------------------------------
116
117 !* 1.1 Meteo-France Physics
118 ! --------------------
119
120 1 print *,'---- SUPHY: avant SUPHMF'
121 1 CALL SUPHMF(KULOUT)
122 !
123 1 print *,'---- SUPHY: avant SUGFL'
124 !SUGFL: Set up unified_treatment grid-point fields
125 1 CALL SUGFL
126
127
128 !* 1.2 ECMWF Physics
129 ! -------------
130
131 ! IF Commente par MPL 20.11.08
132 !IF (.NOT.LL2D) THEN
133 1 CALL SUPHEC(KULOUT)
134 !ENDIF
135
136 ! 1.3 Initialize HIRLAM physics
137 ! -------------------------
138 ! Commente par MPL 20.11.08
139 !CALL SUHLPH(KULOUT)
140 !
141 ! ------------------------------------------------------------------
142
143 !* 2. Initialize physics' flags commons.
144 ! ----------------------------------
145
146 ! Commente par MPL 20.11.08
147 !CALL SUPHYFL
148
149 ! ------------------------------------------------------------------
150
151 !* 3. Initialize "model to satellite" RTTOV parameters.
152 ! ------------------------------------------------
153
154 ! Commente par MPL 20.11.08
155 !CALL SUMTS
156
157 ! ------------------------------------------------------------------
158
159
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('SUPHY',1,ZHOOK_HANDLE)
160 1 END SUBROUTINE SUPHY
161