diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index bf140a1ac..0e37d230c 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -133,6 +133,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, !*** INITIALIZE THE WRITE GRIDDED COMPONENT. !----------------------------------------------------------------------- ! + use ctlblk_mod, only: numx type(esmf_GridComp) :: wrt_comp type(ESMF_State) :: imp_state_write, exp_state_write type(esmf_Clock) :: clock @@ -379,6 +380,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, itasks = 1 jtasks = ntasks endif + numx = itasks + if (lprnt) print *,'jtasks=',jtasks,' itasks=',itasks,' numx=',numx if (trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:',rc=rc) diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 81c62dd66..5f057c34a 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -36,6 +36,7 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! and HAFS. ! 6)read 3D cloud fraction from cld_amt for GFDL MP, ! and from cldfra for other MPs. +! Jun 2022 J. Meng 2D decomposition ! !----------------------------------------------------------------------- !*** run post on write grid comp @@ -43,7 +44,7 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,ista,iend, im, nsoil, filenameflat,numx use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl @@ -69,6 +70,8 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil integer,allocatable :: jstagrp(:),jendgrp(:) + integer its,ite + integer,allocatable :: istagrp(:),iendgrp(:) integer,save :: kpo,kth,kpv logical,save :: log_postalct=.false. real,dimension(komax),save :: po, th, pv @@ -93,6 +96,8 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & nwtpg = wrt_int_state%petcount jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection + its = wrt_int_state%lon_start !<-- Starting I of this write task's subsection + ite = wrt_int_state%lon_end !<-- Ending I of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount @@ -107,12 +112,16 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & if (.not.log_postalct) then ! allocate(jstagrp(nwtpg),jendgrp(nwtpg)) + allocate(istagrp(nwtpg),iendgrp(nwtpg)) ! do n=0,nwtpg-1 jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) + istagrp(n+1) = wrt_int_state%lon_start_wrtgrp(n+1) + iendgrp(n+1) = wrt_int_state%lon_end_wrtgrp (n+1) enddo if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp + if(mype==0) print *,'in post_run,istagrp=',istagrp,'iendgrp=',iendgrp !----------------------------------------------------------------------- !*** read namelist for pv,th,po @@ -131,7 +140,7 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & 'jstagrp=',jstagrp,'jendgrp=',jendgrp call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po @@ -200,11 +209,11 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & npset = npset + 1 call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) - allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) + allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd,ista,iend) do k=1,nrecout+100 do j=1,jend+1-jsta - do i=1,im + do i=1,iend+1-ista datapd(i,j,k) = 0. enddo enddo @@ -511,6 +520,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & + ista, iend, ista_2l, iend_2u, ista_m,iend_m, & lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& @@ -546,7 +556,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer i1,i2,j1,j2,k1,k2 - integer ista,iend,fieldDimCount,gridDimCount,ncount_field + integer fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found, mvispresent integer totalLBound3d(3), totalUBound3d(3) @@ -594,18 +604,19 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! !$omp parallel do default(shared),private(i,j) do j=jsta,jend - do i=1,im + do i=ista,iend gdlat(i,j) = wrt_int_state%latPtr(i,j) gdlon(i,j) = wrt_int_state%lonPtr(i,j) enddo enddo - call exch(gdlat(1,jsta_2l)) + call exch(gdlat) + call exch(gdlon) !$omp parallel do default(none),private(i,j,ip1), & -!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) +!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy,ista,iend_m) do j = jsta, jend_m - do i = 1, im-1 + do i = ista, iend_m ip1 = i + 1 !if (ip1 > im) ip1 = ip1 - im dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr @@ -619,9 +630,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & bk5(i) = wrt_int_state%bk(i) enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) end do end do @@ -631,9 +642,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! GFS does not have surface specific humidity ! inst sensible heat flux ! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL @@ -650,10 +661,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m theta ! 10 m humidity ! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & +!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval,ista,iend), & !$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend - do i=1,im + do i=ista,iend cldefi(i,j) = SPVAL lspa(i,j) = SPVAL th10(i,j) = SPVAL @@ -663,9 +674,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend cprate(i,j) = 0. enddo enddo @@ -675,10 +686,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! inst cloud fraction for high, middle, and low cloud, ! cfrach ! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,ista,iend), & !$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) do j=jsta,jend - do i=1,im + do i=ista,iend czen(i,j) = SPVAL czmean(i,j) = SPVAL cfrach(i,j) = SPVAL @@ -705,10 +716,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! inst outgoing sfc shortwave, rswout ! snow phase change heat flux, snopcx ! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,ista,iend), & !$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) do j=jsta,jend - do i=1,im + do i=ista,iend acfrcv(i,j) = spval ncfrcv(i,j) = 1.0 acfrst(i,j) = spval @@ -731,10 +742,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! temperature tendency due to latent heating from convection ! temperature tendency due to latent heating from grid scale do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l,ista_2l,iend_2u), & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval @@ -761,10 +772,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! v at roughness length, vz0 ! shelter rh max, maxrhshltr ! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & !$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u smstav(i,j) = spval sfcevp(i,j) = spval acsnow(i,j) = spval @@ -778,9 +789,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! GFS does not have mixing length,el_pbl ! exchange coefficient, exch_h do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h,ista_2l,iend_2u) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u el_pbl(i,j,l) = spval exch_h(i,j,l) = spval enddo @@ -788,10 +799,10 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,ista_2l,iend_2u), & !$omp& shared(htopd,hbotd,htops,hbots,cuppt) do j=jsta_2l,jend_2u - do i=1,im + do i=ista_2l,iend_2u htopd(i,j) = SPVAL hbotd(i,j) = SPVAL htops(i,j) = SPVAL @@ -852,8 +863,6 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & line=__LINE__, file=__FILE__)) return ! bail out ! print *,'in post_lam, get land field value,fillvalue=',fillvalue - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend @@ -886,8 +895,6 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in post_lam, get icec field value,fillvalue=',fillvalue - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm,fillValue) do j=jsta, jend do i=ista, iend @@ -3029,9 +3036,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo file_loop_all ! recompute full layer of zint -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if (fis(i,j) /= spval) then zint(i,j,lp1) = fis(i,j) fis(i,j) = fis(i,j) * grav @@ -3043,9 +3050,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint,spval) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint,spval,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if(wh(i,j,l) /= spval) then omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) @@ -3060,17 +3067,17 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! 'lm=',maxval(omga(ista:iend,jsta:jend,lm)),minval(omga(ista:iend,jsta:jend,lm)) ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend pint(i,j,1) = ak5(1) end do end do do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres,spval) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres,spval,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if(dpres(i,j,l-1) /= spval) then pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) else @@ -3082,9 +3089,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & !compute pmid from averaged two layer pint do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint,spval) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint,spval,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if(pint(i,j,l+1) /= spval) then pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) else @@ -3094,9 +3101,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend pd(i,j) = spval pint(i,j,1) = pt end do @@ -3105,9 +3112,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! compute alpint do l=lp1,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint,spval) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint,spval,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if(pint(i,j,l) /= spval) then alpint(i,j,l) = log(pint(i,j,l)) else @@ -3119,9 +3126,9 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint,spval) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint,spval,ista,iend) do j=jsta,jend - do i=1,im + do i=ista,iend if( zint(i,j,l+1)/=spval .and. zint(i,j,l)/=spval .and. pmid(i,j,l) /= spval) then zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & (log(pmid(i,j,l))-alpint(i,j,l+1))/ & @@ -3199,7 +3206,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & !htop do j=jsta,jend - do i=1,im + do i=ista,iend htop(i,j) = spval if(ptop(i,j) < spval)then do l=1,lm @@ -3214,7 +3221,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! hbot do j=jsta,jend - do i=1,im + do i=ista,iend hbot(i,j) = spval if(pbot(i,j) < spval)then do l=lm,1,-1 diff --git a/io/post_nems_routines.F90 b/io/post_nems_routines.F90 index 995349224..6430d64f6 100644 --- a/io/post_nems_routines.F90 +++ b/io/post_nems_routines.F90 @@ -3,12 +3,13 @@ !----------------------------------------------------------------------- ! subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & - jts,jte,jtsgrp,jtegrp) + jts,jte,jtsgrp,jtegrp,its,ite,itsgrp,itegrp) +! jts,jte,jtsgrp,jtegrp) ! ! ! revision history: ! Jul 2019 Jun Wang: allocate arrays for post processing -! +! Feb 2022 J. Meng/B. Cui: create interface to run inline post with post_2d_decomp ! !----------------------------------------------------------------------- !*** allocate post variables @@ -23,6 +24,10 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ioform, jsta, jend, jsta_m, jsta_m2, & jend_m, jend_m2, jvend_2u, jsta_2l, jend_2u, iup, idn, & icnt, idsp, mpi_comm_comp, num_servers, & + modelname, numx, ista, iend, ista_m, ista_m2, & + iend_m, iend_m2, ista_2l, iend_2u, & + ileft,iright,ileftb,irightb, & + icnt2, idsp2,isxa,iexa,jsxa,jexa, & num_procs ! !----------------------------------------------------------------------- @@ -37,6 +42,8 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & integer,intent(in) :: lead_write integer,intent(in) :: jts,jte integer,intent(in) :: jtsgrp(nwtlpes),jtegrp(nwtlpes) + integer,intent(in) :: its,ite + integer,intent(in) :: itsgrp(nwtlpes),itegrp(nwtlpes) ! !----------------------------------------------------------------------- !*** LOCAL VARIABLES @@ -44,6 +51,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! integer i,j,l integer last_write_task + integer isumm,isumm2 ! !----------------------------------------------------------------------- !*** get dims from int_state @@ -78,14 +86,28 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & jsta_m2 = jsta jend_m = jend jend_m2 = jend - if ( mype == lead_write ) then + if ( mype<(lead_write+numx) ) then jsta_m = 2 jsta_m2 = 3 end if - if ( mype == last_write_task ) then + if ( mype>(last_write_task-numx) ) then jend_m = jm - 1 jend_m2 = jm - 2 end if + ista = its + iend = ite + ista_m = ista + ista_m2 = ista + iend_m = iend + iend_m2 = iend + if(mod(me,numx)==0)then + ista_m=2 + ista_m2=3 + end if + if(mod(me+1,numx)==0)then + iend_m=im-1 + iend_m2=im-2 + end if !** neighbors iup = mype + 1 - lead_write idn = mype - 1 - lead_write @@ -100,22 +122,69 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! ! counts, disps for gatherv and scatterv ! + isumm=0 + isumm2=0 + allocate(isxa(0:num_procs-1) ) + allocate(jsxa(0:num_procs-1) ) + allocate(iexa(0:num_procs-1) ) + allocate(jexa(0:num_procs-1) ) + do i = 1, num_procs - icnt(i-1) = (jtegrp(i)-jtsgrp(i)+1)*im - idsp(i-1) = (jtsgrp(i)-1)*im -! if ( mype .eq. lead_write ) then -! print *, ' i, icnt(i),idsp(i) = ',i-1,icnt(i-1),idsp(i-1) -! end if + icnt(i-1) = (jtegrp(i)-jtsgrp(i)+1)*(itegrp(i)-itsgrp(i)+1) + isxa(i-1) = itsgrp(i) + iexa(i-1) = itegrp(i) + jsxa(i-1) = jtsgrp(i) + jexa(i-1) = jtegrp(i) + idsp(i-1) = isumm + isumm=isumm+icnt(i-1) + if(jtsgrp(i)==1 .or. jtegrp(i)==jm) then + icnt2(i-1) = (itegrp(i)-itsgrp(i)+1) + else + icnt2(i-1) = 0 + endif + idsp2(i-1)=isumm2 + if(jtsgrp(i)==1 .or. jtegrp(i)==jm) isumm2=isumm2+(itegrp(i)-itsgrp(i)+1) + enddo +! write(6,'(a25,i4,16i8)') 'JESSE,me,icnt2,idsp2=',me,icnt2(0:num_procs-1),idsp2(0:num_procs-1) ! ! extraction limits -- set to two rows ! jsta_2l = max(jsta - 2, 1 ) jend_2u = min(jend + 2, jm ) + if(modelname=='GFS') then + ista_2l=max(ista-2,0) + iend_2u=min(iend+2,im+1) + else + ista_2l = max(ista - 2, 1 ) + iend_2u = min(iend + 2, im ) + endif ! special for c-grid v jvend_2u = min(jend + 2, jm+1 ) - if(mype==0)print *,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm -! +! if(mype==0)print *,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta =',jsta ,'jend =',jend ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta_m =',jsta_m ,'jend_m =',jend_m ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'jsta_2l=',jsta_2l,'jend_2u=',jend_2u,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista =',ista ,'iend =',iend ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista_m =',ista_m ,'iend_m =',iend_m ,'lm=',lm +! print 901,'GWVX mype/me=',mype,me,'im=',im,'ista_2l=',ista_2l,'iend_2u=',iend_2u,'lm=',lm +! 901 format(a15,2i4,4(1x,a8,i4)) +! NEW neighbors + ileft = me - 1 + iright = me + 1 + iup=MPI_PROC_NULL + idn=MPI_PROC_NULL +! if(mod(me,numx) .eq. 0) print *,' LEFT POINT',mype,me +! if(mod(me+1,numx) .eq. 0) print *,' RIGHT POINT',mype,me + if(mod(me,numx) .eq. 0) ileft=MPI_PROC_NULL + if(mod(me,numx) .eq. 0) ileftb=me+numx-1 +! if(mod(me,numx) .eq. 0) print *,' GWVX ILEFTB ',ileftb,mype,me,numx + if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) iright=MPI_PROC_NULL + if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) irightb=me-numx+1 +! if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) print *,' GWVX IRIGHTB',irightb,mype,me,numx + if(me .ge. numx) idn=me-numx + if(me+1 .le. num_procs-numx) iup=me+numx +! write(6,'(a12,6i10)') 'GWVX BOUNDS ',me,ileft,iright,iup,idn,num_procs ! ! SETS UP MESSAGE PASSING INFO @@ -126,7 +195,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! LMV always = LM for sigma-type vert coord do j = jsta_2l, jend_2u - do i = 1, im + do i = ista_2l, iend_2u lmv ( i, j ) = lm lmh ( i, j ) = lm end do @@ -136,7 +205,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & do l = 1, lm do j = jsta_2l, jend_2u - do i = 1, im + do i = ista_2l, iend_2u htm ( i, j, l ) = 1.0 vtm ( i, j, l ) = 1.0 end do diff --git a/upp b/upp index dc8bc684a..6b4a79cac 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit dc8bc684a3e38eae5ff4431e24672b6382127d70 +Subproject commit 6b4a79cac94f0b69654b60cfcc202cdca6e4f740