GCC Code Coverage Report


Directory: ./
File: phys/readaerosolstrato.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 67 0.0%
Branches: 0 132 0.0%

Line Branch Exec Source
1 subroutine readaerosolstrato(debut)
2
3 use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
4 nf95_inq_varid, nf95_open
5 use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
6
7 USE phys_cal_mod, ONLY : mth_cur
8 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, &
9 grid2dto1d_glo, grid_type, unstructured
10 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
11 USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
12 USE mod_phys_lmdz_para
13 USE phys_state_var_mod
14 USE phys_local_var_mod
15 USE aero_mod
16 USE dimphy
17 USE print_control_mod, ONLY: prt_level,lunout
18 implicit none
19
20 include "YOMCST.h"
21
22 ! Variable input
23 logical debut
24
25 ! Variables locales
26 integer n_lat ! number of latitudes in the input data
27 integer n_lon ! number of longitudes in the input data
28 integer n_lev ! number of levels in the input data
29 integer n_month ! number of months in the input data
30 real, pointer:: latitude(:)
31 real, pointer:: longitude(:)
32 real, pointer:: time(:)
33 real, pointer:: lev(:)
34 integer i, k, band, wave
35 integer, save :: mth_pre=1
36 !$OMP THREADPRIVATE(mth_pre)
37
38 real, allocatable, dimension(:,:), save :: tau_aer_strat
39 !$OMP THREADPRIVATE(tau_aer_strat)
40
41 ! Champs reconstitues
42 real, allocatable:: tauaerstrat(:, :, :, :)
43 real, allocatable:: tauaerstrat_mois(:, :, :)
44 real, allocatable:: tauaerstrat_mois_glo(:, :)
45 real, allocatable:: tau_aer_strat_mpi(:, :)
46
47 ! For NetCDF:
48 integer ncid_in ! IDs for input files
49 integer varid, ncerr
50
51 ! Stratospheric aerosols optical properties
52 ! alpha_strat over the 2 bands is normalised by the 550 nm extinction coefficient
53 ! alpha_strat_wave is *not* normalised by the 550 nm extinction coefficient
54 real, dimension(nbands) :: alpha_strat, piz_strat, cg_strat
55 data alpha_strat/0.9922547, 0.7114912 /
56 data piz_strat /0.9999998, 0.99762493/
57 data cg_strat /0.73107845,0.73229635/
58 real, dimension(nwave_sw) :: alpha_strat_wave
59 data alpha_strat_wave/3.36780953,3.34667683,3.20444202,3.0293026,2.82108808/
60
61 CHARACTER (len = 20) :: modname = 'readaerosolstrato'
62 CHARACTER (len = 80) :: abort_message
63
64 !--------------------------------------------------------
65
66 IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev))
67
68 !--only read file if beginning of run or start of new month
69 IF (debut.OR.mth_cur.NE.mth_pre) THEN
70
71 !--only root reads
72 IF (is_mpi_root.AND.is_omp_root) THEN
73
74 IF (nbands.NE.2) THEN
75 abort_message='nbands doit etre egal a 2 dans readaerosolstrat'
76 CALL abort_physic(modname,abort_message,1)
77 ENDIF
78
79 CALL nf95_open("taustrat.nc", nf90_nowrite, ncid_in)
80
81 CALL nf95_inq_varid(ncid_in, "LEV", varid)
82 CALL nf95_gw_var(ncid_in, varid, lev)
83 n_lev = size(lev)
84 IF (n_lev.NE.klev) THEN
85 abort_message='Le nombre de niveaux n est pas egal a klev'
86 CALL abort_physic(modname,abort_message,1)
87 ENDIF
88
89 CALL nf95_inq_varid(ncid_in, "LAT", varid)
90 CALL nf95_gw_var(ncid_in, varid, latitude)
91 n_lat = size(latitude)
92 WRITE(lunout,*) 'LAT aerosol strato=', n_lat, latitude
93 IF (grid_type/=unstructured) THEN
94 IF (n_lat.NE.nbp_lat) THEN
95 abort_message='Le nombre de lat n est pas egal a nbp_lat'
96 CALL abort_physic(modname,abort_message,1)
97 ENDIF
98 ENDIF
99
100 CALL nf95_inq_varid(ncid_in, "LON", varid)
101 CALL nf95_gw_var(ncid_in, varid, longitude)
102 n_lon = size(longitude)
103 IF (grid_type/=unstructured) THEN
104 WRITE(lunout,*) 'LON aerosol strato=', n_lon, longitude
105 IF (n_lon.NE.nbp_lon) THEN
106 abort_message='Le nombre de lon n est pas egal a nbp_lon'
107 CALL abort_physic(modname,abort_message,1)
108 ENDIF
109 ENDIF
110
111 CALL nf95_inq_varid(ncid_in, "TIME", varid)
112 CALL nf95_gw_var(ncid_in, varid, time)
113 n_month = size(time)
114 WRITE(lunout,*) 'TIME aerosol strato=', n_month, time
115 IF (n_month.NE.12) THEN
116 abort_message='Le nombre de month n est pas egal a 12'
117 CALL abort_physic(modname,abort_message,1)
118 ENDIF
119
120 IF (.not.ALLOCATED(tauaerstrat)) ALLOCATE(tauaerstrat(n_lon, n_lat, n_lev, n_month))
121 IF (.not.ALLOCATED(tauaerstrat_mois)) ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
122 IF (.not.ALLOCATED(tauaerstrat_mois_glo)) ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
123
124 !--reading stratospheric AOD at 550 nm
125 CALL nf95_inq_varid(ncid_in, "TAUSTRAT", varid)
126 ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
127 WRITE(lunout,*) 'code erreur readaerosolstrato=', ncerr, varid
128
129 CALL nf95_close(ncid_in)
130
131 !---select the correct month
132 IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
133 WRITE(lunout,*) 'probleme avec le mois dans readaerosolstrat =', mth_cur
134 ENDIF
135 tauaerstrat_mois(:,:,:) = tauaerstrat(:,:,:,mth_cur)
136
137 !---reduce to a klon_glo grid
138 CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo)
139
140 ELSE
141 ALLOCATE(tauaerstrat_mois(0,0,0))
142 ENDIF !--is_mpi_root and is_omp_root
143
144 !$OMP BARRIER
145
146 IF (grid_type==unstructured) THEN
147 ELSE
148 !--scatter on all proc
149 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
150 ENDIF
151
152 !--keep memory of previous month
153 mth_pre=mth_cur
154 !
155 IF (is_mpi_root.AND.is_omp_root) THEN
156 !
157 DEALLOCATE(tauaerstrat)
158 DEALLOCATE(tauaerstrat_mois)
159 DEALLOCATE(tauaerstrat_mois_glo)
160 !
161 ENDIF !-is_mpi_root and is_omp_root
162
163 !$OMP BARRIER
164
165 ENDIF !--debut ou nouveau mois
166
167 !--total vertical aod at the 6 wavelengths
168 DO wave=1, nwave_sw
169 DO k=1, klev
170 tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2)
171 ENDDO
172 ENDDO
173
174 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
175 DO band=1, nbands
176 !--anthropogenic aerosols bands 1 and 2
177 cg_aero(:,:,3,band) = ( cg_aero(:,:,3,band)*piz_aero(:,:,3,band)*tau_aero(:,:,3,band) + &
178 cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / &
179 MAX( piz_aero(:,:,3,band)*tau_aero(:,:,3,band) + &
180 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
181 piz_aero(:,:,3,band) = ( piz_aero(:,:,3,band)*tau_aero(:,:,3,band) + &
182 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / &
183 MAX( tau_aero(:,:,3,band) + alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
184 tau_aero(:,:,3,band) = tau_aero(:,:,3,band) + alpha_strat(band)*tau_aer_strat(:,:)
185 !--natural aerosols bands 1 and 2
186 cg_aero(:,:,2,band) = ( cg_aero(:,:,2,band)*piz_aero(:,:,2,band)*tau_aero(:,:,2,band) + &
187 cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / &
188 MAX( piz_aero(:,:,2,band)*tau_aero(:,:,2,band) + &
189 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 )
190 piz_aero(:,:,2,band) = ( piz_aero(:,:,2,band)*tau_aero(:,:,2,band) + &
191 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / &
192 MAX( tau_aero(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:),1.e-15 )
193 tau_aero(:,:,2,band) = tau_aero(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:)
194 ENDDO
195
196 end subroutine readaerosolstrato
197