!!!@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