GCC Code Coverage Report


Directory: ./
File: dyn_phys/inigeomphy_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 95 111 85.6%
Branches: 91 140 65.0%

Line Branch Exec Source
1 !
2 ! $Id: $
3 !
4 MODULE inigeomphy_mod
5
6 CONTAINS
7
8 4 SUBROUTINE inigeomphy(iim,jjm,nlayer, &
9 nbp, communicator, &
10 1 rlatu,rlatv,rlonu,rlonv,aire,cu,cv)
11 USE mod_grid_phy_lmdz, ONLY: klon_glo, & ! number of atmospheric columns (on full grid)
12 regular_lonlat, & ! regular longitude-latitude grid type
13 nbp_lon, nbp_lat, nbp_lev
14 USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
15 klon_omp_begin, & ! start index of local omp subgrid
16 klon_omp_end, & ! end index of local omp subgrid
17 klon_mpi_begin ! start indes of columns (on local mpi grid)
18 USE geometry_mod, ONLY : init_geometry
19 USE physics_distribution_mod, ONLY : init_physics_distribution
20 USE regular_lonlat_mod, ONLY : init_regular_lonlat, &
21 east, west, north, south, &
22 north_east, north_west, &
23 south_west, south_east
24 USE mod_interface_dyn_phys, ONLY : init_interface_dyn_phys
25 USE nrtype, ONLY: pi
26 USE comvert_mod, ONLY: preff, ap, bp, aps, bps, presnivs, &
27 scaleheight, pseudoalt
28 USE vertical_layers_mod, ONLY: init_vertical_layers
29 IMPLICIT NONE
30
31 ! =======================================================================
32 ! Initialisation of the physical constants and some positional and
33 ! geometrical arrays for the physics
34 ! =======================================================================
35
36 include "iniprint.h"
37
38 INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
39 INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
40 INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
41 INTEGER, INTENT(IN) :: nbp ! number of physics columns for this MPI process
42 INTEGER, INTENT(IN) :: communicator ! MPI communicator
43 REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
44 REAL, INTENT (IN) :: rlatv(jjm) ! latitude boundaries of the physics grid
45 REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
46 REAL, INTENT (IN) :: rlonu(iim+1) ! longitude boundaries of the physics grid
47 REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
48 REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
49 REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
50
51 INTEGER :: ibegin, iend, offset
52 INTEGER :: i,j,k
53 CHARACTER (LEN=20) :: modname = 'inigeomphy'
54 CHARACTER (LEN=80) :: abort_message
55 REAL :: total_area_phy, total_area_dyn
56
57 ! boundaries, on global grid
58 REAL,ALLOCATABLE :: boundslon_reg(:,:)
59 REAL,ALLOCATABLE :: boundslat_reg(:,:)
60
61 ! global array, on full physics grid:
62 REAL,ALLOCATABLE :: latfi_glo(:)
63 REAL,ALLOCATABLE :: lonfi_glo(:)
64 REAL,ALLOCATABLE :: cufi_glo(:)
65 REAL,ALLOCATABLE :: cvfi_glo(:)
66 REAL,ALLOCATABLE :: airefi_glo(:)
67 REAL,ALLOCATABLE :: boundslonfi_glo(:,:)
68 REAL,ALLOCATABLE :: boundslatfi_glo(:,:)
69
70 ! local arrays, on given MPI/OpenMP domain:
71 REAL,ALLOCATABLE,SAVE :: latfi(:)
72 REAL,ALLOCATABLE,SAVE :: lonfi(:)
73 REAL,ALLOCATABLE,SAVE :: cufi(:)
74 REAL,ALLOCATABLE,SAVE :: cvfi(:)
75 REAL,ALLOCATABLE,SAVE :: airefi(:)
76 REAL,ALLOCATABLE,SAVE :: boundslonfi(:,:)
77 REAL,ALLOCATABLE,SAVE :: boundslatfi(:,:)
78 INTEGER,ALLOCATABLE,SAVE :: ind_cell_glo_fi(:)
79 !$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi,ind_cell_glo_fi)
80
81 ! Initialize Physics distibution and parameters and interface with dynamics
82
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iim*jjm>1) THEN ! general 3D case
83 CALL init_physics_distribution(regular_lonlat,4, &
84 1 nbp,iim,jjm+1,nlayer,communicator)
85 ELSE ! For 1D model
86 CALL init_physics_distribution(regular_lonlat,4, &
87 1,1,1,nlayer,communicator)
88 ENDIF
89 1 CALL init_interface_dyn_phys
90
91 ! init regular global longitude-latitude grid points and boundaries
92
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 ALLOCATE(boundslon_reg(iim,2))
93
7/14
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
4 ALLOCATE(boundslat_reg(jjm+1,2))
94
95 ! specific handling of the -180 longitude scalar grid point boundaries
96 1 boundslon_reg(1,east)=rlonu(1)
97 1 boundslon_reg(1,west)=rlonu(iim)-2*PI
98
2/2
✓ Branch 0 taken 31 times.
✓ Branch 1 taken 1 times.
32 DO i=2,iim
99 31 boundslon_reg(i,east)=rlonu(i)
100 32 boundslon_reg(i,west)=rlonu(i-1)
101 ENDDO
102
103 1 boundslat_reg(1,north)= PI/2
104 1 boundslat_reg(1,south)= rlatv(1)
105
2/2
✓ Branch 0 taken 31 times.
✓ Branch 1 taken 1 times.
32 DO j=2,jjm
106 31 boundslat_reg(j,north)=rlatv(j-1)
107 32 boundslat_reg(j,south)=rlatv(j)
108 ENDDO
109 1 boundslat_reg(jjm+1,north)= rlatv(jjm)
110 1 boundslat_reg(jjm+1,south)= -PI/2
111
112 ! Write values in module regular_lonlat_mod
113 CALL init_regular_lonlat(iim,jjm+1, rlonv(1:iim), rlatu, &
114 1 boundslon_reg, boundslat_reg)
115
116 ! Generate global arrays on full physics grid
117
3/6
✓ 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.
1 ALLOCATE(latfi_glo(klon_glo),lonfi_glo(klon_glo))
118
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(cufi_glo(klon_glo),cvfi_glo(klon_glo))
119
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 ALLOCATE(airefi_glo(klon_glo))
120
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 ALLOCATE(boundslonfi_glo(klon_glo,4))
121
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 ALLOCATE(boundslatfi_glo(klon_glo,4))
122
123
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (klon_glo>1) THEN ! general case
124 ! North pole
125 1 latfi_glo(1)=rlatu(1)
126 1 lonfi_glo(1)=0.
127 1 cufi_glo(1) = cu(1)
128 1 cvfi_glo(1) = cv(1)
129 1 boundslonfi_glo(1,north_east)=PI
130 1 boundslatfi_glo(1,north_east)=PI/2
131 1 boundslonfi_glo(1,north_west)=-PI
132 1 boundslatfi_glo(1,north_west)=PI/2
133 1 boundslonfi_glo(1,south_west)=-PI
134 1 boundslatfi_glo(1,south_west)=rlatv(1)
135 1 boundslonfi_glo(1,south_east)=PI
136 1 boundslatfi_glo(1,south_east)=rlatv(1)
137
2/2
✓ Branch 0 taken 31 times.
✓ Branch 1 taken 1 times.
32 DO j=2,jjm
138
2/2
✓ Branch 0 taken 992 times.
✓ Branch 1 taken 31 times.
1024 DO i=1,iim
139 992 k=(j-2)*iim+1+i
140 992 latfi_glo(k)= rlatu(j)
141 992 lonfi_glo(k)= rlonv(i)
142 992 cufi_glo(k) = cu((j-1)*(iim+1)+i)
143 992 cvfi_glo(k) = cv((j-1)*(iim+1)+i)
144 992 boundslonfi_glo(k,north_east)=rlonu(i)
145 992 boundslatfi_glo(k,north_east)=rlatv(j-1)
146
2/2
✓ Branch 0 taken 31 times.
✓ Branch 1 taken 961 times.
992 if (i.eq.1) then
147 ! special case for the first longitude's west bound
148 31 boundslonfi_glo(k,north_west)=rlonu(iim)-2*PI
149 31 boundslonfi_glo(k,south_west)=rlonu(iim)-2*PI
150 else
151 961 boundslonfi_glo(k,north_west)=rlonu(i-1)
152 961 boundslonfi_glo(k,south_west)=rlonu(i-1)
153 endif
154 992 boundslatfi_glo(k,north_west)=rlatv(j-1)
155 992 boundslatfi_glo(k,south_west)=rlatv(j)
156 992 boundslonfi_glo(k,south_east)=rlonu(i)
157 1023 boundslatfi_glo(k,south_east)=rlatv(j)
158 ENDDO
159 ENDDO
160 ! South pole
161 1 latfi_glo(klon_glo)= rlatu(jjm+1)
162 1 lonfi_glo(klon_glo)= 0.
163 1 cufi_glo(klon_glo) = cu((iim+1)*jjm+1)
164 1 cvfi_glo(klon_glo) = cv((iim+1)*jjm-iim)
165 1 boundslonfi_glo(klon_glo,north_east)= PI
166 1 boundslatfi_glo(klon_glo,north_east)= rlatv(jjm)
167 1 boundslonfi_glo(klon_glo,north_west)= -PI
168 1 boundslatfi_glo(klon_glo,north_west)= rlatv(jjm)
169 1 boundslonfi_glo(klon_glo,south_west)= -PI
170 1 boundslatfi_glo(klon_glo,south_west)= -PI/2
171 1 boundslonfi_glo(klon_glo,south_east)= PI
172 1 boundslatfi_glo(klon_glo,south_east)= -Pi/2
173
174 ! build airefi(), mesh area on physics grid
175 1 CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi_glo)
176 ! Poles are single points on physics grid
177
2/2
✓ Branch 0 taken 32 times.
✓ Branch 1 taken 1 times.
33 airefi_glo(1)=sum(aire(1:iim,1))
178
2/2
✓ Branch 0 taken 32 times.
✓ Branch 1 taken 1 times.
33 airefi_glo(klon_glo)=sum(aire(1:iim,jjm+1))
179
180 ! Sanity check: do total planet area match between physics and dynamics?
181
4/4
✓ Branch 0 taken 33 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 1056 times.
✓ Branch 3 taken 33 times.
1090 total_area_dyn=sum(aire(1:iim,1:jjm+1))
182
2/2
✓ Branch 0 taken 994 times.
✓ Branch 1 taken 1 times.
995 total_area_phy=sum(airefi_glo(1:klon_glo))
183
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (total_area_dyn/=total_area_phy) THEN
184 1 WRITE (lunout, *) 'inigeomphy: planet total surface discrepancy !!!'
185 1 WRITE (lunout, *) ' in the dynamics total_area_dyn=', total_area_dyn
186 1 WRITE (lunout, *) ' but in the physics total_area_phy=', total_area_phy
187
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
188 ! stop here if the relative difference is more than 0.001%
189 abort_message = 'planet total surface discrepancy'
190 CALL abort_gcm(modname, abort_message, 1)
191 ENDIF
192 ENDIF
193 ELSE ! klon_glo==1, running the 1D model
194 ! just copy over input values
195 latfi_glo(1)=rlatu(1)
196 lonfi_glo(1)=rlonv(1)
197 cufi_glo(1)=cu(1)
198 cvfi_glo(1)=cv(1)
199 airefi_glo(1)=aire(1,1)
200 boundslonfi_glo(1,north_east)=rlonu(1)
201 boundslatfi_glo(1,north_east)=PI/2
202 boundslonfi_glo(1,north_west)=rlonu(2)
203 boundslatfi_glo(1,north_west)=PI/2
204 boundslonfi_glo(1,south_west)=rlonu(2)
205 boundslatfi_glo(1,south_west)=rlatv(1)
206 boundslonfi_glo(1,south_east)=rlonu(1)
207 boundslatfi_glo(1,south_east)=rlatv(1)
208 ENDIF ! of IF (klon_glo>1)
209
210 !$OMP PARALLEL
211 ! Now generate local lon/lat/cu/cv/area/bounds arrays
212
9/18
✓ 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.
✗ Branch 14 not taken.
✓ Branch 15 taken 1 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 1 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 1 times.
1 ALLOCATE(latfi(klon_omp),lonfi(klon_omp),cufi(klon_omp),cvfi(klon_omp))
213
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(airefi(klon_omp))
214
3/6
✓ 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.
1 ALLOCATE(boundslonfi(klon_omp,4))
215
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(boundslatfi(klon_omp,4))
216
3/6
✓ 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.
1 ALLOCATE(ind_cell_glo_fi(klon_omp))
217
218
219 1 offset = klon_mpi_begin - 1
220
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 994 times.
995 airefi(1:klon_omp) = airefi_glo(offset+klon_omp_begin:offset+klon_omp_end)
221
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 994 times.
995 cufi(1:klon_omp) = cufi_glo(offset+klon_omp_begin:offset+klon_omp_end)
222
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 994 times.
995 cvfi(1:klon_omp) = cvfi_glo(offset+klon_omp_begin:offset+klon_omp_end)
223
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 994 times.
995 lonfi(1:klon_omp) = lonfi_glo(offset+klon_omp_begin:offset+klon_omp_end)
224
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 994 times.
995 latfi(1:klon_omp) = latfi_glo(offset+klon_omp_begin:offset+klon_omp_end)
225
4/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 boundslonfi(1:klon_omp,:) = boundslonfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
226
4/4
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
3981 boundslatfi(1:klon_omp,:) = boundslatfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
227
5/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 994 times.
✓ Branch 4 taken 994 times.
✓ Branch 5 taken 1 times.
1990 ind_cell_glo_fi(1:klon_omp)=(/ (i,i=offset+klon_omp_begin,offset+klon_omp_end) /)
228
229 ! copy over local grid longitudes and latitudes
230 CALL init_geometry(klon_omp,lonfi,latfi,boundslonfi,boundslatfi, &
231 1 airefi,ind_cell_glo_fi,cufi,cvfi)
232
233 ! copy over preff , ap(), bp(), etc
234 CALL init_vertical_layers(nlayer,preff,scaleheight, &
235 1 ap,bp,aps,bps,presnivs,pseudoalt)
236
237 !$OMP END PARALLEL
238
239
240
7/14
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
1 END SUBROUTINE inigeomphy
241
242 END MODULE inigeomphy_mod
243
244