| 1 | ! $Id$ |
|---|
| 2 | MODULE regr_pr_time_av_m |
|---|
| 3 | |
|---|
| 4 | USE write_field_phy |
|---|
| 5 | USE mod_phys_lmdz_transfert_para, ONLY: bcast |
|---|
| 6 | USE mod_phys_lmdz_para, ONLY: mpi_rank, omp_rank |
|---|
| 7 | USE print_control_mod, ONLY: prt_level |
|---|
| 8 | IMPLICIT NONE |
|---|
| 9 | |
|---|
| 10 | !------------------------------------------------------------------------------- |
|---|
| 11 | ! Purpose: Regrid pressure with an averaging method. Operations done: |
|---|
| 12 | ! * on the root process: read a NetCDF 3D or 4D field at a given day. |
|---|
| 13 | ! * pack the fields to the LMDZ "horizontal "physics" grid and scatter |
|---|
| 14 | ! to all threads of all processes; |
|---|
| 15 | ! * in all the threads of all the processes, regrid the fields in pressure |
|---|
| 16 | ! to the LMDZ vertical grid. |
|---|
| 17 | ! * the forcing fields are stretched if the following arguments are present: |
|---|
| 18 | ! - "lat_in": input file latitudes. |
|---|
| 19 | ! - "pcen_in": input file cells center pressure levels. |
|---|
| 20 | ! - "ptrop_ou": target grid (LMDZ) tropopause pressure. |
|---|
| 21 | ! so that the tropopause is shifted to the position of the one of LMDZ. |
|---|
| 22 | ! Note that the ozone quantity conservation is not ensured. |
|---|
| 23 | !------------------------------------------------------------------------------- |
|---|
| 24 | ! Initial routine: regr_pr_av_m module (L. Guez). |
|---|
| 25 | ! Present version: David Cugnet ; corresponding additions: |
|---|
| 26 | ! - time interpolation |
|---|
| 27 | ! - 3D compliant |
|---|
| 28 | ! - vertical stretching of the field to allow tropopause matching between |
|---|
| 29 | ! input field and current lmdz field. |
|---|
| 30 | !------------------------------------------------------------------------------- |
|---|
| 31 | ! Remarks: |
|---|
| 32 | ! * 3D fields are zonal means, with dimensions (latitude, pressure, julian day) |
|---|
| 33 | ! * 4D fields have the dimensions: (longitude, latitude, pressure, julian day) |
|---|
| 34 | ! * All the fields are already on the horizontal grid (rlatu) or (rlatu,rlonv), |
|---|
| 35 | ! except that the latitudes are in ascending order in the input file. |
|---|
| 36 | ! * We assume that all the input fields have the same coordinates. |
|---|
| 37 | ! * The target vertical LMDZ grid is the grid of layer boundaries. |
|---|
| 38 | ! * Regridding in pressure is conservative, second order. |
|---|
| 39 | ! * All the fields are regridded as a single multi-dimensional array, so it |
|---|
| 40 | ! saves CPU time to call this procedure once for several NetCDF variables |
|---|
| 41 | ! rather than several times, each time for a single NetCDF variable. |
|---|
| 42 | ! * The input file pressure at tropopause can be (in decreasing priority): |
|---|
| 43 | ! 1) read from the file if "tropopause_air_pressure" field is available. |
|---|
| 44 | ! 2) computed using "tro3" and "tro3_at_tropopause' (if available). |
|---|
| 45 | ! 3) computed using "tro3" and a fixed threshold otherwise, determined using |
|---|
| 46 | ! an empirical three parameters law: |
|---|
| 47 | ! o3t(ppbV)=co1+co2*SIN(PI*(month-2)/6)*TANH(lat_deg/co3) |
|---|
| 48 | ! => co1 and co2 are in ppbV, and co3 in degrees. |
|---|
| 49 | ! => co3 allow a smooth transition between north and south hemispheres. |
|---|
| 50 | ! * If available, the field "ps" (input file pressure at surface) is used. |
|---|
| 51 | ! If not, the current LMDZ ground pressure is taken instead. |
|---|
| 52 | ! * Fields with suffix "m"/"p" are at the closest records earlier/later than |
|---|
| 53 | ! the mid-julian day "julien", on the global "dynamics" horizontal grid. |
|---|
| 54 | ! * Fields(i,j,k,l) are at longitude-latitude "rlonv(i)-rlatu(j)", pressure |
|---|
| 55 | ! interval "pint_in(k:k+1)]" and variable "nam(l)". |
|---|
| 56 | ! * In the 2D file case, the values are the same for all longitudes. |
|---|
| 57 | ! * The tropopause correction works like this: the input fields (file) are |
|---|
| 58 | ! interpolated on output (LMDZ) pressure field, which is streched using a power |
|---|
| 59 | ! law in a limited zone made of 3 layers: |
|---|
| 60 | ! 1) between the two tropopauses (file and LMDZ) |
|---|
| 61 | ! 2) in an upper and a lower transitions layers |
|---|
| 62 | ! The stretching function has the following form: |
|---|
| 63 | ! Sigma_str = Sigma^(1+alpha), with alpha=LOG(SigT_in/SigT_ou)/LOG(SigT_ou) |
|---|
| 64 | ! This value shifts the file tropopause to the height of the one of LMDZ. |
|---|
| 65 | ! The stretching is fully applied in the central zone only, and only partially |
|---|
| 66 | ! in the transitions zones, thick enough to guarantee a growing stretched |
|---|
| 67 | ! pressure field. The ponderation function for alpha to modulate the stretching |
|---|
| 68 | ! is constant equal to 1 in the central layer, and quasi-linear (from 1 to 0) |
|---|
| 69 | ! in the transition layers (from 1 to 0 ; in fact: sections of 1/log function), |
|---|
| 70 | ! making this localisation function quasi-trapezoidal. |
|---|
| 71 | ! |
|---|
| 72 | ! * The following fields are on the global "dynamics" grid, as read from files: |
|---|
| 73 | REAL, SAVE, ALLOCATABLE :: v1m(:,:,:,:) !--- Previous ozone fields |
|---|
| 74 | REAL, SAVE, ALLOCATABLE :: v1p(:,:,:,:) !--- Next ozone fields |
|---|
| 75 | REAL, SAVE, ALLOCATABLE :: psm(:,:), psp(:,:) !--- Surface pressure |
|---|
| 76 | REAL, SAVE, ALLOCATABLE :: ptm(:,:), ptp(:,:) !--- Tropopause pressure |
|---|
| 77 | REAL, SAVE, ALLOCATABLE :: otm(:,:), otp(:,:) !--- Tropopause o3 mix. ratio |
|---|
| 78 | INTEGER, SAVE :: ntim_in !--- Records nb in input file |
|---|
| 79 | INTEGER, SAVE :: itrp0 !--- idx above chem tropop. |
|---|
| 80 | INTEGER, SAVE :: irec !--- Current time index |
|---|
| 81 | ! * for daily input files: current julian day number |
|---|
| 82 | ! * for monthly input files: julien is in [time_in(irec),time_in(irec+1)] |
|---|
| 83 | LOGICAL, SAVE :: linterp !--- Interpolation in time |
|---|
| 84 | LOGICAL, SAVE :: lPrSurf !--- Surface pressure flag |
|---|
| 85 | LOGICAL, SAVE :: lPrTrop !--- Tropopause pressure flag |
|---|
| 86 | LOGICAL, SAVE :: lO3Trop !--- Tropopause ozone flag |
|---|
| 87 | LOGICAL, SAVE :: lfirst=.TRUE. !--- First call flag |
|---|
| 88 | !$OMP THREADPRIVATE(lfirst) |
|---|
| 89 | REAL, PARAMETER :: pTropUp=9.E+3 !--- Value < tropopause pressure (Pa) |
|---|
| 90 | REAL, PARAMETER :: gamm = 0.4 !--- Relative thickness of transitions |
|---|
| 91 | REAL, PARAMETER :: rho = 1.3 !--- Max tropopauses sigma ratio |
|---|
| 92 | REAL, PARAMETER :: o3t0 = 1.E-7 !--- Nominal O3 vmr at tropopause |
|---|
| 93 | LOGICAL, PARAMETER :: lo3tp=.FALSE. !--- Use parametrized O3 vmr at tropopause |
|---|
| 94 | LOGICAL, PARAMETER :: debug=.FALSE. !--- Force writefield_phy multiple outputs |
|---|
| 95 | REAL, PARAMETER :: ChemPTrMin=9.E+3 !--- Thresholds for minimum and maximum |
|---|
| 96 | REAL, PARAMETER :: ChemPTrMax=4.E+4 ! chemical tropopause pressure (Pa). |
|---|
| 97 | REAL, PARAMETER :: DynPTrMin =8.E+3 !--- Thresholds for minimum and maximum |
|---|
| 98 | REAL, PARAMETER :: DynPTrMax =4.E+4 ! dynamical tropopause pressure (Pa). |
|---|
| 99 | |
|---|
| 100 | CONTAINS |
|---|
| 101 | |
|---|
| 102 | !------------------------------------------------------------------------------- |
|---|
| 103 | ! |
|---|
| 104 | SUBROUTINE regr_pr_time_av(fID, nam, julien, pint_in, pint_ou, v3, & |
|---|
| 105 | time_in, lon_in, lat_in, pcen_in, ptrop_ou) |
|---|
| 106 | ! |
|---|
| 107 | !------------------------------------------------------------------------------- |
|---|
| 108 | USE dimphy, ONLY: klon |
|---|
| 109 | USE netcdf95, ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, handle_err, & |
|---|
| 110 | NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION |
|---|
| 111 | USE netcdf, ONLY: NF90_INQ_VARID, NF90_GET_VAR, NF90_NOERR |
|---|
| 112 | USE assert_m, ONLY: assert |
|---|
| 113 | USE assert_eq_m, ONLY: assert_eq |
|---|
| 114 | USE comvert_mod, ONLY: scaleheight |
|---|
| 115 | USE interpolation, ONLY: locate |
|---|
| 116 | USE regr_conserv_m, ONLY: regr_conserv |
|---|
| 117 | USE regr_lint_m, ONLY: regr_lint |
|---|
| 118 | USE slopes_m, ONLY: slopes |
|---|
| 119 | USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root |
|---|
| 120 | USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev |
|---|
| 121 | USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter |
|---|
| 122 | USE phys_cal_mod, ONLY: calend, year_len, days_elapsed, jH_cur |
|---|
| 123 | !------------------------------------------------------------------------------- |
|---|
| 124 | ! Arguments: |
|---|
| 125 | INTEGER, INTENT(IN) :: fID !--- NetCDF file ID |
|---|
| 126 | CHARACTER(LEN=13), INTENT(IN) :: nam(:) !--- NetCDF variables names |
|---|
| 127 | REAL, INTENT(IN) :: julien !--- Days since Jan 1st |
|---|
| 128 | !--- File & LMDZ (resp. decreasing & increasing order) interfaces pressure, Pa |
|---|
| 129 | REAL, INTENT(IN) :: pint_in(:) !--- in: file (nlev_in+1) |
|---|
| 130 | REAL, INTENT(IN) :: pint_ou(:,:) !--- out: LMDZ (klon,nbp_lev+1) |
|---|
| 131 | REAL, INTENT(OUT) :: v3(:,:,:) !--- Regridded fld (klon,llm,n_var) |
|---|
| 132 | REAL, INTENT(IN), OPTIONAL :: time_in(:) !--- Records times, in days |
|---|
| 133 | ! since Jan 1 of current year |
|---|
| 134 | REAL, INTENT(IN), OPTIONAL :: lon_in(:) !--- File longitudes vector (klon) |
|---|
| 135 | REAL, INTENT(IN), OPTIONAL :: lat_in(:) !--- File latitudes vector (klon) |
|---|
| 136 | REAL, INTENT(IN), OPTIONAL :: pcen_in(:) !--- File mid-layers pres (nlev_in) |
|---|
| 137 | REAL, INTENT(IN), OPTIONAL :: ptrop_ou(:)!--- LMDZ tropopause pres (klon) |
|---|
| 138 | !------------------------------------------------------------------------------- |
|---|
| 139 | ! Local variables: |
|---|
| 140 | include "clesphys.h" |
|---|
| 141 | include "YOMCST.h" |
|---|
| 142 | CHARACTER(LEN=80) :: sub |
|---|
| 143 | CHARACTER(LEN=320) :: str |
|---|
| 144 | INTEGER :: vID, ncerr, n_var, ibot, ibo0, nn, itrp |
|---|
| 145 | INTEGER :: i, nlev_in, n_dim, itop, ito0, i0 |
|---|
| 146 | LOGICAL :: lAdjTro !--- Need to adjust tropopause |
|---|
| 147 | REAL :: y_frac !--- Elapsed year fraction |
|---|
| 148 | REAL :: alpha, beta, al !--- For stretching/interpolation |
|---|
| 149 | REAL :: SigT_in, SigT_ou !--- Input and output tropopauses |
|---|
| 150 | REAL :: Sig_bot, Sig_top !--- Fully strained layer bounds |
|---|
| 151 | REAL :: Sig_bo0, Sig_to0 !--- Total strained layers bounds |
|---|
| 152 | REAL :: Sig_in(SIZE(pint_in)) !--- Input field sigma levels |
|---|
| 153 | REAL :: Sig_ou (nbp_lev+1) !--- Output LMDZ sigma levels |
|---|
| 154 | REAL :: phi (nbp_lev+1) !--- Stretching exponent anomaly |
|---|
| 155 | REAL :: pstr_ou(nbp_lev+1) !--- Stretched pressure levels |
|---|
| 156 | REAL :: pintou (nbp_lev+1) !--- pint_ou in reversed order |
|---|
| 157 | REAL :: v1(nbp_lon,nbp_lat,SIZE(pint_in)-1,SIZE(nam)) |
|---|
| 158 | REAL :: v2(klon, SIZE(pint_in)-1,SIZE(nam)) |
|---|
| 159 | ! v1: Field read/interpol at time "julien" on the global "dynamics" horiz. grid. |
|---|
| 160 | ! v2: Field scattered to the partial "physics" horizontal grid. |
|---|
| 161 | ! In the 2D file case, the values are the same for all longitudes. |
|---|
| 162 | ! "v2(i, k, l)" is at longitude-latitude "xlon(i)-xlat(i)". |
|---|
| 163 | ! Both are for pressure interval "press_in_edg(k:k+1)]" and variable "nam(l)" |
|---|
| 164 | REAL, DIMENSION(nbp_lon, nbp_lat) :: ps1, pt1, ot1 |
|---|
| 165 | REAL, DIMENSION(klon) :: ps2, pt2, ot2, ptropou |
|---|
| 166 | LOGICAL :: ll |
|---|
| 167 | !--- For debug |
|---|
| 168 | REAL, DIMENSION(klon) :: ptrop_in, ptrop_ef!, dzStrain, dzStrain0 |
|---|
| 169 | ! REAL, DIMENSION(klon,nbp_lev+1) :: pstrn_ou, phii |
|---|
| 170 | !------------------------------------------------------------------------------- |
|---|
| 171 | sub="regr_pr_time_av" |
|---|
| 172 | nlev_in=SIZE(pint_in)-1 |
|---|
| 173 | CALL assert(SIZE(v3,1)==klon, TRIM(sub)//" v3 klon") |
|---|
| 174 | CALL assert(SIZE(v3,2)==nbp_lev, TRIM(sub)//" v3 nbp_lev") |
|---|
| 175 | n_var = assert_eq(SIZE(nam),SIZE(v3,3),TRIM(sub)//" v3 n_var") |
|---|
| 176 | CALL assert(SIZE(pint_ou,1)==klon ,TRIM(sub)//" pint_ou klon") |
|---|
| 177 | CALL assert(SIZE(pint_ou,2)==nbp_lev+1,TRIM(sub)//" pint_ou nbp_lev+1") |
|---|
| 178 | IF(PRESENT(lon_in)) CALL assert(SIZE(lon_in )==klon,TRIM(sub)//" lon_in klon") |
|---|
| 179 | IF(PRESENT(lat_in)) CALL assert(SIZE(lat_in )==klon,TRIM(sub)//" lat_in klon") |
|---|
| 180 | IF(PRESENT(ptrop_ou)) CALL assert(SIZE(ptrop_ou)==klon,TRIM(sub)//" ptrop_ou klon") |
|---|
| 181 | IF(PRESENT(pcen_in)) CALL assert(SIZE(pcen_in )==nlev_in,TRIM(sub)//" pcen_in") |
|---|
| 182 | lAdjTro=PRESENT(ptrop_ou) |
|---|
| 183 | IF(lAdjTro.AND.(.NOT.PRESENT(lat_in).OR..NOT.PRESENT(pcen_in))) & |
|---|
| 184 | CALL abort_physic(sub, 'Missing lat_in and/or pcen_in (adjust_tropopause=T)', 1) |
|---|
| 185 | |
|---|
| 186 | !$OMP MASTER |
|---|
| 187 | IF(is_mpi_root) THEN |
|---|
| 188 | |
|---|
| 189 | !=== CHECK WHICH FIELDS ARE AVAILABLE IN THE INPUT FILE |
|---|
| 190 | IF(lfirst) THEN |
|---|
| 191 | lPrSurf=NF90_INQ_VARID(fID,"ps" ,vID)==NF90_NOERR |
|---|
| 192 | lPrTrop=NF90_INQ_VARID(fID,"tropopause_air_pressure",vID)==NF90_NOERR |
|---|
| 193 | lO3Trop=NF90_INQ_VARID(fID,"tro3_at_tropopause" ,vID)==NF90_NOERR |
|---|
| 194 | CALL NF95_INQ_DIMID(fID,"time",vID) |
|---|
| 195 | CALL NF95_INQUIRE_DIMENSION(fID,vID,nclen=ntim_in) |
|---|
| 196 | linterp=PRESENT(time_in).AND.ntim_in==14 |
|---|
| 197 | IF(linterp) THEN |
|---|
| 198 | ALLOCATE(v1m(nbp_lon,nbp_lat,nlev_in,n_var)) |
|---|
| 199 | ALLOCATE(v1p(nbp_lon,nbp_lat,nlev_in,n_var)) |
|---|
| 200 | ALLOCATE(psm(nbp_lon,nbp_lat),psp(nbp_lon,nbp_lat)) |
|---|
| 201 | ALLOCATE(ptm(nbp_lon,nbp_lat),ptp(nbp_lon,nbp_lat)) |
|---|
| 202 | IF(lO3Trop) ALLOCATE(otm(nbp_lon,nbp_lat),otp(nbp_lon,nbp_lat)) |
|---|
| 203 | END IF |
|---|
| 204 | !--- INITIAL INDEX: LOCATE A LAYER WELL ABOVE TROPOPAUSE (50hPa) |
|---|
| 205 | IF(lAdjTro) itrp0=locate(pcen_in,pTropUp) |
|---|
| 206 | CALL msg(lPrSurf,'Using GROUND PRESSURE from input O3 forcing file.',sub) |
|---|
| 207 | CALL msg(linterp,'Monthly O3 files => ONLINE TIME INTERPOLATION.',sub) |
|---|
| 208 | CALL msg(lAdjTro,'o3 forcing file tropopause location uses:',sub) |
|---|
| 209 | IF(lPrTrop) THEN |
|---|
| 210 | CALL msg(lAdjTro,' PRESSURE AT TROPOPAUSE from file.') |
|---|
| 211 | ELSE IF(lO3Trop) THEN |
|---|
| 212 | CALL msg(lAdjTro,' O3 CONCENTRATION AT TROPOPAUSE from file.') |
|---|
| 213 | ELSE IF(lo3tp) THEN |
|---|
| 214 | CALL msg(lAdjTro,' PARAMETRIZED O3 concentration at tropopause.') |
|---|
| 215 | ELSE |
|---|
| 216 | CALL msg(lAdjTro,' CONSTANT O3 concentration at tropopause.') |
|---|
| 217 | END IF |
|---|
| 218 | END IF |
|---|
| 219 | |
|---|
| 220 | !=== UPDATE (ALWAYS FOR DAILY FILES, EACH MONTH FOR MONTHLY FILES) |
|---|
| 221 | CALL update_fields() |
|---|
| 222 | |
|---|
| 223 | !=== TIME INTERPOLATION FOR MONTHLY INPUT FILES |
|---|
| 224 | IF(linterp) THEN |
|---|
| 225 | WRITE(str,'(3(a,f12.8))')'Interpolating O3 at julian day ',julien,' from '& |
|---|
| 226 | &//'fields at times ',time_in(irec),' and ', time_in(irec+1) |
|---|
| 227 | CALL msg(.TRUE.,str,sub) |
|---|
| 228 | al=(time_in(irec+1)-julien)/(time_in(irec+1)-time_in(irec)) |
|---|
| 229 | v1=al*v1m+(1.-al)*v1p |
|---|
| 230 | IF(lPrSurf) ps1=al*psm+(1.-al)*psp |
|---|
| 231 | IF(lPrTrop) pt1=al*ptm+(1.-al)*ptp |
|---|
| 232 | IF(lO3Trop) ot1=al*otm+(1.-al)*otp |
|---|
| 233 | END IF |
|---|
| 234 | END IF |
|---|
| 235 | !$OMP END MASTER |
|---|
| 236 | IF(lfirst) THEN |
|---|
| 237 | lfirst=.FALSE.; CALL bcast(lfirst) |
|---|
| 238 | IF(lAdjTro) CALL bcast(itrp0) |
|---|
| 239 | CALL bcast(lPrTrop); CALL bcast(lPrSurf) |
|---|
| 240 | CALL bcast(lO3Trop); CALL bcast(linterp) |
|---|
| 241 | END IF |
|---|
| 242 | CALL scatter2d(v1,v2) |
|---|
| 243 | !--- No "ps" in input file => assumed to be equal to current LMDZ ground press |
|---|
| 244 | IF(lPrSurf) THEN; CALL scatter2d(ps1,ps2); ELSE; ps2=pint_ou(:,1); END IF |
|---|
| 245 | IF(lPrTrop) CALL scatter2d(pt1,pt2) |
|---|
| 246 | IF(lO3Trop) CALL scatter2d(ot1,ot2) |
|---|
| 247 | |
|---|
| 248 | !--- REGRID IN PRESSURE ; 3rd index inverted because "paprs" is decreasing |
|---|
| 249 | IF(.NOT.lAdjTro) THEN |
|---|
| 250 | DO i=1,klon |
|---|
| 251 | pintou = pint_ou(i,nbp_lev+1:1:-1) |
|---|
| 252 | CALL regr_conserv(1,v2(i,:,:), pint_in(:), pintou(:), & |
|---|
| 253 | v3(i,nbp_lev:1:-1,:), slopes(1,v2(i,:,:), pint_in(:))) |
|---|
| 254 | END DO |
|---|
| 255 | ELSE |
|---|
| 256 | y_frac=(REAL(days_elapsed)+jH_cur)/year_len |
|---|
| 257 | |
|---|
| 258 | !--- OUTPUT SIGMA LEVELS |
|---|
| 259 | DO i=1,klon |
|---|
| 260 | |
|---|
| 261 | !--- LOCAL INPUT/OUTPUT (FILE/LMDZ) SIGMA LEVELS AT INTERFACES |
|---|
| 262 | pintou=pint_ou(i,nbp_lev+1:1:-1) !--- increasing values |
|---|
| 263 | Sig_in(:) = [pint_in(1:nlev_in+1)/ps2(i)] !--- increasing values |
|---|
| 264 | Sig_ou(:) = [pintou (1:nbp_lev)/ps2(i),1.0] !--- increasing values |
|---|
| 265 | |
|---|
| 266 | !--- INPUT (FILE) SIGMA LEVEL AT TROPOPAUSE ; extreme values are filtered |
|---|
| 267 | ! to keep tropopause pressure realistic ; high values are usually due to |
|---|
| 268 | ! ozone hole fooling the crude chemical tropopause detection algorithm. |
|---|
| 269 | SigT_in = get_SigTrop(i,itrp) |
|---|
| 270 | SigT_in=MIN(SigT_in,ChemPTrMax/ps2(i)) !--- too low value filtered |
|---|
| 271 | SigT_in=MAX(SigT_in,ChemPTrMin/ps2(i)) !--- too high value filtered |
|---|
| 272 | |
|---|
| 273 | !--- OUTPUT (LMDZ) SIGMA LEVEL AT TROPOPAUSE ; too high variations of the |
|---|
| 274 | ! dynamical tropopause (especially in filaments) are conterbalanced with a |
|---|
| 275 | ! filter ensuring it stays within a certain distance around input (file) |
|---|
| 276 | ! tropopause, hence avoiding avoid a too thick stretched region ; a final |
|---|
| 277 | ! extra-safety filter keeps the tropopause pressure value realistic. |
|---|
| 278 | SigT_ou = ptrop_ou(i)/ps2(i) |
|---|
| 279 | IF(SigT_ou<SigT_in/rho) SigT_ou=SigT_in/rho !--- too low value w/r input |
|---|
| 280 | IF(SigT_ou>SigT_in*rho) SigT_ou=SigT_in*rho !--- too high value w/r input |
|---|
| 281 | SigT_ou=MIN(SigT_ou,DynPTrMax/ps2(i)) !--- too low value filtered |
|---|
| 282 | SigT_ou=MAX(SigT_ou,DynPTrMin/ps2(i)) !--- too high value filtered |
|---|
| 283 | ptropou(i)=SigT_ou*ps2(i) |
|---|
| 284 | |
|---|
| 285 | !--- FULLY STRETCHED LAYER BOUNDS (alpha power law fully applied) |
|---|
| 286 | alpha = LOG(SigT_in/SigT_ou)/LOG(SigT_ou) |
|---|
| 287 | Sig_bot = MAX(SigT_in,SigT_ou) ; ibot = locate(Sig_ou(:),Sig_bot) |
|---|
| 288 | Sig_top = MIN(SigT_in,SigT_ou) ; itop = locate(Sig_ou(:),Sig_top) |
|---|
| 289 | |
|---|
| 290 | !--- PARTIALLY STRETCHED LAYER BOUNDS (fraction of alpha applied) |
|---|
| 291 | ! The used formulae ensure the first derivative stays positive. |
|---|
| 292 | beta = LOG(Sig_top)/LOG(Sig_bot) |
|---|
| 293 | Sig_bo0 = Sig_bot ; IF(alpha<0.) Sig_bo0 = Sig_bot**(1/beta) |
|---|
| 294 | Sig_to0 = Sig_top ; IF(alpha>0.) Sig_to0 = Sig_top ** beta |
|---|
| 295 | |
|---|
| 296 | !--- SOME ADDITIONAL MARGIN, PROPORTIONAL TO STRETCHED REGION THICKNESS |
|---|
| 297 | !--- gamma<log(Sig_bo0/|alpha|) to keep Sig_bo0<1 |
|---|
| 298 | Sig_bo0 = MIN(Sig_bo0*EXP( gamm*ABS(alpha)), 0.95+(1.-0.95)*Sig_bo0) |
|---|
| 299 | Sig_to0 = Sig_to0*EXP(-gamm*ABS(alpha)) |
|---|
| 300 | ibo0 = locate(Sig_ou(:),Sig_bo0) |
|---|
| 301 | ito0 = locate(Sig_ou(:),Sig_to0) |
|---|
| 302 | |
|---|
| 303 | !--- STRETCHING POWER LAW FUNCTION: |
|---|
| 304 | ! 0 in [0,Sig_to0] and [Sig_bo0,1] ; 1 in [Sig_bot,Sig_top] |
|---|
| 305 | ! 0->1 in [Sig_to0,Sig_top] 1->0 in [Sig_bot,Sig_bo0] |
|---|
| 306 | phi(:)=0. |
|---|
| 307 | phi(itop+1:ibot) = 1. |
|---|
| 308 | phi(ito0+1:itop) = (1.-LOG(Sig_to0)/LOG(Sig_ou(ito0+1:itop)))& |
|---|
| 309 | *LOG(Sig_top)/LOG(Sig_top/Sig_to0) |
|---|
| 310 | phi(ibot+1:ibo0) = (1.-LOG(Sig_bo0)/LOG(Sig_ou(ibot+1:ibo0)))& |
|---|
| 311 | *LOG(Sig_bot)/LOG(Sig_bot/Sig_bo0) |
|---|
| 312 | |
|---|
| 313 | !--- LOCALY STRECHED OUTPUT (LMDZ) PRESSURE PROFILES (INCREASING ORDER) |
|---|
| 314 | pstr_ou(:) = pintou(:) * Sig_ou(:)**(alpha*phi(:)) |
|---|
| 315 | |
|---|
| 316 | !--- REGRID INPUT PROFILE ON STRAINED VERTICAL OUTPUT LEVELS |
|---|
| 317 | CALL regr_conserv(1, v2(i,:,:), pint_in(:), pstr_ou(:), & |
|---|
| 318 | v3(i,nbp_lev:1:-1,:), slopes(1,v2(i,:,:),pint_in(:))) |
|---|
| 319 | |
|---|
| 320 | !--- CHECK CONCENTRATIONS. strato: 50ppbV-15ppmV ; tropo: 5ppbV-300ppbV. |
|---|
| 321 | i0=nbp_lev-locate(pintou(:),ptropou(i))+1 |
|---|
| 322 | ll=check_ozone(v3(i, 1:i0 ,1),lon_in(i),lat_in(i),1 ,'troposphere', & |
|---|
| 323 | 5.E-9,3.0E-7) |
|---|
| 324 | ! IF(ll) CALL abort_physic(sub, 'Inconsistent O3 values in troposphere', 1) |
|---|
| 325 | ll=check_ozone(v3(i,i0:nbp_lev,1),lon_in(i),lat_in(i),i0,'stratosphere', & |
|---|
| 326 | 5.E-8,1.5E-5) |
|---|
| 327 | ! IF(ll) CALL abort_physic(sub, 'Inconsistent O3 values in stratosphere', 1) |
|---|
| 328 | |
|---|
| 329 | IF(debug) THEN |
|---|
| 330 | ! dzStrain0(i)=7.*LOG(Sig_bo0/Sig_to0) |
|---|
| 331 | ! dzStrain (i)=7.*LOG(Sig_bot/Sig_top) |
|---|
| 332 | ptrop_in(i) = SigT_in*ps2(i) |
|---|
| 333 | ! Pstrn_ou(i,:)= pstr_ou |
|---|
| 334 | ! phii(i,:)=phi(:) |
|---|
| 335 | ptrop_ef(i)=chem_tropopause(i, itrp, locate(pintou(:),PTropUp), & |
|---|
| 336 | pintou(:), v3(:,nbp_lev+1:1:-1,1),o3trop=o3t0) |
|---|
| 337 | END IF |
|---|
| 338 | END DO |
|---|
| 339 | IF(debug) THEN |
|---|
| 340 | ! CALL writefield_phy('PreSt_ou' ,Pstrn_ou,nbp_lev+1) !--- Strained pressure |
|---|
| 341 | ! CALL writefield_phy('dzStrain' ,dzStrain ,1) !--- Fully & total strained |
|---|
| 342 | ! CALL writefield_phy('dzStrain0',dzStrain0,1) !--- regions thickness |
|---|
| 343 | ! CALL writefield_phy('phi',phii,nbp_lev+1) !--- Localisation function |
|---|
| 344 | !--- Tropopauses pressures: |
|---|
| 345 | CALL writefield_phy('PreTr_in',ptrop_in,1) !--- Input and effective |
|---|
| 346 | CALL writefield_phy('PreTr_ef',ptrop_ef,1) ! chemical tropopauses |
|---|
| 347 | END IF |
|---|
| 348 | END IF |
|---|
| 349 | IF(debug) THEN |
|---|
| 350 | IF(lAdjTro) & |
|---|
| 351 | CALL writefield_phy('PreTr_ou',ptropou,1) !--- LMDz dyn tropopause |
|---|
| 352 | CALL writefield_phy('Ozone_in',v2(:,:,1),nlev_in)!--- Raw input O3 field |
|---|
| 353 | CALL writefield_phy('Ozone_ou',v3(:,:,1),nbp_lev)!--- Output ozone field |
|---|
| 354 | CALL writefield_phy('Pint_ou' ,pint_ou,1+nbp_lev)!--- LMDZ unstreched Press |
|---|
| 355 | END IF |
|---|
| 356 | |
|---|
| 357 | CONTAINS |
|---|
| 358 | |
|---|
| 359 | |
|---|
| 360 | !------------------------------------------------------------------------------- |
|---|
| 361 | ! |
|---|
| 362 | SUBROUTINE update_fields() |
|---|
| 363 | ! |
|---|
| 364 | !------------------------------------------------------------------------------- |
|---|
| 365 | IF(.NOT.linterp) THEN !=== DAILY FILES: NO TIME INTERPOLATION |
|---|
| 366 | CALL msg(.TRUE.,sub,'Updating Ozone forcing field: read from file.') |
|---|
| 367 | irec=MIN(INT(julien)+1,ntim_in) !--- irec is just the julian day number |
|---|
| 368 | !--- MIN -> Security in the unlikely case of roundup errors. |
|---|
| 369 | CALL get_3Dfields(v1) !--- Read ozone field(s) |
|---|
| 370 | IF(lAdjTro) THEN !--- Additional files for fields strain |
|---|
| 371 | IF(lPrSurf) CALL get_2Dfield(ps1,"ps") |
|---|
| 372 | IF(lPrTrop) CALL get_2Dfield(pt1,"tropopause_air_pressure") |
|---|
| 373 | IF(lO3Trop) CALL get_2Dfield(ot1,"tro3_at_tropopause") |
|---|
| 374 | END IF |
|---|
| 375 | ELSE !=== MONTHLY FILES: GET 2 NEAREST RECS |
|---|
| 376 | IF(lfirst) irec=locate(time_in,julien) !--- Need to locate surrounding times |
|---|
| 377 | IF(.NOT.lfirst.AND.julien<time_in(irec+1)) RETURN |
|---|
| 378 | CALL msg(.TRUE.,'Refreshing adjacent Ozone forcing fields.',sub) |
|---|
| 379 | IF(lfirst) THEN !=== READ EARLIEST TIME FIELDS |
|---|
| 380 | WRITE(str,'(a,i3,a,f12.8,a)')'Previous available field update (step 1): '& |
|---|
| 381 | //'reading record ',irec,' (time ',time_in(irec),')' |
|---|
| 382 | CALL msg(.TRUE.,str,sub) |
|---|
| 383 | CALL get_3Dfields(v1m) !--- Read ozone field(s) |
|---|
| 384 | IF(lAdjTro) THEN !--- Additional files for fields strain |
|---|
| 385 | IF(lPrSurf) CALL get_2Dfield(psm,"ps") |
|---|
| 386 | IF(lPrTrop) CALL get_2Dfield(ptm,"tropopause_air_pressure") |
|---|
| 387 | IF(lO3Trop) CALL get_2Dfield(otm,"tro3_at_tropopause") |
|---|
| 388 | END IF |
|---|
| 389 | ELSE !=== SHIFT FIELDS |
|---|
| 390 | irec=irec+1 |
|---|
| 391 | WRITE(str,'(a,i3,a,f12.8,a)')'Previous available field update: shifting'& |
|---|
| 392 | //' current next one (',irec,', time ',time_in(irec),')' |
|---|
| 393 | CALL msg(.TRUE.,str,sub) |
|---|
| 394 | v1m=v1p !--- Ozone fields |
|---|
| 395 | IF(lAdjTro) THEN !--- Additional files for fields strain |
|---|
| 396 | IF(lPrSurf) psm=psp !--- Surface pressure |
|---|
| 397 | IF(lPrTrop) ptm=ptp !--- Tropopause pressure |
|---|
| 398 | IF(lO3Trop) otm=otp !--- Tropopause ozone |
|---|
| 399 | END IF |
|---|
| 400 | END IF |
|---|
| 401 | irec=irec+1 |
|---|
| 402 | WRITE(str,'(a,i3,a,f12.8,a)')'Next available field update: reading record'& |
|---|
| 403 | ,irec,' (time ',time_in(irec),')' |
|---|
| 404 | CALL msg(.TRUE.,str,sub) |
|---|
| 405 | CALL get_3Dfields(v1p) !--- Read ozone field(s) |
|---|
| 406 | IF(lAdjTro) THEN !--- Additional files for fields strain |
|---|
| 407 | IF(lPrSurf) CALL get_2Dfield(psp,"ps") |
|---|
| 408 | IF(lPrTrop) CALL get_2Dfield(ptp,"tropopause_air_pressure") |
|---|
| 409 | IF(lO3Trop) CALL get_2Dfield(otp,"tro3_at_tropopause") |
|---|
| 410 | END IF |
|---|
| 411 | irec=irec-1 |
|---|
| 412 | END IF |
|---|
| 413 | |
|---|
| 414 | END SUBROUTINE update_fields |
|---|
| 415 | ! |
|---|
| 416 | !------------------------------------------------------------------------------- |
|---|
| 417 | |
|---|
| 418 | |
|---|
| 419 | !------------------------------------------------------------------------------- |
|---|
| 420 | ! |
|---|
| 421 | SUBROUTINE get_2Dfield(v,var) |
|---|
| 422 | ! |
|---|
| 423 | !------------------------------------------------------------------------------- |
|---|
| 424 | ! Purpose: Shortcut to get the "irec"th record of the surface field named "var" |
|---|
| 425 | ! from the input file. |
|---|
| 426 | ! Remark: In case the field is zonal, it is duplicated along first dimension. |
|---|
| 427 | !------------------------------------------------------------------------------- |
|---|
| 428 | ! Arguments: |
|---|
| 429 | REAL, INTENT(INOUT) :: v(:,:) |
|---|
| 430 | CHARACTER(LEN=*), INTENT(IN) :: var |
|---|
| 431 | !------------------------------------------------------------------------------- |
|---|
| 432 | CALL NF95_INQ_VARID(fID, TRIM(var), vID) |
|---|
| 433 | CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim) |
|---|
| 434 | IF(n_dim==2) ncerr=NF90_GET_VAR(fID,vID,v(1,:), start=[ 1,irec]) |
|---|
| 435 | IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(:,:), start=[1,1,irec]) |
|---|
| 436 | CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(var),ncerr,fID) |
|---|
| 437 | |
|---|
| 438 | !--- Flip latitudes: ascending in input file, descending in "rlatu". |
|---|
| 439 | IF(n_dim==3) THEN |
|---|
| 440 | v(1,:) = v(1,nbp_lat:1:-1) |
|---|
| 441 | v(2:,:)= SPREAD(v(1,:),DIM=1,ncopies=nbp_lon-1) !--- Duplication |
|---|
| 442 | ELSE |
|---|
| 443 | v(:,:) = v(:,nbp_lat:1:-1) |
|---|
| 444 | END IF |
|---|
| 445 | |
|---|
| 446 | END SUBROUTINE get_2Dfield |
|---|
| 447 | ! |
|---|
| 448 | !------------------------------------------------------------------------------- |
|---|
| 449 | |
|---|
| 450 | |
|---|
| 451 | !------------------------------------------------------------------------------- |
|---|
| 452 | ! |
|---|
| 453 | SUBROUTINE get_3Dfields(v) |
|---|
| 454 | ! |
|---|
| 455 | !------------------------------------------------------------------------------- |
|---|
| 456 | ! Purpose: Shortcut to get the "irec"th record of the 3D fields named "nam" |
|---|
| 457 | ! from the input file. Fields are stacked on fourth dimension. |
|---|
| 458 | ! Remark: In case the field is zonal, it is duplicated along first dimension. |
|---|
| 459 | !------------------------------------------------------------------------------- |
|---|
| 460 | ! Arguments: |
|---|
| 461 | REAL, INTENT(INOUT) :: v(:,:,:,:) |
|---|
| 462 | !------------------------------------------------------------------------------- |
|---|
| 463 | DO i=1,SIZE(nam) |
|---|
| 464 | CALL NF95_INQ_VARID(fID, TRIM(nam(i)), vID) |
|---|
| 465 | CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim) |
|---|
| 466 | IF(n_dim==3) ncerr=NF90_GET_VAR(fID,vID,v(1,:,:,i), start=[ 1,1,irec]) |
|---|
| 467 | IF(n_dim==4) ncerr=NF90_GET_VAR(fID,vID,v(:,:,:,i), start=[1,1,1,irec]) |
|---|
| 468 | CALL handle_err(TRIM(sub)//" NF90_GET_VAR "//TRIM(nam(i)),ncerr,fID) |
|---|
| 469 | END DO |
|---|
| 470 | |
|---|
| 471 | !--- Flip latitudes: ascending in input file, descending in "rlatu". |
|---|
| 472 | IF(n_dim==3) THEN |
|---|
| 473 | v(1,:,:,:) = v(1,nbp_lat:1:-1,:,:) |
|---|
| 474 | v(2:,:,:,:)= SPREAD(v(1,:,:,:),DIM=1,ncopies=nbp_lon-1) !--- Duplication |
|---|
| 475 | ELSE |
|---|
| 476 | v(:,:,:,:) = v(:,nbp_lat:1:-1,:,:) |
|---|
| 477 | END IF |
|---|
| 478 | |
|---|
| 479 | END SUBROUTINE get_3Dfields |
|---|
| 480 | ! |
|---|
| 481 | !------------------------------------------------------------------------------- |
|---|
| 482 | |
|---|
| 483 | |
|---|
| 484 | |
|---|
| 485 | !------------------------------------------------------------------------------- |
|---|
| 486 | ! |
|---|
| 487 | FUNCTION get_SigTrop(ih,it) |
|---|
| 488 | ! |
|---|
| 489 | !------------------------------------------------------------------------------- |
|---|
| 490 | ! Arguments: |
|---|
| 491 | INTEGER, INTENT(IN) :: ih |
|---|
| 492 | INTEGER, INTENT(OUT) :: it |
|---|
| 493 | REAL :: get_Sigtrop |
|---|
| 494 | !------------------------------------------------------------------------------- |
|---|
| 495 | !--- Pressure at tropopause is read in the forcing file |
|---|
| 496 | IF(lPrTrop) THEN !--- PrTrop KNOWN FROM FILE |
|---|
| 497 | get_SigTrop=pt2(ih)/ps2(ih); RETURN |
|---|
| 498 | END IF |
|---|
| 499 | !--- Chemical tropopause definition is used using a particular threshold |
|---|
| 500 | IF(lO3Trop) THEN !--- o3trop KNOWN FROM FILE |
|---|
| 501 | get_SigTrop=chem_tropopause(ih,it,itrp0,pint_in,v2(:,:,1),pcen_in,ot2(ih)) |
|---|
| 502 | ELSE IF(lo3tp) THEN !--- o3trop PARAMETRIZATION |
|---|
| 503 | get_SigTrop=chem_tropopause(ih,it,itrp0,pint_in,v2(:,:,1),pcen_in) |
|---|
| 504 | ELSE !--- o3trop CONSTANT |
|---|
| 505 | get_SigTrop=chem_tropopause(ih,it,itrp0,pint_in,v2(:,:,1),pcen_in,o3t0) |
|---|
| 506 | END IF |
|---|
| 507 | get_SigTrop=get_SigTrop/ps2(ih) |
|---|
| 508 | |
|---|
| 509 | END FUNCTION get_SigTrop |
|---|
| 510 | ! |
|---|
| 511 | !------------------------------------------------------------------------------- |
|---|
| 512 | |
|---|
| 513 | |
|---|
| 514 | !------------------------------------------------------------------------------- |
|---|
| 515 | ! |
|---|
| 516 | FUNCTION chem_tropopause(ih,it,it0,pint,o3,pcen,o3trop) |
|---|
| 517 | ! |
|---|
| 518 | !------------------------------------------------------------------------------- |
|---|
| 519 | ! Purpose: Determine the tropopause using chemical criterium, ie the pressure |
|---|
| 520 | ! at which the ozone concentration reaches a certain level. |
|---|
| 521 | !------------------------------------------------------------------------------- |
|---|
| 522 | ! Remarks: |
|---|
| 523 | ! * Input field is upside down (increasing pressure // increasing vertical idx) |
|---|
| 524 | ! The sweep is done from top to ground, starting at the 50hPa layer (idx it0), |
|---|
| 525 | ! where O3 is about 1,5 ppmV, until the first layer where o3<o3t is reached: |
|---|
| 526 | ! the O3 profile in this zone is decreasing with pressure. |
|---|
| 527 | ! * Threshold o3t can be given as an input argument ("o3trop", in ppmV) or |
|---|
| 528 | ! determined using an empirical law roughly derived from ... & al. |
|---|
| 529 | !------------------------------------------------------------------------------- |
|---|
| 530 | ! Arguments: |
|---|
| 531 | REAL :: chem_tropopause !--- Pressure at tropopause |
|---|
| 532 | INTEGER, INTENT(IN) :: ih !--- Horizontal index |
|---|
| 533 | INTEGER, INTENT(OUT) :: it !--- Index of tropopause layer |
|---|
| 534 | INTEGER, INTENT(IN) :: it0 !--- Idx: higher than tropopause |
|---|
| 535 | REAL, INTENT(IN) :: pint(:) !--- Cells-interf Pr, increasing |
|---|
| 536 | REAL, INTENT(IN) :: o3(:,:) !--- Ozone field (pptV) |
|---|
| 537 | REAL, OPTIONAL, INTENT(IN) :: pcen(:) !--- Cells-center Pr, increasing |
|---|
| 538 | REAL, OPTIONAL, INTENT(IN) :: o3trop !--- Ozone at tropopause |
|---|
| 539 | !------------------------------------------------------------------------------- |
|---|
| 540 | ! Local variables: |
|---|
| 541 | REAL :: o3t !--- Ozone concent. at tropopause |
|---|
| 542 | REAL :: al !--- Interpolation coefficient |
|---|
| 543 | REAL :: coef !--- Coeff of latitude modulation |
|---|
| 544 | REAL, PARAMETER :: co3(3)=[91.,28.,20.] !--- Coeff for o3 at tropopause |
|---|
| 545 | !------------------------------------------------------------------------------- |
|---|
| 546 | !--- DETERMINE THE OZONE CONCENTRATION AT TROPOPAUSE IN THE CURRENT COLUMN |
|---|
| 547 | IF(PRESENT(o3trop)) THEN !=== THRESHOLD FROM ARGUMENTS |
|---|
| 548 | o3t=o3trop |
|---|
| 549 | ELSE !=== EMPIRICAL LAW |
|---|
| 550 | coef = TANH(lat_in(ih)/co3(3)) !--- Latitude modulation |
|---|
| 551 | coef = SIN (2.*RPI*(y_frac-1./6.)) * coef !--- Seasonal modulation |
|---|
| 552 | o3t = 1.E-9 * (co3(1)+co3(2)*coef) !--- Value from parametrization |
|---|
| 553 | END IF |
|---|
| 554 | |
|---|
| 555 | !--- FROM 50hPa, GO DOWN UNTIL "it" IS SUCH THAT o3(ih,it)>o3t>o3(ih,it+1) |
|---|
| 556 | it=it0; DO WHILE(o3(ih,it+1)>=o3t); it=it+1; END DO |
|---|
| 557 | al=(o3(ih,it)-o3t)/(o3(ih,it)-o3(ih,it+1)) |
|---|
| 558 | IF(PRESENT(pcen)) THEN |
|---|
| 559 | chem_tropopause = pcen(it)**(1.-al) * pcen(it+1)**al |
|---|
| 560 | ELSE |
|---|
| 561 | chem_tropopause = SQRT( pint(it)**(1.-al) * pint(it+2)**al * pint(it+1) ) |
|---|
| 562 | END IF |
|---|
| 563 | it = locate(pint(:), chem_tropopause) !--- pint(it)<ptrop<pint(it+1) |
|---|
| 564 | |
|---|
| 565 | END FUNCTION chem_tropopause |
|---|
| 566 | ! |
|---|
| 567 | !------------------------------------------------------------------------------- |
|---|
| 568 | |
|---|
| 569 | |
|---|
| 570 | !------------------------------------------------------------------------------- |
|---|
| 571 | ! |
|---|
| 572 | FUNCTION check_ozone(o3col, lon, lat, ilev0, layer, vmin, vmax) |
|---|
| 573 | ! |
|---|
| 574 | !------------------------------------------------------------------------------- |
|---|
| 575 | IMPLICIT NONE |
|---|
| 576 | !------------------------------------------------------------------------------- |
|---|
| 577 | ! Arguments: |
|---|
| 578 | LOGICAL :: check_ozone !--- .T. => some wrong values |
|---|
| 579 | REAL, INTENT(IN) :: o3col(:), lon, lat |
|---|
| 580 | INTEGER, INTENT(IN) :: ilev0 |
|---|
| 581 | CHARACTER(LEN=*), INTENT(IN) :: layer |
|---|
| 582 | REAL, OPTIONAL, INTENT(IN) :: vmin |
|---|
| 583 | REAL, OPTIONAL, INTENT(IN) :: vmax |
|---|
| 584 | !------------------------------------------------------------------------------- |
|---|
| 585 | ! Local variables: |
|---|
| 586 | INTEGER :: k |
|---|
| 587 | LOGICAL :: lmin, lmax |
|---|
| 588 | REAL :: fac |
|---|
| 589 | CHARACTER(LEN=6) :: unt |
|---|
| 590 | !------------------------------------------------------------------------------- |
|---|
| 591 | !--- NOTHING TO DO |
|---|
| 592 | lmin=.FALSE.; IF(PRESENT(vmin)) lmin=COUNT(o3col<vmin)/=0 |
|---|
| 593 | lmax=.FALSE.; IF(PRESENT(vmax)) lmax=COUNT(o3col>vmax)/=0 |
|---|
| 594 | check_ozone=lmin.OR.lmax; IF(.NOT.check_ozone) RETURN |
|---|
| 595 | IF(prt_level<1) RETURN |
|---|
| 596 | |
|---|
| 597 | !--- SOME TOO LOW VALUES FOUND |
|---|
| 598 | IF(lmin) THEN |
|---|
| 599 | CALL unitc(vmin,unt,fac) |
|---|
| 600 | DO k=1,SIZE(o3col); IF(o3col(k)>vmin) CYCLE |
|---|
| 601 | WRITE(*,'(a,2f7.1,i3,a,2(f8.3,a))')'WARNING: inconsistent value in ' & |
|---|
| 602 | //TRIM(layer)//': O3(',lon,lat,k+ilev0-1,')=',fac*o3col(k),unt//' < ', & |
|---|
| 603 | fac*vmin,unt//' in '//TRIM(layer) |
|---|
| 604 | END DO |
|---|
| 605 | END IF |
|---|
| 606 | |
|---|
| 607 | !--- SOME TOO HIGH VALUES FOUND |
|---|
| 608 | IF(lmax) THEN |
|---|
| 609 | CALL unitc(vmax,unt,fac) |
|---|
| 610 | DO k=1,SIZE(o3col); IF(o3col(k)<vmax) CYCLE |
|---|
| 611 | WRITE(*,'(a,2f7.1,i3,a,2(f8.3,a))')'WARNING: inconsistent value in ' & |
|---|
| 612 | //TRIM(layer)//': O3(',lon,lat,k+ilev0-1,')=',fac*o3col(k),unt//' > ', & |
|---|
| 613 | fac*vmax,unt//' in '//TRIM(layer) |
|---|
| 614 | END DO |
|---|
| 615 | END IF |
|---|
| 616 | |
|---|
| 617 | END FUNCTION check_ozone |
|---|
| 618 | ! |
|---|
| 619 | !------------------------------------------------------------------------------- |
|---|
| 620 | |
|---|
| 621 | |
|---|
| 622 | !------------------------------------------------------------------------------- |
|---|
| 623 | ! |
|---|
| 624 | SUBROUTINE unitc(val,unt,fac) |
|---|
| 625 | ! |
|---|
| 626 | !------------------------------------------------------------------------------- |
|---|
| 627 | IMPLICIT NONE |
|---|
| 628 | !------------------------------------------------------------------------------- |
|---|
| 629 | ! Arguments: |
|---|
| 630 | REAL, INTENT(IN) :: val |
|---|
| 631 | CHARACTER(LEN=6), INTENT(OUT) :: unt |
|---|
| 632 | REAL, INTENT(OUT) :: fac |
|---|
| 633 | !------------------------------------------------------------------------------- |
|---|
| 634 | ! Local variables: |
|---|
| 635 | INTEGER :: ndgt |
|---|
| 636 | !------------------------------------------------------------------------------- |
|---|
| 637 | ndgt=3*FLOOR(LOG10(val)/3.) |
|---|
| 638 | SELECT CASE(ndgt) |
|---|
| 639 | CASE(-6); unt=' ppmV '; fac=1.E6 |
|---|
| 640 | CASE(-9); unt=' ppbV '; fac=1.E9 |
|---|
| 641 | CASE DEFAULT; unt=' vmr '; fac=1.0 |
|---|
| 642 | END SELECT |
|---|
| 643 | |
|---|
| 644 | END SUBROUTINE unitc |
|---|
| 645 | ! |
|---|
| 646 | !------------------------------------------------------------------------------- |
|---|
| 647 | |
|---|
| 648 | |
|---|
| 649 | !------------------------------------------------------------------------------- |
|---|
| 650 | ! |
|---|
| 651 | SUBROUTINE msg(ll,str,sub) |
|---|
| 652 | ! |
|---|
| 653 | !------------------------------------------------------------------------------- |
|---|
| 654 | USE print_control_mod, ONLY: lunout |
|---|
| 655 | IMPLICIT NONE |
|---|
| 656 | !------------------------------------------------------------------------------- |
|---|
| 657 | ! Arguments: |
|---|
| 658 | LOGICAL, INTENT(IN) :: ll |
|---|
| 659 | CHARACTER(LEN=*), INTENT(IN) :: str |
|---|
| 660 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub |
|---|
| 661 | !------------------------------------------------------------------------------- |
|---|
| 662 | IF(.NOT.ll) RETURN |
|---|
| 663 | IF(PRESENT(sub)) THEN |
|---|
| 664 | WRITE(lunout,*)TRIM(sub)//': '//TRIM(str) |
|---|
| 665 | ELSE |
|---|
| 666 | WRITE(lunout,*)TRIM(str) |
|---|
| 667 | END IF |
|---|
| 668 | |
|---|
| 669 | END SUBROUTINE msg |
|---|
| 670 | ! |
|---|
| 671 | !------------------------------------------------------------------------------- |
|---|
| 672 | |
|---|
| 673 | END SUBROUTINE regr_pr_time_av |
|---|
| 674 | ! |
|---|
| 675 | !------------------------------------------------------------------------------- |
|---|
| 676 | |
|---|
| 677 | END MODULE regr_pr_time_av_m |
|---|
