diff --git a/physics/GWD/cires_ugwpv1_initialize.F90 b/physics/GWD/cires_ugwpv1_initialize.F90 index 65c96cf0d..daa850550 100644 --- a/physics/GWD/cires_ugwpv1_initialize.F90 +++ b/physics/GWD/cires_ugwpv1_initialize.F90 @@ -16,7 +16,7 @@ module ugwp_common ! use machine, only : kind_phys - + implicit none real(kind=kind_phys) :: pi, pi2, pih, rad_to_deg, deg_to_rad @@ -60,12 +60,11 @@ module ugwp_common ! real(kind=kind_phys), parameter :: fv = rv/rd - 1.0 ! real(kind=kind_phys), parameter :: arad = 6370.e3 - end module ugwp_common - + contains + subroutine init_nazdir(naz, xaz, yaz) use machine, only : kind_phys - use ugwp_common, only : pi2 implicit none @@ -103,7 +102,6 @@ end subroutine init_nazdir subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) ! use machine , only : kind_phys - use ugwp_common, only : pih, pi implicit none integer , intent(in) :: me, master @@ -185,6 +183,8 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) ! 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) end subroutine init_global_gwdis + + end module ugwp_common ! ! ======================================================================== ! Part 2 - sources @@ -353,7 +353,7 @@ module ugwp_conv_init ! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) ! - use ugwp_common, only : pi2, arad + use ugwp_common, only : pi2, arad, init_nazdir implicit none @@ -433,8 +433,8 @@ module ugwp_fjet_init subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac,lonr, kxw) - use ugwp_common, only : pi2, arad - + use ugwp_common, only : pi2, arad, init_nazdir + implicit none integer :: nwaves, nazdir, nstoch @@ -492,7 +492,7 @@ module ugwp_okw_init subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common, only : pi2, arad + use ugwp_common, only : pi2, arad, init_nazdir implicit none diff --git a/physics/GWD/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 index 9c3fa24ee..c0e866dc5 100644 --- a/physics/GWD/cires_ugwpv1_module.F90 +++ b/physics/GWD/cires_ugwpv1_module.F90 @@ -151,6 +151,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! use netcdf + use ugwp_common, only : init_global_gwdis use ugwp_oro_init, only : init_oro_gws use ugwp_conv_init, only : init_conv_gws use ugwp_fjet_init, only : init_fjet_gws diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 index 2ba367530..329121359 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @@ -27,6 +27,7 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, ! ! use machine, only: kind_phys, kind_io8 + use sfccyc_module, only: sfccycle implicit none integer, intent(in) :: me, nthrds, nx, ny, isc, jsc, nsst, & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 9dfad38bb..a69dbea26 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -11,6 +11,7 @@ module sfccyc_module use machine , only : kind_io8,kind_io4 implicit none save + ! ! grib code for each parameter - used in subroutines sfccycle and setrmsk. ! @@ -52,8 +53,6 @@ function message(prefix,index) write(message,fmt='(a,a,i0)') trim(prefix), '-', index end function message - end module sfccyc_module - !>\ingroup mod_GFS_phys_time_vary !! This subroutine reads or interpolates surface climatology data in analysis !! and forecast mode. @@ -89,7 +88,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) ! use machine , only : kind_io8,kind_io4 - use sfccyc_module implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len), & @@ -2769,7 +2767,6 @@ subroutine dayoyr(iyr,imo,idy,ldy) subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & & kpds5,slmskh,gausm,blnmsk,bltmsk,me) use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata, xdata, ydata implicit none integer kpds5,me,i,imsk,jmsk,lugb ! @@ -2802,7 +2799,6 @@ subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & subroutine fixrdg(lugb,idim,jdim,fngrib, & & kpds5,gdata,gaus,blno,blto,me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb, & iret, me,kpds5,kdata,i @@ -3127,7 +3123,6 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& & gauout,len,lmask,rslmsk,slmask & &, outlat, outlon,me) use machine , only : kind_io8,kind_io4 - use sfccyc_module , only : num_threads implicit none real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, & & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, & @@ -4794,8 +4789,6 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & & irtvmn,irtvmx,irtslp,irtabs, & & irtvet,irtsot,irtsoc,irtalf, landice, me) use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : veg_type_landice, soil_type_landice, & - & num_threads, zero, one,soil_color_landice implicit none integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, & & irttg3,irtstc,irtalf,me,irtsot,irtsoc,irtveg,irtvet, irtzor, & !irtsoc:soil color @@ -5514,7 +5507,6 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & & rla,rlo,len,mode,percrit,lgchek,me) ! use machine , only : kind_io8,kind_io4 - use sfccyc_module , only : num_threads implicit none integer, intent(in) :: len, mode, me real (kind=kind_io8), intent(in) :: fldimx,fldimn,fldjmx,fldomn, & @@ -6260,7 +6252,6 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & & data,imax,jmax,rlnout,rltout,lmask,rslmsk & &, gaus,blno, blto, kgds1, kpds4, lbms) use machine , only : kind_io8,kind_io4,kind_dbl_prec - use sfccyc_module implicit none real (kind=kind_io8) blno,blto,wlon,rnlat,crit,data_max integer i,j,ijmax,jgaul,igaul,kpds5,jmax,imax, kgds1, kspla @@ -6746,7 +6737,6 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & & wlon,rnlat,rlnout,rltout,gaus,blno, blto) use machine , only : kind_io8,kind_io4,kind_dbl_prec - use sfccyc_module , only : num_threads implicit none integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, & & j,iret @@ -8415,7 +8405,6 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & @@ -8580,7 +8569,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & @@ -8902,3 +8890,6 @@ subroutine snodpth2(glacir,snwmax,snoanl, len, me) return end !>@} + + end module sfccyc_module +