!!!@PROCESS NOEXTCHK SUBROUTINE MPI_FIRST() !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: MPI_FIRST SET UP MESSGAE PASSING INFO ! PRGRMMR: TUCCILLO ORG: IBM ! ! ABSTRACT: ! SETS UP MESSAGE PASSING INFO ! . ! ! PROGRAM HISTORY LOG: ! 00-01-06 TUCCILLO - ORIGINAL ! 01-10-25 H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT ! 02-06-19 MIKE BALDWIN - WRF VERSION ! 11-12-16 SARAH LU - MODIFIED TO INITIALIZE AEROSOL FIELDS ! 12-01-07 SARAH LU - MODIFIED TO INITIALIZE AIR DENSITY/LAYER THICKNESS ! ! USAGE: CALL MPI_FIRST ! INPUT ARGUMENT LIST: ! ! OUTPUT ARGUMENT LIST: ! ! OUTPUT FILES: ! STDOUT - RUN TIME STANDARD OUT. ! ! SUBPROGRAMS CALLED: ! PARA_RANGE ! UTILITIES: ! NONE ! LIBRARY: ! COMMON - CTLBLK.comm ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN ! MACHINE : IBM RS/6000 SP !$$$ ! use vrbls4d, only: dust, salt, soot, waso, suso use vrbls3d, only: u, v, t, q, uh, vh, wh, pmid, pmidv, pint, alpint, zmid,& zint, q2, omga, t_adj, ttnd, rswtt, rlwtt, exch_h, train, tcucn,& el_pbl, cwm, f_ice, f_rain, f_rimef, qqw, qqi, qqr, qqs,qqg, qqni, qqnr,& extcof55, cfr, dbz, dbzr, dbzi, dbzc, mcvg, nlice, o3, vdifftt,& tcucns, vdiffmois, dconvmois, sconvmois, nradtt, o3vdiff, o3prod,& o3tndy, mwpv, unknown, vdiffzacce, zgdrag, cnvctummixing, vdiffmacce,& mgdrag, cnvctvmmixing, ncnvctcfrac, cnvctumflx, cnvctdmflx, cnvctdetmflx,& cnvctzgdrag, cnvctmgdrag, icing_gfip, asy, ssa, duem, dusd, dudp,& duwt, suem, susd, sudp, suwt, ocem, ocsd, ocdp, ocwt, bcem, bcsd,& bcdp, bcwt, ssem, sssd, ssdp, sswt, ext, dpres, rhomid use vrbls2d, only: wspd10max, w_up_max, w_dn_max, w_mean, refd_max, up_heli_max,& up_heli_max16, grpl_max, up_heli, up_heli16, ltg1_max, ltg2_max, & ltg3_max, nci_ltg, nca_ltg, nci_wq, nca_wq, nci_refd, vil, radarvil,& echotop, u10, v10, tshltr, qshltr, mrshltr, smstav, ssroff, bgroff,& nca_refd, vegfrc, acsnow, acsnom, cmc, sst, qz0, thz0, uz0, vz0, qs, ths,& sno, snonc, snoavg, psfcavg, t10m, t10avg, akmsavg, akhsavg, u10max,& v10max, u10h, v10h, akms, akhs, cuprec, acprec, ancprc, cuppt,& rainc_bucket, rainnc_bucket, pcp_bucket, snow_bucket, qrmax, tmax,& snownc, graupelnc, tsnow, qvg, qv2m, rswin, rlwin, rlwtoa, tg, sfcshx,& fis, t500, cfracl, cfracm, cfrach, acfrst, acfrcv, hbot, potevp,& sfclhx, htop, aswin, alwin, aswout, alwout, aswtoa, alwtoa, czen, czmean,& sigt4, rswout, radot, ncfrst, ncfrcv, smstot, pctsno, pshltr, th10,& q10, sr, prec, subshx, snopcx, sfcuvx, sfcevp, z0, ustar, pblh, mixht,& twbs, qwbs, sfcexc, grnflx, soiltb, z1000, slp, pslp, f, albedo, albase,& cldfra, cprate, cnvcfr, ivgtyp, hbotd, htopd, hbots, isltyp, htops,& cldefi, islope, si, lspa, rswinc, vis, pd, mxsnal, epsr, sfcux,& sfcvx, avgalbedo, avgcprate, avgprec, ptop, pbot, avgcfrach, avgcfracm,& avgcfracl, avgtcdc, auvbin, auvbinc, ptopl, pbotl, ttopl, ptopm,& pbotm, ttopm, ptoph, pboth, ttoph, sfcugs, sfcvgs, pblcfr, cldwork,& gtaux, gtauy, mdltaux, mdltauy, runoff, maxtshltr, mintshltr,& maxrhshltr, minrhshltr, dzice, alwinc, alwoutc, alwtoac, aswinc,& aswoutc,aswtoac, aswintoa, smcwlt, suntime, fieldcapa, avisbeamswin,& avisdiffswin, airbeamswin, airdiffswin, snowfall, dusmass, ducmass,& dusmass25, susmass, sucmass, susmass25, sucmass25, ocsmass, occmass,& ocsmass25, occmass25, bcsmass, bccmass, bcsmass25, bccmass25,& sssmass, sscmass, sssmass25, sscmass25, ducmass25 use soil, only: smc, stc, sh2o, sldpth, rtdpth, sllevel use masks, only: htm, vtm, hbm2, sm, sice, lmh, gdlat, gdlon, dx, dy, lmv use ctlblk_mod, only: me, num_procs, jm, jsta, jend, jsta_m, jsta_m2,& jend_m, jend_m2, iup, idn, icnt, im, idsp, jsta_2l, jend_2u,& jvend_2u, lm, lp1, jsta_2l, jend_2u, nsoil, nbin_du, nbin_ss,& nbin_bc, nbin_oc, nbin_su ! ! use params_mod !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none ! include 'mpif.h' ! integer ierr,i,jsx,jex ! if ( me .eq. 0 ) then ! print *, ' NUM_PROCS = ',num_procs end if if ( num_procs .gt. 1024 ) then print *, ' too many MPI tasks, max is 1024, stopping' call mpi_abort(MPI_COMM_WORLD,1,ierr) stop end if ! ! error check ! if ( num_procs .gt. JM/2 ) then print *, ' too many MPI tasks, max is ',jm/2,' stopping' call mpi_abort(MPI_COMM_WORLD,1,ierr) stop end if ! ! global loop ranges ! call para_range(1,jm,num_procs,me, & jsta,jend) jsta_m = jsta jsta_m2 = jsta jend_m = jend jend_m2 = jend if ( me .eq. 0 ) then jsta_m = 2 jsta_m2 = 3 end if if ( me .eq. num_procs - 1 ) then jend_m = jm - 1 jend_m2 = jm - 2 end if ! ! neighbors ! iup = me + 1 idn = me - 1 if ( me .eq. 0 ) then idn = MPI_PROC_NULL end if if ( me .eq. num_procs - 1 ) then iup = MPI_PROC_NULL end if ! ! print *, ' ME, NUM_PROCS = ',me,num_procs ! print *, ' ME, JSTA, JSTA_M, JSTA_M2 = ',me,jsta,jsta_m,jsta_m2 ! print *, ' ME, JEND, JEND_M, JEND_M2 = ',me,jend,jend_m,jend_m2 ! print *, ' ME, IUP, IDN = ',me,iup,idn ! ! counts, disps for gatherv and scatterv ! do i = 0, num_procs - 1 call para_range(1,jm,num_procs,i,jsx,jex) icnt(i) = (jex-jsx+1)*im idsp(i) = (jsx-1)*im if ( me .eq. 0 ) then print *, ' i, icnt(i),idsp(i) = ',i,icnt(i), & idsp(i) end if end do ! ! extraction limits -- set to two rows ! jsta_2l = max(jsta - 2, 1 ) jend_2u = min(jend + 2, jm ) ! special for c-grid v jvend_2u = min(jend + 2, jm+1 ) ! special for c-grid v ! print *, ' me, jvend_2u = ',me,jvend_2u ! ! allocate arrays ! ! ! FROM VRBLS3D ! print *, ' me, jsta_2l, jend_2u = ',me,jsta_2l, jend_2u, & 'jvend_2u=',jvend_2u,'im=',im,'jm=',jm,'lm=',lm, & 'lp1=',lp1 end