! ! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE INITADAS ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE initadas 4,107 ! !----------------------------------------------------------------------- ! ! PURPOSE: ! Read in analysis variables in namelist format from standard input. ! ! AUTHOR: ! Keith Brewster, CAPS, January, 1996 ! ! MODIFICATION HISTORY: ! ! Added read of variables previously read by calling initpara ! Added new src and iuse variables. ! Keith Brewster, CAPS, October, 1997 ! ! Added lines to initialize mgrid and nstgrid which are used ! by the GRIB writer. ! Keith Brewster, CAPS, March, 1998 ! ! Keith Brewster, CAPS, April 27,1998 ! Added new parameters to output namelist to match ARPS ! input file options. ! ! 2000/05/10 (Gene Bassett) ! Merged the ADAS input file back into the ARPS input file. ! ! 2000-05-18 (Gene Bassett) ! Moved hydrostatic and wind adjustment parameters to an ! adjust namelist block. ! ! 2003-09-03 (Steve Leyton, CAPS) ! Added MPI capabilities ! ! 2004/02/10 (Dan Weber, CAPS) ! Added code for the root processor to read in the namelists ! (following ARPS convention) and send the data to the other ! processors via the mpupdate funtion. Also wrapped each write to ! standard out with myproc=0 if statements, thus only the root ! processor will write to the standard output file. ! !----------------------------------------------------------------------- ! ! Variable Declarations: ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! INCLUDE 'adas.inc' INCLUDE 'adassat.inc' INCLUDE 'adjust.inc' INCLUDE 'mp.inc' ! !----------------------------------------------------------------------- ! Misc local variables !----------------------------------------------------------------------- ! INTEGER :: i,j,isat INTEGER :: lenstr LOGICAL :: iexist CHARACTER (LEN=19) :: initime ! Real time in form of 'year-mo-dy:hr:mn:ss' INTEGER :: err_no DATA err_no /0/ ! !----------------------------------------------------------------------- ! ! ADAS namelists ! !----------------------------------------------------------------------- ! NAMELIST /adas_const/ npass,sprdist,wlim,zwlim,thwlim, & ccatopt,spradopt NAMELIST /adjust/ hydradj,wndadj,obropt,obrzero NAMELIST /adas_radaropt/ raduvobs,radrhobs,refrh,rhradobs, & radistride,radkstride, & radcldopt,radqvopt,radqcopt,radqropt,radptopt, & refsat,rhrad, & refcld,cldrad,ceilopt,ceilmin,dzfill, & refrain,radsetrat,radreflim,radptgain NAMELIST /adas_typ/ ianxtyp NAMELIST /adas_range/ sfcqcrng,xyrange NAMELIST /adas_kpvar/ kpvar NAMELIST /adas_zrange/ zrange NAMELIST /adas_thrng/ thrng NAMELIST /adas_trnrng/ trnropt,trnrcst,trnrng NAMELIST /adas_backerf/ backerrfil NAMELIST /adas_sng/ nsngfil,sngfname,sngtmchk,blackfil, & srcsng,sngerrfil,iusesng NAMELIST /adas_ua/ nuafil,uafname,srcua,uaerrfil,iuseua NAMELIST /adas_radar/ nradfil,radfname,srcrad,raderrfil,iuserad NAMELIST /adas_retrieval/ & nretfil,retfname,srcret,reterrfil,iuseret NAMELIST /adas_cloud/ cloudopt,clddiag,range_cld, & refthr1,refthr2,hgtrefthr, & wmhr_cu,wmhr_sc,wc_st,bgqcopt, & cldqvopt,cldqcopt, & cldqropt,cldwopt,cldptopt,thresh_cvr, & rh_thr1,cvr2rh_thr1,rh_thr2,cvr2rh_thr2, & qvslimit_2_qc,qrlimit,frac_qr_2_qc, & frac_qw_2_pt,frac_qc_2_lh,max_lh_2_pt, & smth_opt, & nvisfiles,vis_fname,nirfiles,ir_fname,cld_files, & viscalname,ircalname NAMELIST /incr_out/ incdmpf,incrdmp,incrhdfcompr, & uincdmp,vincdmp,wincdmp, & pincdmp,ptincdmp,qvincdmp, & qcincdmp,qrincdmp,qiincdmp,qsincdmp,qhincdmp ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! !----------------------------------------------------------------------- ! Assign default values to the ADAS input variables !----------------------------------------------------------------------- npass=4 sprdist = 15000. wlim = 1.e-04 zwlim = 1.e-03 thwlim = 1.e-03 ccatopt = 1 spradopt = 2 hydradj = 0 wndadj = 2 obropt = 2 obrzero = 12000. raduvobs = 0 radrhobs = 0 radistride = 2 radkstride = 2 refrh = 20. rhrad = 0.90 radcldopt = 0 radqvopt = 0 radqcopt = 0 radqropt = 0 radptopt = 0 refcld = 20. cldrad = 1.0E-03 ceilopt = 1 ceilmin = 1500. dzfill = 3000. refrain = 30. radsetrat = 0.50 radreflim = 50. radptgain = 1.0 cloudopt = 0 clddiag = 1 range_cld = 100.0E03 refthr1 = 25.0 refthr2 = 10.0 hgtrefthr = 2000.0 wmhr_cu = 0.0005 wmhr_sc = 0.00005 wc_st = 0.05 bgqcopt = 1 cldqvopt = 1 cldwopt = 0 cldqcopt = 1 cldqropt = 1 cldptopt = 1 smth_opt = 1 thresh_cvr = 0.65 rh_thr1 = 0.5 cvr2rh_thr1 = 0.2 rh_thr2 = 0.95 cvr2rh_thr2 = 0.65 frac_qw_2_pt = 1.0 frac_qc_2_lh = 1.0 max_lh_2_pt = 4.0 qvslimit_2_qc = 1.0 qrlimit = 0.010 frac_qr_2_qc = 0.5 DO i=1,mx_nvar_anx kpvar(i)=1.0 END DO ! sfcqcrng = 100.e03 DO i=1,mx_pass ianxtyp(i)=21 xyrange(i)=100.e03 zrange(i)=500. thrng(i)=3.0 trnropt(i)=1 trnrcst(i)=500. trnrng(i)=1.2 END DO ! backerrfil='ruc3herr.adastab' ! blackfil='blacklist.sfc' nsngfil=0 DO i=1,mx_sng_file sngfname(i)='NULL' sngtmchk(i)='NULL' END DO DO i=1,nsrc_sng srcsng(i)='NULL' sngerrfil(i)='NULL' END DO DO i=0,nsrc_sng DO j=1,npass iusesng(i,j)=0 END DO END DO ! nsngfil=0 DO i=1,mx_ua_file uafname(i)='NULL' END DO DO i=1,nsrc_ua srcua(i)='NULL' uaerrfil(i)='NULL' END DO DO i=0,nsrc_ua DO j=1,npass iuseua(i,j)=0 END DO END DO ! nradfil=0 DO i=1,mx_rad radfname(i)='NULL' END DO DO i=1,nsrc_rad srcrad(i)='NULL' raderrfil(i)='NULL' END DO DO i=0,nsrc_rad DO j=1,npass iuserad(i,j)=0 END DO END DO ! nretfil=0 DO i=1,mx_ret retfname(i)='NULL' END DO DO i=1,nsrc_ret srcret(i)='NULL' reterrfil(i)='NULL' END DO DO i=0,nsrc_ret DO j=1,npass iuseret(i,j)=0 END DO END DO ! cld_files=0 nirfiles=0 nvisfiles=0 DO isat=1,mx_sat ir_fname(isat)='NULL' vis_fname(isat)='NULL' viscalname(isat)='NULL' ircalname(isat)='NULL' END DO ! incdmpf='NULL' incrdmp = 0 incrhdfcompr = 0 uincdmp = 1 vincdmp = 1 wincdmp = 0 pincdmp = 1 ptincdmp= 1 qvincdmp= 1 qcincdmp= 1 qrincdmp= 1 qiincdmp= 1 qsincdmp= 0 qhincdmp= 0 ! !----------------------------------------------------------------------- ! read in ADAS namelists !----------------------------------------------------------------------- ! IF(myproc == 0) & READ(5, incr_out, END=201) IF(myproc == 0) & WRITE(6,*) 'Namelist block incr_out sucessfully read.' 201 CONTINUE CALL mpupdatei(incrdmp,1) CALL mpupdatei(incrhdfcompr,1) CALL mpupdatec(incdmpf,256) CALL mpupdatei(uincdmp,1) CALL mpupdatei(vincdmp,1) CALL mpupdatei(wincdmp,1) CALL mpupdatei(pincdmp,1) CALL mpupdatei(ptincdmp,1) CALL mpupdatei(qvincdmp,1) CALL mpupdatei(qcincdmp,1) CALL mpupdatei(qrincdmp,1) CALL mpupdatei(qiincdmp,1) CALL mpupdatei(qsincdmp,1) CALL mpupdatei(qhincdmp,1) IF(myproc == 0) & READ(5, adas_const, END=200) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_const sucessfully read.' 200 CONTINUE CALL mpupdatei(npass,1) CALL mpupdater(sprdist,1) CALL mpupdater(wlim,1) CALL mpupdater(zwlim,1) CALL mpupdater(thwlim,1) CALL mpupdatei(spradopt,1) CALL mpupdatei(ccatopt,1) IF(myproc == 0) & READ(5, adjust, END=205) IF(myproc == 0) & WRITE(6,*) 'Namelist block adjust sucessfully read.' 205 CONTINUE CALL mpupdatei(hydradj,1) CALL mpupdatei(wndadj,1) CALL mpupdatei(obropt,1) CALL mpupdater(obrzero,1) IF(myproc == 0) & READ(5, adas_radaropt, END=210) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_radaropt sucessfully read.' 210 CONTINUE CALL mpupdatei(raduvobs,1) CALL mpupdatei(radrhobs,1) CALL mpupdatei(radistride,1) CALL mpupdatei(radkstride,1) CALL mpupdater(refrh,1) CALL mpupdater(rhradobs,1) CALL mpupdatei(radcldopt,1) CALL mpupdatei(radqvopt,1) CALL mpupdatei(radqcopt,1) CALL mpupdatei(radqropt,1) CALL mpupdatei(radptopt,1) CALL mpupdater(refsat,1) CALL mpupdater(rhrad,1) CALL mpupdater(refcld,1) CALL mpupdater(cldrad,1) CALL mpupdater(ceilopt,1) CALL mpupdater(ceilmin,1) CALL mpupdater(dzfill,1) CALL mpupdater(refrain,1) CALL mpupdater(radsetrat,1) CALL mpupdater(radreflim,1) CALL mpupdater(radptgain,1) IF(myproc == 0) & READ(5, adas_cloud, END=220) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_cloud sucessfully read.' 220 CONTINUE CALL mpupdatei(cloudopt,1) CALL mpupdatei(clddiag,1) CALL mpupdatei(cld_files,1) CALL mpupdater(range_cld,1) CALL mpupdater(refthr1,1) CALL mpupdater(refthr2,1) CALL mpupdater(hgtrefthr,1) CALL mpupdater(thresh_cvr,1) CALL mpupdatei(bgqcopt,1) CALL mpupdatei(cldqvopt,1) CALL mpupdater(rh_thr1,1) CALL mpupdater(cvr2rh_thr1,1) CALL mpupdater(rh_thr2,1) CALL mpupdater(cvr2rh_thr2,1) CALL mpupdatei(cldqcopt,1) CALL mpupdater(qvslimit_2_qc,1) CALL mpupdatei(cldqropt,1) CALL mpupdater(qrlimit,1) CALL mpupdater(frac_qr_2_qc,1) CALL mpupdatei(cldwopt,1) CALL mpupdater(wmhr_Cu,1) CALL mpupdater(wmhr_Sc,1) CALL mpupdater(wc_St,1) CALL mpupdatei(cldptopt,1) CALL mpupdater(frac_qw_2_pt,1) CALL mpupdater(frac_qc_2_lh,1) CALL mpupdater(max_lh_2_pt,1) CALL mpupdatei(smth_opt,1) CALL mpupdatei(nirfiles,1) CALL mpupdatec(ir_fname,256*mx_sat) CALL mpupdatec(ircalname,256*mx_sat) CALL mpupdatei(nvisfiles,1) CALL mpupdatec(vis_fname,256*mx_sat) CALL mpupdatec(viscalname,256*mx_sat) IF(myproc == 0) & READ(5, adas_typ, END=240) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_typ sucessfully read.' 240 CONTINUE CALL mpupdatei(ianxtyp,mx_pass) IF(myproc == 0) & READ(5, adas_range, END=250) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_range sucessfully read.' 250 CONTINUE CALL mpupdater(sfcqcrng,1) CALL mpupdater(xyrange,mx_pass) IF(myproc == 0) & READ(5, adas_kpvar, END=255) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_kpvar sucessfully read.' 255 CONTINUE CALL mpupdater(kpvar,nvar_anx) IF(myproc == 0) & READ(5, adas_zrange, END=260) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_zrange sucessfully read.' 260 CONTINUE CALL mpupdater(zrange,mx_pass) IF(myproc == 0) & READ(5, adas_thrng, END=270) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_thrng sucessfully read.' 270 CONTINUE CALL mpupdater(thrng,mx_pass) IF(myproc == 0) & READ(5, adas_trnrng, END=280) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_trnrng sucessfully read.' 280 CONTINUE CALL mpupdatei(trnropt,mx_pass) CALL mpupdater(trnrcst,mx_pass) CALL mpupdater(trnrng,mx_pass) IF(myproc == 0) & READ(5, adas_backerf, END=300) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_backerf sucessfully read.' 300 CONTINUE CALL mpupdatec(backerrfil,256) IF(myproc == 0) & READ(5, adas_sng, END=310) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_sng sucessfully read.' 310 CONTINUE CALL mpupdatei(srcsng,nsrc_sng) CALL mpupdatec(sngerrfil,256*nsrc_sng) CALL mpupdatei(iusesng,(nsrc_sng+1)*mx_pass) IF(myproc == 0) & READ(5, adas_ua, END=320) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_ua sucessfully read.' 320 CONTINUE CALL mpupdatei(srcua,nsrc_sng) CALL mpupdatec(uaerrfil,256*mx_ua_file) CALL mpupdatei(iuseua,(nsrc_ua+1)*mx_pass) IF(myproc == 0) & READ(5, adas_radar, END=330) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_radar sucessfully read.' 330 CONTINUE CALL mpupdatei(nradfil,1) CALL mpupdatec(radfname,256*mx_rad) CALL mpupdatei(srcrad,nsrc_rad) CALL mpupdatec(raderrfil,256*nsrc_rad) CALL mpupdatei(iuserad,(nsrc_rad+1)*mx_pass) IF(myproc == 0) & READ(5, adas_retrieval, END=340) IF(myproc == 0) & WRITE(6,*) 'Namelist block adas_retrieval sucessfully read.' 340 CONTINUE CALL mpupdatei(nretfil,1) CALL mpupdatec(retfname,256*mx_ret) CALL mpupdatei(srcret,nsrc_ret) CALL mpupdatec(reterrfil,256*mx_ret) CALL mpupdatei(iuseret,(nsrc_ret+1)*mx_pass) !----------------------------------------------------------------------- ! Compute squared input variables !----------------------------------------------------------------------- DO i=1,mx_nvar_anx kpvrsq(i)=kpvar(i)*kpvar(i) END DO RETURN END SUBROUTINE initadas ! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE RADINF ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE radinf (rlim) 1 !----------------------------------------------------------------------- ! ! PURPOSE: ! For MPI message passing efficiency, we need to know the maximum ! possible radii of influence that any any grid point will have so we ! know processors need to communicate. ! ! For the non-MPI case, this subroutine has no meaning, and isn't used. ! ! AUTHOR: ! Steve Leyton, CAPS, August, 2005. ! ! MODIFICATION HISTORY: ! 10/06/2006 Add cloud information into the computations. ! !----------------------------------------------------------------------- ! ! Variable Declarations: ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! INCLUDE 'globcst.inc' INCLUDE 'grid.inc' ! Grid parameters INCLUDE 'phycst.inc' INCLUDE 'mp.inc' ! Message passing parameters. ! INCLUDE 'adas.inc' INCLUDE 'adassat.inc' INCLUDE 'adjust.inc' ! REAL :: rlim ! 1st pass radius of influence REAL :: rpass, rsq, rlimsq REAL :: rngsqi REAL :: max_xyrange INTEGER :: i ! ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Identify the maximum xyrange for all passes, then use to compute ! the maximum radius of influence for the given data type max_xyrange=xyrange(1) DO i = 2,npass IF (xyrange(i) .gt. max_xyrange) THEN max_xyrange=xyrange(i) END IF END DO rpass=max_xyrange*max_xyrange rlimsq=0. DO i=1,nvar_anx rsq=(kpvrsq(i)*rpass) rngsqi =1./rsq rlimsq=AMAX1(rlimsq,rsq) END DO rlimsq=-rlimsq*ALOG(wlim) rlim=SQRT(rlimsq) IF (cloudopt > 0) THEN ! ! "dx" and "dy" should always be the same, but just to be safe, make sure ! we have the larger of the two. ! rsq = dx IF (dy > rsq) rsq = dy rsq = rsq * i_perimeter IF (rsq > rlim) rlim = rsq END IF IF (myproc == 0) & WRITE(6,'(/a,f10.2,a/)') 'Influence cutoff radius (all data): ',rlim,' m.' RETURN END SUBROUTINE radinf