| 1 | ! |
|---|
| 2 | ! $Id: get_bulk.F,v 1.1 2004/11/09 08:19:03 pmarches Exp $ |
|---|
| 3 | ! |
|---|
| 4 | #include "cppdefs.h" |
|---|
| 5 | #if defined BULK_FLUX |
|---|
| 6 | |
|---|
| 7 | subroutine get_bulk |
|---|
| 8 | ! |
|---|
| 9 | ! Read in wind speed and surface air temperature |
|---|
| 10 | ! |
|---|
| 11 | ! |
|---|
| 12 | # define BULK_DATA |
|---|
| 13 | # ifdef BULK_WSTR |
|---|
| 14 | # define SMFLUX_DATA |
|---|
| 15 | # endif |
|---|
| 16 | implicit none |
|---|
| 17 | # include "param.h" |
|---|
| 18 | # include "forces.h" |
|---|
| 19 | # include "scalars.h" |
|---|
| 20 | # include "netcdf.inc" |
|---|
| 21 | # include "ncscrum.h" |
|---|
| 22 | real cff |
|---|
| 23 | integer i,ierr, lstr,lvar,lenstr, nf_fread, advance_cycle |
|---|
| 24 | ! |
|---|
| 25 | ! Initialization: Inquire about the contents of forcing NetCDF file: |
|---|
| 26 | !================ variables and dimensions. Check for consistency. |
|---|
| 27 | ! |
|---|
| 28 | if (may_day_flag.ne.0) return !--> EXIT |
|---|
| 29 | if (itbulk.eq.0 .or. iic.eq.0) then |
|---|
| 30 | lstr=lenstr(bulkname) |
|---|
| 31 | c* call opencdf (bulkname,N) |
|---|
| 32 | c* if (may_day_flag.ne.0) return !--> EXIT |
|---|
| 33 | ! |
|---|
| 34 | ! If not opened yet, open forcing NetCDF file for reading. |
|---|
| 35 | ! Find and save IDs for relevant variables, determine whether |
|---|
| 36 | ! SST is a field or scalar value. |
|---|
| 37 | ! |
|---|
| 38 | if (ncidbulk.eq.-1) then |
|---|
| 39 | ierr=nf_open(bulkname(1:lstr), nf_nowrite, ncidbulk) |
|---|
| 40 | if (ierr. ne. nf_noerr) goto 4 !--> ERROR |
|---|
| 41 | endif |
|---|
| 42 | |
|---|
| 43 | ierr=nf_inq_varid (ncidbulk, 'bulk_time', bulk_tid) |
|---|
| 44 | if (ierr .ne. nf_noerr) then |
|---|
| 45 | write(stdout,3) 'bulk_time', bulkname(1:lstr) |
|---|
| 46 | goto 99 !--> ERROR |
|---|
| 47 | endif |
|---|
| 48 | |
|---|
| 49 | # ifndef BULK_WVEC |
|---|
| 50 | lvar=lenstr(vname(1,indxWSPD)) |
|---|
| 51 | ierr=nf_inq_varid (ncidbulk, vname(1,indxWSPD)(1:lvar), wspd_id) |
|---|
| 52 | if (ierr .eq. nf_noerr) then |
|---|
| 53 | ierr=nf_inq_varndims (ncidbulk, wspd_id, i) |
|---|
| 54 | if (ierr. eq. nf_noerr) then |
|---|
| 55 | if (i.gt.1) then |
|---|
| 56 | lwspdgrd=1 |
|---|
| 57 | else |
|---|
| 58 | lwspdgrd=0 |
|---|
| 59 | endif |
|---|
| 60 | endif |
|---|
| 61 | endif |
|---|
| 62 | if (ierr .ne. nf_noerr) then |
|---|
| 63 | write(stdout,3) vname(1,indxWSPD)(1:lvar), bulkname(1:lstr) |
|---|
| 64 | goto 99 !--> ERROR |
|---|
| 65 | endif |
|---|
| 66 | # endif |
|---|
| 67 | |
|---|
| 68 | lvar=lenstr(vname(1,indxTAIR)) |
|---|
| 69 | ierr=nf_inq_varid (ncidbulk, vname(1,indxTAIR)(1:lvar),tair_id) |
|---|
| 70 | if (ierr .eq. nf_noerr) then |
|---|
| 71 | ierr=nf_inq_varndims (ncidbulk, tair_id, i) |
|---|
| 72 | if (ierr. eq. nf_noerr) then |
|---|
| 73 | if (i.gt.1) then |
|---|
| 74 | ltairgrd=1 |
|---|
| 75 | else |
|---|
| 76 | ltairgrd=0 |
|---|
| 77 | endif |
|---|
| 78 | endif |
|---|
| 79 | endif |
|---|
| 80 | if (ierr .ne. nf_noerr) then |
|---|
| 81 | write(stdout,3) vname(1,indxTAIR)(1:lvar),bulkname(1:lstr) |
|---|
| 82 | goto 99 !--> ERROR |
|---|
| 83 | endif |
|---|
| 84 | |
|---|
| 85 | lvar=lenstr(vname(1,indxRHUM)) |
|---|
| 86 | ierr=nf_inq_varid (ncidbulk, vname(1,indxRHUM)(1:lvar),rhum_id) |
|---|
| 87 | if (ierr .eq. nf_noerr) then |
|---|
| 88 | ierr=nf_inq_varndims (ncidbulk, rhum_id, i) |
|---|
| 89 | if (ierr. eq. nf_noerr) then |
|---|
| 90 | if (i.gt.1) then |
|---|
| 91 | lrhumgrd=1 |
|---|
| 92 | else |
|---|
| 93 | lrhumgrd=0 |
|---|
| 94 | endif |
|---|
| 95 | endif |
|---|
| 96 | endif |
|---|
| 97 | if (ierr .ne. nf_noerr) then |
|---|
| 98 | write(stdout,3) vname(1,indxRHUM)(1:lvar),bulkname(1:lstr) |
|---|
| 99 | goto 99 !--> ERROR |
|---|
| 100 | endif |
|---|
| 101 | |
|---|
| 102 | lvar=lenstr(vname(1,indxRADLW)) |
|---|
| 103 | ierr=nf_inq_varid (ncidbulk,vname(1,indxRADLW)(1:lvar),radlw_id) |
|---|
| 104 | if (ierr .eq. nf_noerr) then |
|---|
| 105 | ierr=nf_inq_varndims (ncidbulk, radlw_id, i) |
|---|
| 106 | if (ierr. eq. nf_noerr) then |
|---|
| 107 | if (i.gt.1) then |
|---|
| 108 | lradlwgrd=1 |
|---|
| 109 | else |
|---|
| 110 | lradlwgrd=0 |
|---|
| 111 | endif |
|---|
| 112 | endif |
|---|
| 113 | endif |
|---|
| 114 | if (ierr .ne. nf_noerr) then |
|---|
| 115 | write(stdout,3) vname(1,indxRADLW)(1:lvar),bulkname(1:lstr) |
|---|
| 116 | goto 99 !--> ERROR |
|---|
| 117 | endif |
|---|
| 118 | |
|---|
| 119 | lvar=lenstr(vname(1,indxRADSW)) |
|---|
| 120 | ierr=nf_inq_varid (ncidbulk,vname(1,indxRADSW)(1:lvar),radsw_id) |
|---|
| 121 | if (ierr .eq. nf_noerr) then |
|---|
| 122 | ierr=nf_inq_varndims (ncidbulk, radsw_id, i) |
|---|
| 123 | if (ierr. eq. nf_noerr) then |
|---|
| 124 | if (i.gt.1) then |
|---|
| 125 | lradswgrd=1 |
|---|
| 126 | else |
|---|
| 127 | lradswgrd=0 |
|---|
| 128 | endif |
|---|
| 129 | endif |
|---|
| 130 | endif |
|---|
| 131 | if (ierr .ne. nf_noerr) then |
|---|
| 132 | write(stdout,3) vname(1,indxRADSW)(1:lvar),bulkname(1:lstr) |
|---|
| 133 | goto 99 !--> ERROR |
|---|
| 134 | endif |
|---|
| 135 | |
|---|
| 136 | # ifdef BULK_EP |
|---|
| 137 | lvar=lenstr(vname(1,indxPRATE)) |
|---|
| 138 | ierr=nf_inq_varid (ncidbulk,vname(1,indxPRATE)(1:lvar),prate_id) |
|---|
| 139 | if (ierr .eq. nf_noerr) then |
|---|
| 140 | ierr=nf_inq_varndims (ncidbulk, prate_id, i) |
|---|
| 141 | if (ierr. eq. nf_noerr) then |
|---|
| 142 | if (i.gt.1) then |
|---|
| 143 | lprategrd=1 |
|---|
| 144 | else |
|---|
| 145 | lprategrd=0 |
|---|
| 146 | endif |
|---|
| 147 | endif |
|---|
| 148 | endif |
|---|
| 149 | if (ierr .ne. nf_noerr) then |
|---|
| 150 | write(stdout,3) vname(1,indxPRATE)(1:lvar),bulkname(1:lstr) |
|---|
| 151 | goto 99 !--> ERROR |
|---|
| 152 | endif |
|---|
| 153 | # endif /* BULK_EP */ |
|---|
| 154 | |
|---|
| 155 | # ifdef BULK_WVEC |
|---|
| 156 | lvar=lenstr(vname(1,indxUWND)) |
|---|
| 157 | ierr=nf_inq_varid (ncidbulk,vname(1,indxUWND)(1:lvar),uwnd_id) |
|---|
| 158 | if (ierr .eq. nf_noerr) then |
|---|
| 159 | ierr=nf_inq_varndims (ncidbulk, uwnd_id, i) |
|---|
| 160 | if (ierr. eq. nf_noerr) then |
|---|
| 161 | if (i.gt.1) then |
|---|
| 162 | luwndgrd=1 |
|---|
| 163 | else |
|---|
| 164 | luwndgrd=0 |
|---|
| 165 | endif |
|---|
| 166 | endif |
|---|
| 167 | endif |
|---|
| 168 | if (ierr .ne. nf_noerr) then |
|---|
| 169 | write(stdout,3) vname(1,indxUWND)(1:lvar),bulkname(1:lstr) |
|---|
| 170 | goto 99 !--> ERROR |
|---|
| 171 | endif |
|---|
| 172 | |
|---|
| 173 | lvar=lenstr(vname(1,indxVWND)) |
|---|
| 174 | ierr=nf_inq_varid (ncidbulk,vname(1,indxVWND)(1:lvar),vwnd_id) |
|---|
| 175 | if (ierr .eq. nf_noerr) then |
|---|
| 176 | ierr=nf_inq_varndims (ncidbulk, vwnd_id, i) |
|---|
| 177 | if (ierr. eq. nf_noerr) then |
|---|
| 178 | if (i.gt.1) then |
|---|
| 179 | lvwndgrd=1 |
|---|
| 180 | else |
|---|
| 181 | lvwndgrd=0 |
|---|
| 182 | endif |
|---|
| 183 | endif |
|---|
| 184 | endif |
|---|
| 185 | if (ierr .ne. nf_noerr) then |
|---|
| 186 | write(stdout,3) vname(1,indxVWND)(1:lvar),bulkname(1:lstr) |
|---|
| 187 | goto 99 !--> ERROR |
|---|
| 188 | endif |
|---|
| 189 | |
|---|
| 190 | # elif defined BULK_WSTR |
|---|
| 191 | lvar=lenstr(vname(1,indxSUSTR)) |
|---|
| 192 | ierr=nf_inq_varid (ncidbulk,vname(1,indxSUSTR)(1:lvar),susid) |
|---|
| 193 | if (ierr .eq. nf_noerr) then |
|---|
| 194 | ierr=nf_inq_varndims (ncidbulk, susid, i) |
|---|
| 195 | if (ierr. eq. nf_noerr) then |
|---|
| 196 | if (i.gt.1) then |
|---|
| 197 | lsusgrd=1 |
|---|
| 198 | else |
|---|
| 199 | lsusgrd=0 |
|---|
| 200 | endif |
|---|
| 201 | endif |
|---|
| 202 | endif |
|---|
| 203 | if (ierr .ne. nf_noerr) then |
|---|
| 204 | write(stdout,3) vname(1,indxSUSTR)(1:lvar),bulkname(1:lstr) |
|---|
| 205 | goto 99 !--> ERROR |
|---|
| 206 | endif |
|---|
| 207 | |
|---|
| 208 | lvar=lenstr(vname(1,indxSVSTR)) |
|---|
| 209 | ierr=nf_inq_varid (ncidbulk,vname(1,indxSVSTR)(1:lvar),svsid) |
|---|
| 210 | if (ierr .eq. nf_noerr) then |
|---|
| 211 | ierr=nf_inq_varndims (ncidbulk, svsid, i) |
|---|
| 212 | if (ierr. eq. nf_noerr) then |
|---|
| 213 | if (i.gt.1) then |
|---|
| 214 | lsvsgrd=1 |
|---|
| 215 | else |
|---|
| 216 | lsvsgrd=0 |
|---|
| 217 | endif |
|---|
| 218 | endif |
|---|
| 219 | endif |
|---|
| 220 | if (ierr .ne. nf_noerr) then |
|---|
| 221 | write(stdout,3) vname(1,indxSVSTR)(1:lvar),bulkname(1:lstr) |
|---|
| 222 | goto 99 !--> ERROR |
|---|
| 223 | endif |
|---|
| 224 | # endif /* BULK_WVEC || BULK_WSTR */ |
|---|
| 225 | |
|---|
| 226 | ! |
|---|
| 227 | ! Determine whether there is cycling to reuse the input data and |
|---|
| 228 | ! find cycling period "bulk_cycle", set initial cycling index |
|---|
| 229 | ! "wspd_ncycle" and record index "wspd_rec". |
|---|
| 230 | ! Set initial value for time index "itbulk" and both time record |
|---|
| 231 | ! bounds to large negative artificial values, so that it will |
|---|
| 232 | ! trigger the logic in reading part below. |
|---|
| 233 | ! Also set scale factor to convert input dQdSST from Watts/m2/Celsius |
|---|
| 234 | ! to meter/second. |
|---|
| 235 | ! |
|---|
| 236 | call set_cycle (ncidbulk, bulk_tid, ntbulk, |
|---|
| 237 | & bulk_cycle, bulk_ncycle, bulk_rec) |
|---|
| 238 | if (may_day_flag.ne.0) return !--> EXIT |
|---|
| 239 | itbulk=2 |
|---|
| 240 | bulk_time(1)=-1.E+20 |
|---|
| 241 | bulk_time(2)=-1.E+20 |
|---|
| 242 | srf_scale=1./(rho0*Cp) |
|---|
| 243 | # ifdef BULK_EP |
|---|
| 244 | stf_scale(isalt)=0.01/86400. |
|---|
| 245 | # endif |
|---|
| 246 | # ifdef BULK_WSTR |
|---|
| 247 | sms_scale=1./rho0 |
|---|
| 248 | # endif |
|---|
| 249 | endif |
|---|
| 250 | ! |
|---|
| 251 | ! Reading data from the forcing file: Get out, if model time is |
|---|
| 252 | !======== ==== ==== === ======= ===== already within the interval |
|---|
| 253 | ! set by the past and future data times. Otherwise flip the time |
|---|
| 254 | ! index, increment record and cyclin indices and read a new portion |
|---|
| 255 | ! of data. Repeat it until model time is between the two times from |
|---|
| 256 | ! data. |
|---|
| 257 | ! |
|---|
| 258 | 1 i=3-itbulk |
|---|
| 259 | cff=time+0.5*dt |
|---|
| 260 | if (bulk_time(i).le.cff .and. cff.lt.bulk_time(itbulk)) |
|---|
| 261 | & return |
|---|
| 262 | ierr=advance_cycle (bulk_cycle,ntbulk,bulk_ncycle,bulk_rec) |
|---|
| 263 | if (ierr .ne. 0) goto 7 !--> ERROR |
|---|
| 264 | |
|---|
| 265 | ierr=nf_get_var1_FTYPE (ncidbulk, bulk_tid, bulk_rec, cff) |
|---|
| 266 | if (ierr .ne. nf_noerr) then |
|---|
| 267 | write(stdout,6) 'bulk_time', bulk_rec |
|---|
| 268 | goto 99 !--> ERROR |
|---|
| 269 | endif |
|---|
| 270 | bulk_time(i)=cff*day2sec+bulk_cycle*bulk_ncycle |
|---|
| 271 | if (bulk_time(itbulk).eq.-1.E+20) |
|---|
| 272 | & bulk_time(itbulk)=bulk_time(i) |
|---|
| 273 | # ifndef BULK_WVEC |
|---|
| 274 | ! |
|---|
| 275 | ! wspd |
|---|
| 276 | ! |
|---|
| 277 | if (lwspdgrd.eq.1) then |
|---|
| 278 | ierr=nf_fread (wspdg(START_2D_ARRAY,i), ncidbulk, wspd_id, |
|---|
| 279 | & bulk_rec, r2dvar) |
|---|
| 280 | else |
|---|
| 281 | ierr=nf_get_var1_FTYPE (ncidbulk, wspd_id, bulk_rec, wspdp(i)) |
|---|
| 282 | endif |
|---|
| 283 | if (ierr .ne. nf_noerr) then |
|---|
| 284 | write(stdout,6) 'WSPD', bulk_rec |
|---|
| 285 | goto 99 !--> ERROR |
|---|
| 286 | endif |
|---|
| 287 | # endif |
|---|
| 288 | ! |
|---|
| 289 | ! tair |
|---|
| 290 | ! |
|---|
| 291 | if (ltairgrd.eq.1) then |
|---|
| 292 | ierr=nf_fread (tairg(START_2D_ARRAY,i), ncidbulk, tair_id, |
|---|
| 293 | & bulk_rec, r2dvar) |
|---|
| 294 | else |
|---|
| 295 | ierr=nf_get_var1_FTYPE (ncidbulk,tair_id,bulk_rec,tairp(i)) |
|---|
| 296 | endif |
|---|
| 297 | if (ierr .ne. nf_noerr) then |
|---|
| 298 | write(stdout,6) 'TAIR', bulk_rec |
|---|
| 299 | goto 99 !--> ERROR |
|---|
| 300 | endif |
|---|
| 301 | ! |
|---|
| 302 | ! rhum |
|---|
| 303 | ! |
|---|
| 304 | if (lrhumgrd.eq.1) then |
|---|
| 305 | ierr=nf_fread (rhumg(START_2D_ARRAY,i), ncidbulk, rhum_id, |
|---|
| 306 | & bulk_rec, r2dvar) |
|---|
| 307 | else |
|---|
| 308 | ierr=nf_get_var1_FTYPE (ncidbulk,rhum_id,bulk_rec,rhump(i)) |
|---|
| 309 | endif |
|---|
| 310 | if (ierr .ne. nf_noerr) then |
|---|
| 311 | write(stdout,6) 'RHUM', bulk_rec |
|---|
| 312 | goto 99 !--> ERROR |
|---|
| 313 | endif |
|---|
| 314 | ! |
|---|
| 315 | ! radlw |
|---|
| 316 | ! |
|---|
| 317 | if (lradlwgrd.eq.1) then |
|---|
| 318 | ierr=nf_fread (radlwg(START_2D_ARRAY,i), ncidbulk, radlw_id, |
|---|
| 319 | & bulk_rec, r2dvar) |
|---|
| 320 | else |
|---|
| 321 | ierr=nf_get_var1_FTYPE (ncidbulk,radlw_id,bulk_rec,radlwp(i)) |
|---|
| 322 | endif |
|---|
| 323 | if (ierr .ne. nf_noerr) then |
|---|
| 324 | write(stdout,6) 'RADLW', bulk_rec |
|---|
| 325 | goto 99 !--> ERROR |
|---|
| 326 | endif |
|---|
| 327 | ! |
|---|
| 328 | ! radsw |
|---|
| 329 | ! |
|---|
| 330 | if (lradswgrd.eq.1) then |
|---|
| 331 | ierr=nf_fread (radswg(START_2D_ARRAY,i), ncidbulk, radsw_id, |
|---|
| 332 | & bulk_rec, r2dvar) |
|---|
| 333 | else |
|---|
| 334 | ierr=nf_get_var1_FTYPE (ncidbulk,radsw_id,bulk_rec,radswp(i)) |
|---|
| 335 | endif |
|---|
| 336 | if (ierr .ne. nf_noerr) then |
|---|
| 337 | write(stdout,6) 'RADSW', bulk_rec |
|---|
| 338 | goto 99 !--> ERROR |
|---|
| 339 | endif |
|---|
| 340 | ! |
|---|
| 341 | ! prate |
|---|
| 342 | ! |
|---|
| 343 | # ifdef BULK_EP |
|---|
| 344 | if (lprategrd.eq.1) then |
|---|
| 345 | ierr=nf_fread (prateg(START_2D_ARRAY,i), ncidbulk, prate_id, |
|---|
| 346 | & bulk_rec, r2dvar) |
|---|
| 347 | else |
|---|
| 348 | ierr=nf_get_var1_FTYPE (ncidbulk,prate_id,bulk_rec,pratep(i)) |
|---|
| 349 | endif |
|---|
| 350 | if (ierr .ne. nf_noerr) then |
|---|
| 351 | write(stdout,6) 'PRATE', bulk_rec |
|---|
| 352 | goto 99 !--> ERROR |
|---|
| 353 | endif |
|---|
| 354 | # endif |
|---|
| 355 | # ifdef BULK_WVEC |
|---|
| 356 | ! |
|---|
| 357 | ! uwnd |
|---|
| 358 | ! |
|---|
| 359 | if (luwndgrd.eq.1) then |
|---|
| 360 | ierr=nf_fread(uwndg(START_2D_ARRAY,i), ncidbulk, uwnd_id, |
|---|
| 361 | & bulk_rec, u2dvar) |
|---|
| 362 | else |
|---|
| 363 | ierr=nf_get_var1_FTYPE(ncidbulk,uwnd_id,bulk_rec,sustrp(i)) |
|---|
| 364 | endif |
|---|
| 365 | if (ierr .ne. nf_noerr) then |
|---|
| 366 | write(stdout,6) 'uwnd', bulk_rec |
|---|
| 367 | goto 99 !--> ERROR |
|---|
| 368 | endif |
|---|
| 369 | ! |
|---|
| 370 | ! vwnd |
|---|
| 371 | ! |
|---|
| 372 | if (lvwndgrd.eq.1) then |
|---|
| 373 | ierr=nf_fread(vwndg(START_2D_ARRAY,i), ncidbulk, vwnd_id, |
|---|
| 374 | & bulk_rec, v2dvar) |
|---|
| 375 | else |
|---|
| 376 | ierr=nf_get_var1_FTYPE(ncidbulk,vwnd_id,bulk_rec,vwndp(i)) |
|---|
| 377 | endif |
|---|
| 378 | if (ierr .ne. nf_noerr) then |
|---|
| 379 | write(stdout,6) 'vwnd', bulk_rec |
|---|
| 380 | goto 99 !--> ERROR |
|---|
| 381 | endif |
|---|
| 382 | # elif defined BULK_WSTR |
|---|
| 383 | ! |
|---|
| 384 | ! sustr |
|---|
| 385 | ! |
|---|
| 386 | if (lsusgrd.eq.1) then |
|---|
| 387 | ierr=nf_fread(sustrg(START_2D_ARRAY,i), ncidbulk, susid, |
|---|
| 388 | & bulk_rec, u2dvar) |
|---|
| 389 | else |
|---|
| 390 | ierr=nf_get_var1_FTYPE(ncidbulk,susid,bulk_rec,sustrp(i)) |
|---|
| 391 | endif |
|---|
| 392 | if (ierr .ne. nf_noerr) then |
|---|
| 393 | write(stdout,6) 'sustr', bulk_rec |
|---|
| 394 | goto 99 !--> ERROR |
|---|
| 395 | endif |
|---|
| 396 | ! |
|---|
| 397 | ! svstr |
|---|
| 398 | ! |
|---|
| 399 | if (lsvsgrd.eq.1) then |
|---|
| 400 | ierr=nf_fread(svstrg(START_2D_ARRAY,i), ncidbulk, svsid, |
|---|
| 401 | & bulk_rec, v2dvar) |
|---|
| 402 | else |
|---|
| 403 | ierr=nf_get_var1_FTYPE(ncidbulk,svsid,bulk_rec,svstrp(i)) |
|---|
| 404 | endif |
|---|
| 405 | if (ierr .ne. nf_noerr) then |
|---|
| 406 | write(stdout,6) 'svstr', bulk_rec |
|---|
| 407 | goto 99 !--> ERROR |
|---|
| 408 | endif |
|---|
| 409 | # endif /* BULK_WVEC || BULK_WSTR */ |
|---|
| 410 | |
|---|
| 411 | itbulk=i |
|---|
| 412 | write(stdout,'(6x,A,1x,A,1x,g12.4,1x,I4)') 'GET_BULK --', |
|---|
| 413 | & 'Read fields for bulk formula for time =', cff |
|---|
| 414 | # ifdef MPI |
|---|
| 415 | & , mynode |
|---|
| 416 | # endif |
|---|
| 417 | if (ntbulk.gt.1) goto 1 |
|---|
| 418 | if (ntbulk.eq.1) return |
|---|
| 419 | ! |
|---|
| 420 | ! Sort out error messages: The following portion of the code is |
|---|
| 421 | !===== === ===== ========= not accessed unless something goes wrong. |
|---|
| 422 | ! |
|---|
| 423 | 3 format(/,' GET_BULK - ERROR: unable to find forcing variable', |
|---|
| 424 | & ': ',a,/,11x,'in forcing NetCDF file: ',a) |
|---|
| 425 | 4 write(stdout,5) bulkname(1:lstr) |
|---|
| 426 | 5 format(/,' GET_BULK - ERROR: unable to open forcing NetCDF ', |
|---|
| 427 | & 'file: ',a) |
|---|
| 428 | goto 99 |
|---|
| 429 | 6 format(/,' GET_BULK - ERROR while reading variable: ',a,2x, |
|---|
| 430 | & ' at TIME index = ',i4) |
|---|
| 431 | 7 write(stdout,8) bulk_rec, ntbulk, bulkname(1:lstr), tdays, |
|---|
| 432 | & bulk_time(itbulk)*sec2day |
|---|
| 433 | 8 format(/,' GET_BULK - ERROR: requested time record ',I4, |
|---|
| 434 | & 1x,'exeeds the last available', /, 11x,'record ',I4, |
|---|
| 435 | & 1x,'in forcing NetCDF file: ', a, /, 11x,'TDAYS = ', |
|---|
| 436 | & g12.4,2x,'last available BULK_TIME = ',g12.4) |
|---|
| 437 | 99 may_day_flag=2 |
|---|
| 438 | return |
|---|
| 439 | end |
|---|
| 440 | |
|---|
| 441 | |
|---|
| 442 | subroutine set_bulk_tile (Istr,Iend,Jstr,Jend) |
|---|
| 443 | ! |
|---|
| 444 | ! Set-up bulk data for current tile. |
|---|
| 445 | ! |
|---|
| 446 | # define BULK_DATA |
|---|
| 447 | # ifdef BULK_WSTR |
|---|
| 448 | # define SMFLUX_DATA |
|---|
| 449 | # endif |
|---|
| 450 | implicit none |
|---|
| 451 | # include "param.h" |
|---|
| 452 | # include "forces.h" |
|---|
| 453 | # include "scalars.h" |
|---|
| 454 | # include "grid.h" |
|---|
| 455 | integer Istr,Iend,Jstr,Jend, i,j, it1,it2 |
|---|
| 456 | real cff,cff1,cff2, cff3,cff4 |
|---|
| 457 | # ifdef BULK_EP |
|---|
| 458 | real cff5,cff6 |
|---|
| 459 | # endif |
|---|
| 460 | # if defined BULK_WVEC || defined BULK_WSTR |
|---|
| 461 | real cff7,cff8 |
|---|
| 462 | # endif |
|---|
| 463 | real val1,val2,val3,val4,val5,val6,val7,val8 |
|---|
| 464 | ! |
|---|
| 465 | # include "compute_extended_bounds.h" |
|---|
| 466 | ! |
|---|
| 467 | it1=3-itbulk |
|---|
| 468 | it2=itbulk |
|---|
| 469 | cff=time+0.5*dt |
|---|
| 470 | cff1=bulk_time(it2)-cff |
|---|
| 471 | cff2=cff-bulk_time(it1) |
|---|
| 472 | ! |
|---|
| 473 | ! Load time invariant |
|---|
| 474 | ! |
|---|
| 475 | if (bulk_cycle.lt.0.) then |
|---|
| 476 | if (FIRST_TIME_STEP) then |
|---|
| 477 | if (ltairgrd.eq.1) then |
|---|
| 478 | do j=JstrR,JendR |
|---|
| 479 | do i=IstrR,IendR |
|---|
| 480 | # ifndef BULK_WVEC |
|---|
| 481 | wspd(i,j)=wspdg(i,j,itbulk) |
|---|
| 482 | # endif |
|---|
| 483 | tair(i,j)=tairg(i,j,itbulk) |
|---|
| 484 | rhum(i,j)=rhumg(i,j,itbulk) |
|---|
| 485 | radlw(i,j)=srf_scale*radlwg(i,j,itbulk) |
|---|
| 486 | radsw(i,j)=srf_scale*radswg(i,j,itbulk) |
|---|
| 487 | srflx(i,j)=radsw(i,j) |
|---|
| 488 | # ifdef BULK_EP |
|---|
| 489 | prate(i,j)=stf_scale(isalt)*prateg(i,j,itbulk) |
|---|
| 490 | # endif |
|---|
| 491 | # ifdef BULK_WVEC |
|---|
| 492 | uwnd(i,j)=uwndg(i,j,itbulk) |
|---|
| 493 | vwnd(i,j)=vwndg(i,j,itbulk) |
|---|
| 494 | # elif defined BULK_WSTR |
|---|
| 495 | sustr(i,j)=sms_scale*sustrg(i,j,itbulk) |
|---|
| 496 | svstr(i,j)=sms_scale*svstrg(i,j,itbulk) |
|---|
| 497 | # endif |
|---|
| 498 | enddo |
|---|
| 499 | enddo |
|---|
| 500 | else |
|---|
| 501 | # ifndef BULK_WVEC |
|---|
| 502 | val1=wspdp(itbulk) |
|---|
| 503 | # endif |
|---|
| 504 | val2=tairp(itbulk) |
|---|
| 505 | val3=rhump(itbulk) |
|---|
| 506 | val4=srf_scale*radlwp(itbulk) |
|---|
| 507 | val5=srf_scale*radswp(itbulk) |
|---|
| 508 | # ifdef BULK_EP |
|---|
| 509 | val6=stf_scale(isalt)*pratep(itbulk) |
|---|
| 510 | # endif |
|---|
| 511 | # ifdef BULK_WVEC |
|---|
| 512 | val7=uwndp(itbulk) |
|---|
| 513 | val8=vwndp(itbulk) |
|---|
| 514 | # elif defined BULK_WSTR |
|---|
| 515 | val7=sms_scale*sustrp(itbulk) |
|---|
| 516 | val8=sms_scale*svstrp(itbulk) |
|---|
| 517 | # endif |
|---|
| 518 | do j=JstrR,JendR |
|---|
| 519 | do i=IstrR,IendR |
|---|
| 520 | # ifndef BULK_WVEC |
|---|
| 521 | wspd(i,j)=val1 |
|---|
| 522 | # endif |
|---|
| 523 | tair(i,j)=val2 |
|---|
| 524 | rhum(i,j)=val3 |
|---|
| 525 | radlw(i,j)=val4 |
|---|
| 526 | radsw(i,j)=val5 |
|---|
| 527 | srflx(i,j)=val5 |
|---|
| 528 | # ifdef BULK_EP |
|---|
| 529 | prate(i,j)=val6 |
|---|
| 530 | # endif |
|---|
| 531 | # if defined BULK_WVEC || defined BULK_WSTR |
|---|
| 532 | # ifdef CURVGRID |
|---|
| 533 | cff=0.5*(angler(i,j)+angler(i-1,j)) |
|---|
| 534 | cff7=val7*cos(cff)+val8*sin(cff) |
|---|
| 535 | # else |
|---|
| 536 | cff7=val7 |
|---|
| 537 | # endif |
|---|
| 538 | # ifdef BULK_WVEC |
|---|
| 539 | uwnd(i,j)=cff7 |
|---|
| 540 | # else |
|---|
| 541 | sustr(i,j)=cff7 |
|---|
| 542 | # endif |
|---|
| 543 | # ifdef CURVGRID |
|---|
| 544 | cff=0.5*(angler(i,j)+angler(i,j-1)) |
|---|
| 545 | cff8=-val7*sin(cff)+val8*cos(cff) |
|---|
| 546 | # else |
|---|
| 547 | cff8=vstress |
|---|
| 548 | # endif |
|---|
| 549 | # ifdef BULK_WVEC |
|---|
| 550 | vwnd(i,j)=cff8 |
|---|
| 551 | # else |
|---|
| 552 | svstr(i,j)=cff8 |
|---|
| 553 | # endif |
|---|
| 554 | # endif /* BULK_WVEC || BULK_WSTR */ |
|---|
| 555 | enddo |
|---|
| 556 | enddo |
|---|
| 557 | endif |
|---|
| 558 | endif |
|---|
| 559 | ! |
|---|
| 560 | ! Time-interpolate SST and dQdSST from grided or point data. |
|---|
| 561 | ! Check that for the next time step [when time=time+dt] time+dt |
|---|
| 562 | ! is still between wspd_time(it1) and wspd_time(it2); and if not, |
|---|
| 563 | ! set synchro_flag top signal that the new forcing data should be |
|---|
| 564 | ! read from the netCDF input file (master thread only). |
|---|
| 565 | ! |
|---|
| 566 | elseif (cff1.ge.0. .and. cff2.ge.0.) then |
|---|
| 567 | if (ZEROTH_TILE .and. cff1.lt.dt) synchro_flag=.TRUE. |
|---|
| 568 | !note cff order maters |
|---|
| 569 | cff=srf_scale/(cff1+cff2) |
|---|
| 570 | cff3=cff1*cff |
|---|
| 571 | cff4=cff2*cff |
|---|
| 572 | # ifdef BULK_EP |
|---|
| 573 | cff=stf_scale(isalt)/(cff1+cff2) |
|---|
| 574 | cff5=cff1*cff |
|---|
| 575 | cff6=cff2*cff |
|---|
| 576 | # endif |
|---|
| 577 | # ifdef BULK_WSTR |
|---|
| 578 | cff=sms_scale/(cff1+cff2) |
|---|
| 579 | cff7=cff1*cff |
|---|
| 580 | cff8=cff2*cff |
|---|
| 581 | # endif |
|---|
| 582 | cff=1./(cff1+cff2) |
|---|
| 583 | cff1=cff1*cff |
|---|
| 584 | cff2=cff2*cff |
|---|
| 585 | |
|---|
| 586 | if (ltairgrd.eq.1) then |
|---|
| 587 | do j=JstrR,JendR |
|---|
| 588 | do i=IstrR,IendR |
|---|
| 589 | # ifndef BULK_WVEC |
|---|
| 590 | wspd(i,j)=cff1*wspdg(i,j,it1)+cff2*wspdg(i,j,it2) |
|---|
| 591 | # endif |
|---|
| 592 | tair(i,j)=cff1*tairg(i,j,it1)+cff2*tairg(i,j,it2) |
|---|
| 593 | rhum(i,j)=cff1*rhumg(i,j,it1)+cff2*rhumg(i,j,it2) |
|---|
| 594 | radlw(i,j)=cff3*radlwg(i,j,it1)+cff4*radlwg(i,j,it2) |
|---|
| 595 | radsw(i,j)=cff3*radswg(i,j,it1)+cff4*radswg(i,j,it2) |
|---|
| 596 | srflx(i,j)=radsw(i,j) |
|---|
| 597 | # ifdef BULK_EP |
|---|
| 598 | prate(i,j)=cff5*prateg(i,j,it1)+cff6*prateg(i,j,it2) |
|---|
| 599 | # endif |
|---|
| 600 | # ifdef BULK_WVEC |
|---|
| 601 | uwnd(i,j)=cff1*uwndg(i,j,it1)+cff2*uwndg(i,j,it2) |
|---|
| 602 | vwnd(i,j)=cff1*vwndg(i,j,it1)+cff2*vwndg(i,j,it2) |
|---|
| 603 | # elif defined BULK_WSTR |
|---|
| 604 | sustr(i,j)=cff7*sustrg(i,j,it1)+cff8*sustrg(i,j,it2) |
|---|
| 605 | svstr(i,j)=cff7*svstrg(i,j,it1)+cff8*svstrg(i,j,it2) |
|---|
| 606 | # endif |
|---|
| 607 | enddo |
|---|
| 608 | enddo |
|---|
| 609 | else |
|---|
| 610 | # ifndef BULK_WVEC |
|---|
| 611 | val1=cff1*wspdp(it1)+cff2*wspdp(it2) |
|---|
| 612 | # endif |
|---|
| 613 | val2=cff1*tairp(it1)+cff2*tairp(it2) |
|---|
| 614 | val3=cff1*rhump(it1)+cff2*rhump(it2) |
|---|
| 615 | val4=cff3*radlwp(it1)+cff4*radlwp(it2) |
|---|
| 616 | val5=cff3*radswp(it1)+cff4*radswp(it2) |
|---|
| 617 | # ifdef BULK_EP |
|---|
| 618 | val6=cff5*pratep(it1)+cff6*pratep(it2) |
|---|
| 619 | # endif |
|---|
| 620 | # ifdef BULK_WVEC |
|---|
| 621 | val7=cff1*uwndp(it1)+cff2*uwndp(it2) |
|---|
| 622 | val8=cff1*vwndp(it1)+cff2*vwndp(it2) |
|---|
| 623 | # elif defined BULK_WSTR |
|---|
| 624 | val7=cff7*sustrp(it1)+cff8*sustrp(it2) |
|---|
| 625 | val8=cff7*svstrp(it1)+cff8*svstrp(it2) |
|---|
| 626 | # endif |
|---|
| 627 | do j=JstrR,JendR |
|---|
| 628 | do i=IstrR,IendR |
|---|
| 629 | # ifndef BULK_WVEC |
|---|
| 630 | wspd(i,j)=val1 |
|---|
| 631 | # endif |
|---|
| 632 | tair(i,j)=val2 |
|---|
| 633 | rhum(i,j)=val3 |
|---|
| 634 | radlw(i,j)=val4 |
|---|
| 635 | radsw(i,j)=val5 |
|---|
| 636 | srflx(i,j)=val5 |
|---|
| 637 | # ifdef BULK_EP |
|---|
| 638 | prate(i,j)=val6 |
|---|
| 639 | # endif |
|---|
| 640 | # if defined BULK_WVEC || defined BULK_WSTR |
|---|
| 641 | # ifdef CURVGRID |
|---|
| 642 | cff=0.5*(angler(i,j)+angler(i-1,j)) |
|---|
| 643 | cff7=val7*cos(cff)+val8*sin(cff) |
|---|
| 644 | # else |
|---|
| 645 | cff7=val7 |
|---|
| 646 | # endif |
|---|
| 647 | # ifdef BULK_WVEC |
|---|
| 648 | uwnd(i,j)=cff7 |
|---|
| 649 | # else |
|---|
| 650 | sustr(i,j)=cff7 |
|---|
| 651 | # endif |
|---|
| 652 | # ifdef CURVGRID |
|---|
| 653 | cff=0.5*(angler(i,j)+angler(i,j-1)) |
|---|
| 654 | cff8=-val7*sin(cff)+val8*cos(cff) |
|---|
| 655 | # else |
|---|
| 656 | cff8=vstress |
|---|
| 657 | # endif |
|---|
| 658 | # ifdef BULK_WVEC |
|---|
| 659 | vwnd(i,j)=cff8 |
|---|
| 660 | # else |
|---|
| 661 | svstr(i,j)=cff8 |
|---|
| 662 | # endif |
|---|
| 663 | # endif /* BULK_WVEC || BULK_WSTR */ |
|---|
| 664 | enddo |
|---|
| 665 | enddo |
|---|
| 666 | endif |
|---|
| 667 | ! |
|---|
| 668 | ! Unable to set-up SST and dQdSST: |
|---|
| 669 | ! Complain about the error and signal to quit. |
|---|
| 670 | ! |
|---|
| 671 | else |
|---|
| 672 | if (ZEROTH_TILE) then |
|---|
| 673 | write(stdout,1) 'bulk_time',tdays,bulk_time(it2)*sec2day |
|---|
| 674 | 1 format(/,' SET_BULK - current model time exceeds ending', |
|---|
| 675 | & 1x,'value for variable: ',a,/,11x,'TDAYS = ',g12.4, |
|---|
| 676 | & 2x,'TEND = ',g12.4) |
|---|
| 677 | may_day_flag=2 |
|---|
| 678 | endif |
|---|
| 679 | endif |
|---|
| 680 | return |
|---|
| 681 | end |
|---|
| 682 | #else |
|---|
| 683 | subroutine get_bulk_empty |
|---|
| 684 | return |
|---|
| 685 | end |
|---|
| 686 | #endif /* BULK_FLUX */ |
|---|
