From a23d3620c7f38ec701bf365a5b8f3d4857425a21 Mon Sep 17 00:00:00 2001 From: "Judy.K.Henderson" Date: Fri, 26 Jun 2020 22:25:12 +0000 Subject: [PATCH] Merged with 26Jun feature/gfsv16b branch MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Corrected setting of nwat for Thompson MP in config.fcst Squashed commit of the following: commit 28b1faf03c5ad12e4e9a44f1d02c754f1441ebc7 Author: fanglin.yang Date: Fri Jun 26 02:31:18 2020 +0000 modified: config.vrfy to add elif [ $machine = "HERA" ] ; then export RUNGFSMOSSH="$HOMEgfs/scripts/run_gfsmos_master.sh.hera" commit 61f4a52e299482687d84ef6686e6a65f64fe57f3 Author: fanglin.yang Date: Fri Jun 26 02:21:33 2020 +0000 corrected a typo in hpssarch_gen.sh - echo "${dirname}${head}atma000.ensres${SUFFIX} " >>gdas.txt + echo "${dirname}${head}atma009.ensres${SUFFIX} " >>gdas.txt commit b10a9306b732e543d2be3b932d556ebcdcbe8a5e Author: fanglin.yang Date: Thu Jun 25 20:25:30 2020 +0000 modified: config.vrfy to point a different syndat directory on Hera export COMROOTp1="/scratch1/NCEPDEV/global/glopara/com" export COMINsyn=${COMINsyn:-${COMROOTp1}/gfs/prod/syndat} commit b8192e54988f2fb2f4cda0510af02a090dfdda2e Author: russ.treadon Date: Thu Jun 25 18:20:01 2020 +0000 Issue #1: HPSS archive and MOS script changes * replace enkf member atmi*nc with ratmi*nc in HPSS enkf tarballs * add ensemble resolution analysis to HPSS gdas tarball * allow variable range to be externally set in run_gfsmos_master scripts commit e599c368a2d55018e4a1567717efd7ffa09f14d9 Merge: 99277ae3 1e56eddb Author: Kate Friedman Date: Wed Jun 24 14:16:22 2020 -0400 Merge pull request #93 from JessicaMeixner-NOAA/bugfix/exiterr fix for exiting properly with error for wave prep/init scripts commit 1e56eddb055b1414385e276ac73255d3ede9e9e9 Author: JessicaMeixner-NOAA Date: Wed Jun 24 12:36:53 2020 -0500 fix for exiting properly with error for wave prep/init scripts commit 99277ae34ef50454fa15e7e28b564c2e34e3406c Merge: 14dd3c94 4f8d5a5f Author: fanglin.yang Date: Tue Jun 23 16:05:16 2020 +0000 Merge branch 'feature/gfsv16b' of https://github.com/NOAA-EMC/global-workflow into feature/gfsv16b commit 4f8d5a5f28c7120905fe36e9254f0199da986188 Author: Kate Friedman Date: Tue Jun 23 11:57:26 2020 -0400 Update README.md Remove use/mention of manage_externals until checkout.sh is retired. commit 14dd3c94938b0e69601e25a42104b2fc23944ebd Author: fanglin.yang Date: Tue Jun 23 15:53:11 2020 +0000 modified: Externals.cfg and sorc/checkout.sh to check out model tag GFS.v16.0.7 and UPP tag upp_gfsv16_release.v1.0.9. Changes include: 1) Inline POST Issues #136 and $142 * Update ceiling height calculation for global FV3. * add low,middle,high instantaneous cloud fraction * add radar reflectivity at model layers 1 and 2 , and radar reflectivities at 1 and 4-km height. * fix a bug in initializing DBZI * output mixed layer CAPE/CIN * remove simulated GOES-12 brightness temperature. * change the names of time averaged low/mid/high cloud fractions in grib2 files from "TCDC" to "LCDC/MCDC/HCDC", respectively. 2) Model Issue #152 * update in-line post control files * upgrade post library to 8.0.9 for hera and wcoss_dell_p3 commit dd76002425a03905bfc6ef63d3f43a6813814497 Merge: df89cc80 dd599eaa Author: Kate Friedman Date: Tue Jun 23 11:34:40 2020 -0400 Merge pull request #91 from christopherwharrop-noaa/feature/fix_externals Update version of upp in Externals.cfg to be consistent with sorc/che… commit dd599eaa4f379e1eb8fc5e057f7904b0e6290d48 Author: Christopher Harrop Date: Tue Jun 23 15:25:08 2020 +0000 Update version of upp in Externals.cfg to be consistent with sorc/checkout.sh commit df89cc800d3c479c132a5e679a2562af91b32f62 Author: RussTreadon-NOAA <26926959+RussTreadon-NOAA@users.noreply.github.com> Date: Fri Jun 19 18:40:26 2020 -0400 Update config.resources Generalize setting of echgres threads to be maximum permitted on given platform instead of explicitly setting echgres threads on every platform. commit ff8cd28365377f0ceed87ff8b4b9a9b4b6e91368 Merge: 1dd83b81 965ff420 Author: russ.treadon Date: Thu Jun 18 20:07:59 2020 +0000 Issue #1: merge branch 'feature/chgresfcst' at 965ff42 into feature/gfsv16b commit 965ff4203f132c6b032398a7a56494329714247c Author: russ.treadon Date: Thu Jun 18 20:02:23 2020 +0000 Issue #85: update DA checkout to point at release/gfsda.v16.0.0 commit 71d714119960feed1f0807708cdf85677ab81d73 Author: russ.treadon Date: Tue Jun 16 20:11:33 2020 +0000 Issue #85: (1) rename "chgresfcst" as "echgres", (2) add chgres variables to env commit 1dd83b818e9f2babbd11b762951721cf2a4c415e Author: fanglin.yang Date: Tue Jun 16 16:07:45 2020 +0000 modified: run_gfsmos_master.sh.dell to still set range=both as the default for running the real-time parallel commit eb0e3b4d009047251c535eea6fdc5958e58e68f7 Author: fanglin.yang Date: Tue Jun 16 14:43:29 2020 +0000 update checkout.sh to switch back to post version upp_gfsv16_release.v1.0.8. 1.0.9 still has issues. commit dfc76f0715a29e52e4d7133a8259c492229a5c22 Author: Kate.Friedman Date: Tue Jun 16 13:32:01 2020 +0000 Issue #1 - sync Externals.cfg with checkout.sh update for FV3 GFSv16.0.6 tag commit 7078bb5c680d54297101fae573579be24411a94a Author: fanglin.yang Date: Tue Jun 16 13:22:43 2020 +0000 modified: scripts/run_gfsmos_master.sh.dell to set default verification type o short. modified: sorc/checkout.sh updated to model tag GFS.v16.0.6 to fix contrib issue on HERA commit 15d5bed4119b067905f5a4bf47656557f2211883 Author: russ.treadon Date: Mon Jun 15 20:47:47 2020 +0000 Issue #85: add cfp option to chgresfcst; enable threads with chgresfcst commit d8782697fa698c00daa242a656246cf5f5d9b537 Author: Kate.Friedman Date: Mon Jun 15 16:00:35 2020 +0000 Issue #1 - update Externals.cfg to match updates to checkout.sh commit a2bd621727701e9526feccc7ce8ebd43be31860f Merge: 22b735d3 295cd05f Author: Kate Friedman Date: Mon Jun 15 11:57:14 2020 -0400 Merge pull request #84 from NOAA-EMC/feature/gfsv16b_herawavepost Adapting wavepostsbs for running on Hera commit 295cd05f306e4d70d09880a41fd60fadce74bab3 Author: Jose-Henrique Alves <47567389+ajhenrique@users.noreply.github.com> Date: Mon Jun 15 11:53:13 2020 -0400 Update exwave_post_sbs.sh Removing obsolete nm variable entries commit 22b735d310413989568dca4b30d19eadcd4c3fdb Author: fanglin.yang Date: Fri Jun 12 20:06:49 2020 +0000 modified: checkout.sh to check out upp_gfsv16_relaese.v1.0.9 output cloud ceiling height and instant total cloud fraction. output instant cloud fraction at low/mid/high cloud layer. correct grib2 names of time averaged cloud fraction fraction at low/mid/high cloud layer from "TCDC" into "LCDC, MCDC, HCDC". output radar reflectivity at 1/4 km above ground and model layer 1/2. output mixed layer CAPE/CIN. Remove simulated GOES-12 brightness temperature from gfs product. Add the bug fix of initializing DBZI from Ruiyu. commit 10ce1d4140c7c0fe795ded39e1fa550e0c202c59 Author: Kate.Friedman Date: Thu Jun 11 18:42:22 2020 +0000 Issue #1 - Hotfix to update anaconda module contrib path on Hera commit 58d1139c196f92bd4bb149008a8d61eb6457fb3c Author: henrique.alves Date: Thu Jun 11 02:44:41 2020 +0000 Adapting wavepostsbs for running on Hera commit c330e60197c38acb724cfdf4a30a20417a6618b4 Author: CoryMartin-NOAA Date: Wed Jun 10 21:17:00 2020 +0000 add checkout.sh to test on Dell commit 201609b2d43acd13a08bf1d5ab2251db90a11d32 Author: CoryMartin-NOAA Date: Wed Jun 10 20:51:51 2020 +0000 Commit changes from debugging addition of chgresfcst on hera commit 4405a2c74c8b5a40ee6edd7b4c2faba9bd41b59c Author: russ.treadon Date: Wed Jun 10 14:36:03 2020 +0000 Issue #1: update parm/config/config.base.emc.dyn to be consistent with GFS v16 real-time parallel config.base commit fc3066c2b7a5edd9f0d510b88f8542b07b8a8589 Author: CoryMartin-NOAA Date: Wed Jun 10 14:19:07 2020 +0000 First draft to add chgresfcst to rocoto workflow commit 9f2e4ecfe5799e13a4f6b9e80f7ff3e7b4a3633c Author: russ.treadon Date: Mon Jun 8 00:34:07 2020 +0000 Issue #1: correct typo in scripts/exwave_prep.sh commit 5a8b8f2e80532b7e446c51a69dcb83c7a212395d Author: russ.treadon Date: Mon Jun 8 00:15:31 2020 +0000 Issue #1: check for existence of 0p50 and 1p00 pgrb files before attempting to write to HPSS commit a7306aa93d537da5b165297e0dc34ba88856d4c7 Author: fanglin.yang Date: Sun Jun 7 23:22:53 2020 +0000 modified: jobs/rocoto/post.sh wait for 5 minutes if forecast history file does not exist before exit modified: modulefiles/module_base.hera use GV's temporal build of netcdfp/4.7.4 and esmflocal/8.0.1.08bs on HERA modified: parm/config/config.base.emc.dyn add restart_interval_gfs=0 to config.base. It is used by config.fcst and config.wave modified: parm/config/config.fcst -- fix a bug related to setting npe_wav for gfsfcst. if [ "$CDUMP" = "gfs" ]; then npe_wav=$npe_wav_gfs ; fi -- set io_layout="4,4" for writing gfs restart files modified: parm/config/config.wave set WAVE restart frequency based on restart_interval_gfs (by H. Alves). commit 1082885b082e8a837aef095deb6a3343fca26cb3 Merge: 968b9860 bf5a5c44 Author: Fanglin Yang Date: Thu Jun 4 20:26:47 2020 -0400 Merge pull request #83 from NOAA-EMC/feature/gfsv16b_restart revive GFS forecast break-point restart capability with IAU turned on commit bf5a5c44bdebff5663225e9e9548ba83f498f7cd Merge: b27a01db 968b9860 Author: fanglin.yang Date: Thu Jun 4 23:36:52 2020 +0000 Merge branch 'feature/gfsv16b' of https://github.com/NOAA-EMC/global-workflow into feature/gfsv16b_restart commit 968b98609fe2016518f3adcc6b178bdca0b73bcf Merge: 9b36cfde dc512dd6 Author: Guang Ping Lou Date: Thu Jun 4 19:20:53 2020 +0000 Merge branch 'feature/gfsv16b' of https://github.com/NOAA-EMC/global-workflow into feature/gfsv16b commit 9b36cfde2032e9296cc7567704e1274560b2897e Author: Guang Ping Lou Date: Thu Jun 4 19:12:56 2020 +0000 Unify output path in gfs_bfr2gpk.sh commit 7675368c3f7f3942b7f8a57bad4c29a38cef48fa Author: Guang Ping Lou Date: Thu Jun 4 19:11:23 2020 +0000 remove station elevation adjustment to T,Q and evaporation bug fix commit dc512dd68df088361c340ac01ec3c8130707ffd1 Merge: a7b25a3b 987c32af Author: Fanglin Yang Date: Thu Jun 4 12:55:33 2020 -0400 Merge pull request #82 from NOAA-EMC/feature/gfsv16b_wavehera Adjustment to wave workflow for running wave component on Hera commit 987c32af7c7e94c53f50d20e1ad3c8b27e2c9afb Author: Jose-Henrique Alves <47567389+ajhenrique@users.noreply.github.com> Date: Thu Jun 4 12:08:05 2020 -0400 Updating checkout to ufs-weather-model GFS.v16.0.5 commit a7b25a3bb0b7b5f1b8a15204ff1e7c061ea1199a Author: Mallory Row Date: Thu Jun 4 14:59:22 2020 +0000 modified: checkout.sh to check out METplus verification tag verif_global_v1.8.0 commit 0acee674759a5e2c8fbd4ec7b1cdd0459f95e2bd Author: russ.treadon Date: Wed Jun 3 20:10:09 2020 +0000 Issue #1: remove redundant entry from config.ediag; update checkout.sh to pull GFS v16 DA from github commit b27a01db1516f9aa229e75957885ffa2125d31d6 Author: fanglin.yang Date: Wed Jun 3 16:58:29 2020 +0000 modified: parm/config/config.fcst modified: scripts/exglobal_fcst_nemsfv3gfs.sh GFS forecast restrat capability from a breakpoint is no longer working with IAU turned on. This function has been overhauled to make it more general and works for cases with and without IAU commit ba895481be53906878f58c2998a398bc59870ea2 Author: Jose-Henrique Alves <47567389+ajhenrique@users.noreply.github.com> Date: Wed Jun 3 09:59:35 2020 -0400 Update JWAVE_PREP Removing lines using for testing presence of files while debugging. commit bb79d7a33c423770f4972c9c643c5dfa7fb0f3be Author: wx20ha Date: Wed Jun 3 02:45:33 2020 +0000 Fixing a few minor bugs in wave_tar.sh after testing on WCOSS commit 8dc2e255e77a55c0f7d90a5018f769ade1e83a9f Author: fanglin.yang Date: Wed Jun 3 01:41:18 2020 +0000 add new file: run_gfsmos_master.sh.hera commit 3393cac802b289cb9b6867c003ff27ef1711327a Author: henrique.alves Date: Thu May 28 00:01:51 2020 +0000 Correcting minor bug in wave_prn_cur.sh Adjusting indents in exwave_prep.sh Adding defaults for current processing in conif.waveprep. commit 32c5f29b62cf747662909ff50a6bf8f327127a09 Merge: 49abb906 e87b5a18 Author: henrique.alves Date: Wed May 27 17:40:34 2020 +0000 Merging latest feature/gfsv16b branch into feature/gfsv16b_wavehera commit 49abb9068effc5aeeba8f861f44207b67ff442c9 Author: henrique.alves Date: Wed May 27 17:36:12 2020 +0000 Adding comment indicating how to regenerate cdo interpolation weights. commit e87b5a18f9dbad2230b9d3324f0c48a7b25d9b62 Author: wx20ha Date: Wed May 27 02:01:57 2020 +0000 JWAVE_PREP updated to use CDO_ROOT defined in config config.waveprep updated to default to WCOSS rtofs operational cdo if no module found wave_prnc_cur.sh bug fixed now provides proper fhr in temp file names exwave_prep.sh adjusted for WCOSS and Hera. commit 70d71310132813c1066a9b0f881ef686602a23c4 Author: russ.treadon Date: Tue May 26 20:39:33 2020 +0000 Issue #1: remove "_break" from commented out lines in config.anal and config.prep. "_break" will cause failue if line active commit 914cb8dff96e45e690c8e1a2932c8d846afb1655 Author: russ.treadon Date: Tue May 26 20:37:27 2020 +0000 Issue #1: correct typo in parm/config/config.anal commit 2e12e63b13533a8a1b741bf55cbbaba49beb14cc Author: russ.treadon Date: Tue May 26 19:18:57 2020 +0000 Issue #1: update config.anal logic to point ABIBF at the correct GDA directory commit 38cd82133b64af289648ca5e88fde1ac3dcaeab0 Author: russ.treadon Date: Tue May 26 18:04:59 2020 +0000 Issue #1: update config files * parm/config/config.anal - add logic to use correct global_convinfo.txt prior to GFS v15.3 implementation (2020052612) * parm/config/config.awips - set NAWIPSGRP to equal NPOSTGRP (config.post) * parm/config/config.fcst - add double quotes around CDUMP on levs test to prevent setup_workflow.py runtime error commit 0dff61f103bab78f9d2426599f976dc318eff4e0 Author: fanglin.yang Date: Mon May 25 03:08:27 2020 +0000 modified: config.fv3 to reduce tasks assigned to the WAVE component. 70 tasks at C768 is adequate for wave. commit 20ef779fd90a267affc0e80ae1f8a3f64afd2f8d Author: henrique.alves Date: Fri May 22 19:52:55 2020 +0000 Redefining mpmd command for working on Hera with slurm Adapting wave scripts to execute mpmd command on Hera Adjusting wave_prnc_cur.sh for properly catting files on Hera commit e248236b233b6bcf2dc008006a82ccd459d7e3f3 Author: fanglin.yang Date: Fri May 22 15:23:59 2020 +0000 modified: config.fcst to set if [ $LEVS = "128" -a $CDUMP = "gdas" ]; then ... lheatstrg=".false." commit 96460e6e5f4b09b9fd10d39550bf022dc62c37ab Author: russ.treadon Date: Fri May 22 13:02:06 2020 +0000 Issue #1: replace "nawips" with "gempak" in hpssarch_gen.sh path to gfs sfc and snd files commit 7222f84041f2a2f221e85d6543657f229408328c Author: fanglin.yang Date: Thu May 21 14:09:36 2020 +0000 modified: checkout.sh to check out modle tag GFS.v16.0.4. changes include: 1. Remove constraints on mixing length and background diffusitivity over inversion layers on land 2. Enhance mass flux for deep convection, hence to increase subsidzing warming to reduce cold bias in the lower tropospehre 3. Fix a RRTMg solar radiaiton bug which has impact in SW abosrption in the UV region in the upper atmospehre. commit 4fa08a77e59660f4b58279375a83d179c891b385 Author: fanglin.yang Date: Wed May 20 01:20:21 2020 +0000 modified: HERA.env to add export CFP_MP="YES" # For analdiag with SLURM commit 9f7df9d3552fd971cde09148bc392ad93bf104e0 Author: fanglin.yang Date: Mon May 18 15:06:19 2020 +0000 modified: checkout.sh to check out upp_gfsv16_release.v1.0.8 1) Add configuration for Orion. 2) Make fields at isobaric levels have 41 vertical levels for all forecast hours and analysis in pgrb2 dataset. 3) Remove SPFH at isobaric levels from pgrb2b dataset. commit 5e4a1335ef3feb0242245b5661f22650a0a2e576 Author: Mallory Row Date: Fri May 15 13:08:25 2020 +0000 modified: checkout.sh to check out METplus verification tag verif_global_v1.7.2 commit 42913497cbb82435318797ee2148ec35311e8ea6 Author: fanglin.yang Date: Tue May 12 03:05:17 2020 +0000 modified: checkout.sh to check out gldas_gfsv16_release.v1.2.0. commit 0c0614cd03e6ee178275b85be7636f842f1eb77e Author: russ.treadon Date: Fri May 8 18:29:07 2020 +0000 Issue #1: change number of tasks for analdiag and ediag to 112 and 56, respectively in config.resources commit a601acda14b2c8c58d2d3ae484fa57812bf8801a Author: emc.glopara Date: Fri May 8 04:17:27 2020 +0000 updated config.vrfy to point to the fit2obs version that supports reading netcdf history files export fitdir="$BASE_GIT/verif/global/Fit2Obs/ncf-vqc/batrun" export PREPQFITSH="$fitdir/subfits_hera_slurm" commit ad86a552ac5893e2c57a36772b94d3e05ccf4d33 Author: Mallory Row Date: Wed May 6 15:28:49 2020 +0000 modified: checkout.sh to check out METplus verification tag verif_global_v1.7.1 commit 20572b53aab8579b20aaf4e365c59f32fd386b5f Author: russ.treadon Date: Fri May 1 19:08:23 2020 +0000 Issue #1: update files written to enkf HPSS tarballs to be consistent with GFS v16 DA updates commit 20baab7ab7f7c151330cea30027b90ff30bfc83b Author: fanglin.yang Date: Wed Apr 29 18:49:05 2020 +0000 modified: checkout.sh to check out model tag GFS.v16.0.3 In Sfc_diff.f, a bug was introduced when the surface layer scheme was updated last time to reduce 2-m temperature cold biases. The bug only has impact over sea-ice points, where momentum and thermal roughness are nevertheless very small. commit af6346497abe1d05d408c8c2b819427120a22961 Author: fanglin.yang Date: Tue Apr 28 18:18:44 2020 +0000 modified: qctropcy.f by Qingfu Liu A bug was found that the history files (syndat_stmcat , syndat_stmcat.scr) save the first and last storm ID used. If the FORTRAN code finds that the storm ID has been used in the current hurricane season, the code will change the storm ID by adding 1 to the original storm ID. The fix is to skip the change of the storm ID. See also https://github.com/NOAA-EMC/global-workflow/issues/63 --- sorc/enkf_chgres_recenter_nc.fd/setup.f90 | 6 +- sorc/gfs_bufr.fd/gfsbufr.f | 6 +- sorc/gfs_bufr.fd/meteorg.f | 299 +++++++--------------- sorc/syndat_qctropcy.fd/qctropcy.f | 82 +----- 4 files changed, 117 insertions(+), 276 deletions(-) diff --git a/sorc/enkf_chgres_recenter_nc.fd/setup.f90 b/sorc/enkf_chgres_recenter_nc.fd/setup.f90 index 4bb1a025..1ea5b98a 100644 --- a/sorc/enkf_chgres_recenter_nc.fd/setup.f90 +++ b/sorc/enkf_chgres_recenter_nc.fd/setup.f90 @@ -23,6 +23,7 @@ subroutine program_setup implicit none integer :: istat + character(len=500) :: filenamelist namelist /chgres_setup/ i_output, j_output, input_file, output_file, & terrain_file, vcoord_file, cld_amt @@ -30,8 +31,9 @@ subroutine program_setup cld_amt = .false. ! default option print* - print*,"OPEN SETUP NAMELIST." - open(43, file="./chgres_nc_gauss.nml", iostat=istat) + call getarg(1,filenamelist) + print*,"OPEN SETUP NAMELIST ",trim(filenamelist) + open(43, file=filenamelist, iostat=istat) if (istat /= 0) then print*,"FATAL ERROR OPENING NAMELIST FILE. ISTAT IS: ",istat stop diff --git a/sorc/gfs_bufr.fd/gfsbufr.f b/sorc/gfs_bufr.fd/gfsbufr.f index a01a91fd..08591b91 100755 --- a/sorc/gfs_bufr.fd/gfsbufr.f +++ b/sorc/gfs_bufr.fd/gfsbufr.f @@ -212,7 +212,7 @@ program meteormrf error=nf90_inq_dimid(ncid,"pfull",dimid) error=nf90_inquire_dimension(ncid,dimid,dim_nam,levsi) error=nf90_close(ncid) -!! print*,'NetCDF file im,jm,lm= ',im,jm,levs,levsi + print*,'NetCDF file im,jm,lm= ',im,jm,levs,levsi else call nemsio_init(iret=irets) @@ -239,7 +239,7 @@ program meteormrf call meteorg(npoint,rlat,rlon,istat,cstat,elevstn, & nf,nfile,fnsig,jdate,idate, - & levs,levsi,im,jm,nsfc, + & levsi,im,jm,nsfc, & landwater,nend1, nint1, nint3, iidum,jjdum, & fformat,iocomms(ntask),iope,ionproc) call mpi_barrier(iocomms(ntask), ierr) @@ -248,7 +248,7 @@ program meteormrf !! For nemsio input call meteorg(npoint,rlat,rlon,istat,cstat,elevstn, & nf,nfile,fnsig,jdate,idate, - & levs,levsi,im,jm,nsfc, + & levs,im,jm,nsfc, & landwater,nend1, nint1, nint3, iidum,jjdum, & fformat,iocomms(ntask),iope,ionproc) endif diff --git a/sorc/gfs_bufr.fd/meteorg.f b/sorc/gfs_bufr.fd/meteorg.f index c4b1f3e3..82a736b5 100755 --- a/sorc/gfs_bufr.fd/meteorg.f +++ b/sorc/gfs_bufr.fd/meteorg.f @@ -1,6 +1,6 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, & nf,nfile,fnsig,jdate,idate, - & levso,levs,im,jm,kdim, + & levs,im,jm,kdim, & landwater,nend1,nint1,nint3,iidum,jjdum, & fformat,iocomms,iope,ionproc) @@ -31,8 +31,10 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, ! 2018-03-27 GUANG PING LOU CHANGE STATION ELEVATION CORRECTION LAPSE RATE FROM 0.01 TO 0.0065 ! 2018-03-28 GUANG PING LOU GENERALIZE TIME INTERVAL ! 2019-07-08 GUANG PING LOU ADDED STATION CHARACTER IDS -! 2019-10-08 GUANG PING LOU MODIFY TO READ IN NetCDF FILES. REMOVE NEMSIO +! 2019-10-08 GUANG PING LOU MODIFY TO READ IN NetCDF FILES. RETAIN NEMSIO ! RELATED CALLS AND CLEAN UP THE CODE. +! 2020-04-24 GUANG PING LOU Clean up code and remove station height +! adjustment ! ! USAGE: CALL PROGRAM meteorg ! INPUT: @@ -44,7 +46,6 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, ! nf - forecast cycle ! fnsig - sigma file name ! idate(4) - date -! levso - output vertical layers ! levs - input vertical layers ! kdim - sfc file dimension ! @@ -68,7 +69,7 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, type(nemsio_gfile) :: gfile type(nemsio_gfile) :: ffile type(nemsio_gfile) :: ffile2 - integer :: nfile,npoint,levso,levs,kdim + integer :: nfile,npoint,levs,kdim integer :: nfile1 integer :: i,j,im,jm,kk,idum,jdum,idvc,idsl ! idsl Integer(sigio_intkind) semi-lagrangian id @@ -78,36 +79,32 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, integer :: idate(4),nij,nflx,np,k,l,nf,nfhour,np1 integer :: idate_nems(7) integer :: iret,jdate,leveta,lm,lp1 - integer :: ie,iw,jn,js character*150 :: fnsig,fngrib - real*8 :: data(6*levso+25) + real*8 :: data(6*levs+25) real*8 :: rstat1 character*8 :: cstat1 character*4 :: cstat(npoint) - real :: fhour,pp,ppn,qs,qsn,esn,es,psfc,ppi,dtemp,iwx,nd - real :: t,q,u,v,td,tlcl,plcl,qw,tw,xlat,xlon,iossil - real :: dx,dy + real :: fhour,pp,ppn,qs,qsn,esn,es,psfc,ppi,dtemp,nd + real :: t,q,u,v,td,tlcl,plcl,qw,tw,xlat,xlon integer,dimension(npoint):: landwater integer,dimension(im,jm):: lwmask real,dimension(im,jm):: apcp, cpcp - real,dimension(npoint,2+levso*3):: grids,gridsi + real,dimension(npoint,2+levs*3):: grids real,dimension(npoint) :: rlat,rlon,pmsl,ps,psn,elevstn real,dimension(im*jm) :: dum1d,dum1d2 real,dimension(im,jm) :: gdlat, hgt, gdlon real,dimension(im,jm,15) :: dum2d real,dimension(im,jm,levs) :: t3d, q3d, uh, vh,omega3d - real,dimension(im,jm,levs) :: delp,delz,dummy3d + real,dimension(im,jm,levs) :: delpz real,dimension(im,jm,levs+1) :: pint, zint - real,dimension(npoint,levso) :: gridu,gridv,omega,qnew,zp - real,dimension(npoint):: gradx, grady - real,dimension(npoint,levs) :: griddiv,gridui,gridvi,omegai - real,dimension(npoint,levso) :: p1,p2,p3,pd1,pd2,pd3,tt,ttnew - real,dimension(npoint,levso) :: z1 - real,dimension(npoint,levso+1) :: pi3 + real,dimension(npoint,levs) :: gridu,gridv,omega,qnew,zp + real,dimension(npoint,levs) :: p1,pd3,ttnew + real,dimension(npoint,levs) :: z1 + real,dimension(npoint,levs+1) :: pi3 real :: zp2(2) real,dimension(kdim,npoint) :: sfc - real,dimension(1,levso+1) :: prsi,phii - real,dimension(1,levso) :: gt0,gq0,prsl,phy_f3d + real,dimension(1,levs+1) :: prsi,phii + real,dimension(1,levs) :: gt0,gq0,prsl,phy_f3d real :: PREC,TSKIN,SR,randomno(1,2) real :: DOMR,DOMZR,DOMIP,DOMS real :: vcoord(levs+1,nvcoord),vdummy(levs+1) @@ -116,8 +113,8 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, integer :: n3dfercld,iseedl integer :: istat(npoint) logical :: trace -!! logical, parameter :: debugprint=.true. - logical, parameter :: debugprint=.false. + logical, parameter :: debugprint=.true. +!! logical, parameter :: debugprint=.false. character lprecip_accu*3 real, parameter :: ERAD=6.371E6 real, parameter :: DTR=3.1415926/180. @@ -141,7 +138,7 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, integer iocomms,iope,ionproc nij = 12 - nflx = 6 * levso + nflx = 6 * levs recn_dpres = 0 recn_delz = 0 recn_dzdt = 0 @@ -368,42 +365,22 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, if (fformat == 'netcdf') then VarName='dpres' Zreverse='no' - call read_netcdf_p(ncid,im,jm,levs,VarName,delp,Zreverse, + call read_netcdf_p(ncid,im,jm,levs,VarName,delpz,Zreverse, & iope,ionproc,iocomms,error) if (error /= 0) print*,'dpres not found' else VarName='dpres' LayName='mid layer' call read_nemsio(gfile,im,jm,levs,VarName,LayName, - & delp,error) + & delpz,error) if (error /= 0) print*,'dpres not found' endif if(debugprint) then print*,'sample delp at lev=1 to levs ' do k = 1, levs - print*,k, delp(im/2,jm/3,k) + print*,k, delpz(im/2,jm/3,k) enddo endif -! delz !added by Guang Ping Lou for FV3GFS ("height thickness" with unit "meters" bottom up) - if (fformat == 'netcdf') then - VarName='delz' - Zreverse='no' - call read_netcdf_p(ncid,im,jm,levs,VarName,delz,Zreverse, - & iope,ionproc,iocomms,error) - if (error /= 0) print*,'delz not found' - else - VarName='delz' - LayName='mid layer' - call read_nemsio(gfile,im,jm,levs,VarName,LayName,delz,error) - if (error /= 0) print*,'delz not found' - endif - if(debugprint) then - print*,'sample delz at lev=1 to levs ' - do k = 1, levs - print*,k, delz(im/2,jm/3,k) - enddo - endif - ! compute interface pressure if(recn_dpres == -9999) then do k=2,levs+1 @@ -419,14 +396,14 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, if (fformat == 'netcdf') then do j=1,jm do i=1,im - pint(i,j,levs+1) = delp(i,j,1) + pint(i,j,levs+1) = delpz(i,j,1) end do end do do k=levs,2,-1 kk=levs-k+2 do j=1,jm do i=1,im - pint(i,j,k) = pint(i,j,k+1) + delp(i,j,kk) + pint(i,j,k) = pint(i,j,k+1) + delpz(i,j,kk) end do end do end do @@ -434,7 +411,7 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, do k=2,levs+1 do j=1,jm do i=1,im - pint(i,j,k) = pint(i,j,k-1) - delp(i,j,k-1) + pint(i,j,k) = pint(i,j,k-1) - delpz(i,j,k-1) end do end do end do @@ -446,6 +423,26 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, enddo endif endif +! delz !added by Guang Ping Lou for FV3GFS ("height thickness" with unit "meters" bottom up) + if (fformat == 'netcdf') then + VarName='delz' + Zreverse='no' + call read_netcdf_p(ncid,im,jm,levs,VarName,delpz,Zreverse, + & iope,ionproc,iocomms,error) + if (error /= 0) print*,'delz not found' + else + VarName='delz' + LayName='mid layer' + call read_nemsio(gfile,im,jm,levs,VarName,LayName,delpz,error) + if (error /= 0) print*,'delz not found' + endif + if(debugprint) then + print*,'sample delz at lev=1 to levs ' + do k = 1, levs + print*,k, delpz(im/2,jm/3,k) + enddo + endif + ! compute interface height (meter) if(recn_delz == -9999) then print*, 'using calculated height' @@ -461,7 +458,7 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, kk=levs-k+1 do j=1,jm do i=1,im - zint(i,j,k) = zint(i,j,k-1) - delz(i,j,kk) + zint(i,j,k) = zint(i,j,k-1) - delpz(i,j,kk) end do end do end do @@ -469,7 +466,7 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, do k=2,levs+1 do j=1,jm do i=1,im - zint(i,j,k) = zint(i,j,k-1) + delz(i,j,k-1) + zint(i,j,k) = zint(i,j,k-1) + delpz(i,j,k-1) end do end do end do @@ -1001,23 +998,8 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, endif endif - gridsi(np,1)=hgt(idum,jdum) - gridsi(np,2)=pint(idum,jdum,1) - ie=idum+1 - iw=idum-1 - jn=jdum-1 - js=jdum+1 - dx=(gdlon(ie,jdum)-gdlon(iw,jdum))*dtr*erad* - + cos(gdlat(idum,jdum)*dtr) - dy=(gdlat(idum,jn)-gdlat(idum,js))*erad*dtr - gradx(np)=(log(pint(ie,jdum,1)) - + -log(pint(iw,jdum,1)))/dx - grady(np)=(log(pint(idum,jn,1)) - + -log(pint(idum,js,1)))/dy - if(debugprint) then - if(np==1.or.np==100)print*,'gradx,grady= ', - + gradx(np),grady(np) - endif + grids(np,1)=hgt(idum,jdum) + grids(np,2)=pint(idum,jdum,1) sfc(5,np)=dum2d(idum,jdum,1) sfc(6,np)=dum2d(idum,jdum,6) @@ -1038,20 +1020,16 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, if(sfc(11,np) .gt. sfc(12,np)) sfc(11,np)=sfc(12,np) do k=1,levs - gridsi(np,k+2)=t3d(idum,jdum,k) - gridsi(np,k+2+levs)=q3d(idum,jdum,k) - gridsi(np,k+2+2*levs)=omega3d(idum,jdum,k) - gridui(np,k)=uh(idum,jdum,k) - gridvi(np,k)=vh(idum,jdum,k) + grids(np,k+2)=t3d(idum,jdum,k) + grids(np,k+2+levs)=q3d(idum,jdum,k) + grids(np,k+2+2*levs)=omega3d(idum,jdum,k) + gridu(np,k)=uh(idum,jdum,k) + gridv(np,k)=vh(idum,jdum,k) p1(np,k)=pint(idum,jdum,k+1) z1(np,k)=zint(idum,jdum,k+1) !! p1(np,k)=0.5*(pint(idum,jdum,k)+pint(idum,jdum,k+1)) !! z1(np,k)=0.5*(zint(idum,jdum,k)+zint(idum,jdum,k+1)) - griddiv(np,k)=(uh(ie,jdum,k)-uh(iw,jdum,k))/dx+ - + (vh(idum,jn,k)*cos(gdlat(idum,jn)*dtr)- - + vh(idum,js,k)*cos(gdlat(idum,js)*dtr))/dy/ - + cos(gdlat(idum,jdum)*dtr) end do end do @@ -1059,84 +1037,21 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, do np = 1, npoint ! !ps in kPa - ps(np) = gridsi(np,2)/1000. !! surface pressure + ps(np) = grids(np,2)/1000. !! surface pressure enddo ! -! compute omega(Pa/s) and interface layer pressure (Pa) -! - if(recn_dzdt == -9999) then !!calculated omega - do np=1,npoint - call modstuff(levs,idvc,idsl, - & nvcoord,vcoord,ps(np)*1000, - & gradx(np),grady(np),griddiv(np,1:levs), - & gridui(np,1:levs),gridvi(np,1:levs), - & pd1(np,1:levs),pd1(np,1:levs),omegai(np,1:levs)) - enddo -! -! put omega (pa/s) in the tracer to prepare for interpolation -! - print*, 'using calculated omega ' - do k = 1, levs - do np = 1, npoint - gridsi(np,2+levs*2+k) = omegai(np,k) - enddo - enddo - else - print*, 'using model dzdt m/s' - if(debugprint) then - do k = 1, levs - print*,'sample gridsi(dzdt) at lev ',k,' = ', - + gridsi(10,2+levs*2+k) - enddo - endif - endif - ! ----------------- -! levs=levso so the following section will not be -! excuted so comment out sigma sction for now -! sigheado=sighead -! ----------------- - print*, 'levs,levso= ', levs, levso - if(levs.ne.levso) then - do np = 1, npoint - grids(np,1) = gridsi(np,1) - grids(np,2) = gridsi(np,2) - enddo - call vintg(npoint,npoint,levs,levso,2, - & p1,gridui,gridvi,gridsi(1,3),gridsi(1,3+levs), - & p2,gridu, gridv, grids (1,3),grids (1,3+levso)) - do k = 1, levso - do np = 1, npoint - omega(np,k) = grids(np,2+levso*2+k) - enddo - enddo - else - do k = 1, levs - do np = 1, npoint - p2(np,k) = p1(np,k) - gridu(np,k) = gridui(np,k) - gridv(np,k) = gridvi(np,k) - omega(np,k) = omegai(np,k) - enddo - enddo ! Put topo(1),surf press(2),vir temp(3:66),and specifi hum(67:130) in grids ! for each station - do k = 1, 2*levs+2 - do np = 1, npoint - grids(np,k) = gridsi(np,k) - enddo - enddo - endif !END OF IF STATMENT LEVS .NE. LEVSO - if(recn_dzdt == 0 ) then !!DZDT +!! if(recn_dzdt == 0 ) then !!DZDT do k = 1, levs do np = 1, npoint - omega(np,k) = gridsi(np,2+levs*2+k) + omega(np,k) = grids(np,2+levs*2+k) enddo enddo if(debugprint) + print*,'sample (omega) dzdt ', (omega(3,k),k=1,levs) - endif ! ! move surface pressure to the station surface from the model surface ! @@ -1147,79 +1062,54 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, ! ! print *, "elevstn = ", elevstn(np) if(elevstn(np)==-999.) elevstn(np) = grids(np,1) - psn(np) = ps(np) * exp(-con_g*(elevstn(np)-grids(np,1)) / - & (con_rd * grids(np,3))) - call sigio_modpr(1,1,levso,nvcoord,idvc, + psn(np) = ps(np) + call sigio_modpr(1,1,levs,nvcoord,idvc, & idsl,vcoord,iret, - & ps=psn(np)*1000,pd=pd3(np,1:levso),pm=p3(np,1:levso)) + & ps=psn(np)*1000,pd=pd3(np,1:levs)) grids(np,2) = log(psn(np)) - if(np==1)print*,'station H,grud H,psn,ps,new pm', - & elevstn(np),grids(np,1),psn(np),ps(np),p3(np,1:levso) + if(np==11)print*,'station H,grud H,psn,ps,new pm', + & elevstn(np),grids(np,1),psn(np),ps(np) + if(np==11)print*,'pd3= ', pd3(np,1:levs) enddo ! -! move t to new levels conserving theta -! move q to new levels conserving RH -! - do k = 1, levso - do np = 1, npoint - pp = p2(np,k) - ppn = p3(np,k) - tt(np,k) = grids(np,k+2) - ttnew(np,k) = tt(np,k) * (ppn/pp)**(con_rocp) -! if(np==1)print*,'k,pp,ppn,tt,ttnew= ',k,pp,ppn, -! + tt(np,k),ttnew(np,k) - call svp(qsn,esn,ppn,ttnew(np,k)) - call svp(qs,es,pp,tt(np,k)) - qnew(np,k) = grids(np,k+levso+2) * qsn / qs - enddo - enddo -! -! move the new clocking into the old -! !! test removing height adjustments - np1=0 - if (np1==0) then print*, 'do not do height adjustments' - else - print*, 'do height adjustments' - do np = 1, npoint - ps(np) = psn(np) - enddo - do k = 1, levso - do np = 1, npoint - grids(np,k+2) = ttnew(np,k) - grids(np,k+levso+2) = qnew(np,k) - enddo - enddo - endif - print*,'finish adjusting to station terrain' ! ! get sea-level pressure (Pa) and layer geopotential height ! + do k = 1, levs + do np = 1, npoint + ttnew(np,k) = grids(np,k+2) + qnew(np,k) = grids(np,k+levs+2) + enddo + enddo + do np=1,npoint - call gslp(levso,elevstn(np),ps(np)*1000, - & p3(np,1:levso),ttnew(np,1:levso),qnew(np,1:levso), - & pmsl(np),zp(np,1:levso),zp2(1:2)) +!! call gslp(levs,elevstn(np),ps(np)*1000, + call gslp(levs,grids(np,1),ps(np)*1000, + & p1(np,1:levs),ttnew(np,1:levs),qnew(np,1:levs), + & pmsl(np),zp(np,1:levs),zp2(1:2)) enddo + print *, 'call gslp pmsl= ', (pmsl(np),np=1,20) if(recn_delz == -9999) then print*, 'using calculated height ' else print*, 'using model height m' - do k = 1, levso + do k = 1, levs do np=1, npoint zp(np,k) = z1(np,k) enddo enddo endif print*,'finish computing MSLP' - print*,'finish computing zp ', (zp(3,k),k=1,levso) - print*,'finish computing zp2(1-2) ', zp2(1),zp2(2) + print*,'finish computing zp ', (zp(11,k),k=1,levs) + print*,'finish computing zp2(11-12) ', zp2(11),zp2(12) ! ! prepare buffer data ! do np = 1, npoint pi3(np,1)=psn(np)*1000 - do k=1,levso + do k=1,levs pi3(np,k+1)=pi3(np,k)-pd3(np,k) !layer pressure (Pa) enddo !! ==ivalence (cstat1,rstat1) @@ -1232,22 +1122,20 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, data(6) = elevstn(np) ! STATION ELEVATION (M) psfc = 10. * psn(np) ! convert to MB leveta = 1 - do k = 1, levso + do k = 1, levs ! ! look for the layer above 500 mb for precip type computation ! if(pi3(np,k).ge.50000.) leveta = k ppi = pi3(np,k) t = grids(np,k+2) - q = max(1.e-8,grids(np,2+k+levso)) + q = max(1.e-8,grids(np,2+k+levs)) u = gridu(np,k) v = gridv(np,k) -! data((k-1)*6+7) = pi3(np,k) ! PRESSURE (PA) at interface layer -! data((k-1)*6+7) = p3(np,k) ! PRESSURE (PA) at integer layer data((k-1)*6+7) = p1(np,k) ! PRESSURE (PA) at integer layer data((k-1)*6+8) = t ! TEMPERATURE (K) data((k-1)*6+9) = u ! U WIND (M/S) - data((k-1)*6+10) = v ! V WIND (M/S) + data((k-1)*6+10) = v ! V WIND (M/S) data((k-1)*6+11) = q ! HUMIDITY (KG/KG) data((k-1)*6+12) = omega(np,k)*100. ! Omega (pa/sec) !changed to dzdt(cm/s) if available enddo @@ -1279,11 +1167,19 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, ! endif ! sfc(30,np) = sfc(30,np) + dtemp ! endif +! +!G.P. Lou 20200501: +!convert instantaneous surface latent heat net flux to surface +!evapolation 1 W m-2 = 0.0864 MJ m-2 day-1 +! and 1 mm day-1 = 2.45 MJ m-2 day-1 +! equivament to 0.0864/2.54 = 0.035265 +! equivament to 2.54/0.0864 = 28.3565 if(debugprint) + print*,'evaporation (stn 000692)= ',sfc(17,np) data(9+nflx) = sfc(5,np) ! tsfc (K) - data(10+nflx) = sfc(6,np) ! 10cm soil temp (K) - data(11+nflx) = sfc(17,np) ! evaporation (w/m**2) + data(10+nflx) = sfc(6,np) ! 10cm soil temp (K) +!! data(11+nflx) = sfc(17,np)/28.3565 ! evaporation (kg/m**2) from (W m-2) + data(11+nflx) = sfc(17,np)*0.035265 ! evaporation (kg/m**2) from (W m-2) data(12+nflx) = sfc(12,np) ! total precip (m) data(13+nflx) = sfc(11,np) ! convective precip (m) data(14+nflx) = sfc(10,np) ! water equi. snow (m) @@ -1299,7 +1195,6 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, data(23+nflx) = 0. data(24+nflx) = 0. data(25+nflx) = 0. - iwx = 0 nd = 0 trace = .false. DOMS=0. @@ -1311,10 +1206,10 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, if(sfc(12,np).gt.0.) then !check for precip then calc precip type do k = 1, leveta+1 - pp = p3(np,k) + pp = p1(np,k) ppi = pi3(np,k) t = grids(np,k+2) - q = max(0.,grids(np,2+k+levso)) + q = max(0.,grids(np,2+k+levs)) u = gridu(np,k) v = gridv(np,k) if(q.gt.1.e-6.and.pp.ge.20000.) then @@ -1356,11 +1251,9 @@ subroutine meteorg(npoint,rlat,rlon,istat,cstat,elevstn, print *, ' surface fields for hour', nf, 'np =', np print *, (data(l+nflx),l=1,25) print *, ' temperature sounding' - print 6101, (data((k-1)*6+8),k=1,levso) + print 6101, (data((k-1)*6+8),k=1,levs) print *, ' omega sounding' - print *, (data((k-1)*6+12),k=1,levso) - print *, ' divergence sounding' - print *, (griddiv(np,k),k=1,levs) + print *, (data((k-1)*6+12),k=1,levs) endif C print *, 'in meteorg nfile1= ', nfile1 write(nfile) data diff --git a/sorc/syndat_qctropcy.fd/qctropcy.f b/sorc/syndat_qctropcy.fd/qctropcy.f index acb117d0..f0fae79a 100755 --- a/sorc/syndat_qctropcy.fd/qctropcy.f +++ b/sorc/syndat_qctropcy.fd/qctropcy.f @@ -4237,6 +4237,8 @@ SUBROUTINE RCNCIL(IUNTCA,IUNTCN,IUNTAL,NTEST,NOKAY,NBAD,MAXREC, c record with only one observing rsmc. It must also be entered int c the alias file. + istidn=0 ! Qingfu added to skip the changes of storm ID number + if(istidn .eq. 1) then if(rsmcz(1:1) .eq. '!') then @@ -11989,41 +11991,13 @@ SUBROUTINE OFILE0(IUNTOP,NFILMX,NFTOT,FILNAM) IF(CACCES(NF) .NE. 'DIRECT') THEN if(cpos(nf) .eq. ' ') then - if (cstat(nf).eq.'OLD') then - OPEN(UNIT=IUNIT(NF),FORM=cform(nf),STATUS='OLD', - 1 ACCESS=cacces(nf),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS) - elseif (cstat(nf).eq.'NEW') then - OPEN(UNIT=IUNIT(NF),FORM=cform(nf),STATUS='NEW', - 1 ACCESS=cacces(nf),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS) - elseif (cstat(nf).eq.'UNKNOWN') then - OPEN(UNIT=IUNIT(NF),FORM=cform(nf),STATUS='UNKNOWN', - 1 ACCESS=cacces(nf),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS) - else - OPEN(UNIT=IUNIT(NF),FORM=cform(nf),STATUS=cstat(nf), - 1 ACCESS=cacces(nf), - 2 ERR=95,IOSTAT=IOS) - endif + OPEN(UNIT=IUNIT(NF),FORM=cform(nf),STATUS=cstat(nf), + 1 ACCESS=cacces(nf),FILE=FILNAM(NF)(1:LENGTH), + 2 ERR=95,IOSTAT=IOS) else - if (cstat(nf).eq.'OLD') then - open(unit=iunit(nf),form=cform(nf),status='OLD', - 1 access=cacces(nf),position=cpos(nf), - 2 file=filnam(nf)(1:length),err=95,iostat=ios) - elseif (cstat(nf).eq.'NEW') then - open(unit=iunit(nf),form=cform(nf),status='NEW', - 1 access=cacces(nf),position=cpos(nf), - 2 file=filnam(nf)(1:length),err=95,iostat=ios) - elseif (cstat(nf).eq.'UNKNOWN') then - open(unit=iunit(nf),form=cform(nf),status='UNKNOWN', - 1 access=cacces(nf),position=cpos(nf), - 2 file=filnam(nf)(1:length),err=95,iostat=ios) - else - open(unit=iunit(nf),form=cform(nf),status=cstat(nf), - 1 access=cacces(nf),position=cpos(nf), - 2 err=95,iostat=ios) - endif + open(unit=iunit(nf),form=cform(nf),status=cstat(nf), + 1 access=cacces(nf),position=cpos(nf), + 2 file=filnam(nf)(1:length),err=95,iostat=ios) endif ELSE read(filnam(nf)(length+2:length+2+idgmax-1),37) lrec @@ -12031,41 +12005,13 @@ SUBROUTINE OFILE0(IUNTOP,NFILMX,NFTOT,FILNAM) write(6,39) lrec 39 format('...Direct access record length:',i7,'...') if(cpos(nf) .eq. ' ') then - if (cstat(nf).eq.'OLD') then - OPEN(UNIT=IUNIT(NF),FORM=CFORM(NF),STATUS='OLD', - 1 ACCESS=CACCES(NF),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS,RECL=lrec) - elseif (cstat(nf).eq.'NEW') then - OPEN(UNIT=IUNIT(NF),FORM=CFORM(NF),STATUS='NEW', - 1 ACCESS=CACCES(NF),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS,RECL=lrec) - elseif (cstat(nf).eq.'UNKNOWN') then - OPEN(UNIT=IUNIT(NF),FORM=CFORM(NF),STATUS='UNKNOWN', - 1 ACCESS=CACCES(NF),FILE=FILNAM(NF)(1:LENGTH), - 2 ERR=95,IOSTAT=IOS,RECL=lrec) - else - OPEN(UNIT=IUNIT(NF),FORM=CFORM(NF),STATUS=CSTAT(NF), - 1 ACCESS=CACCES(NF), - 2 ERR=95,IOSTAT=IOS,RECL=lrec) - endif + OPEN(UNIT=IUNIT(NF),FORM=CFORM(NF),STATUS=CSTAT(NF), + 1 ACCESS=CACCES(NF),FILE=FILNAM(NF)(1:LENGTH), + 2 ERR=95,IOSTAT=IOS,RECL=lrec) else - if (cstat(nf).eq.'OLD') then - open(unit=iunit(nf),form=cform(nf),status='OLD', - 1 access=cacces(nf),file=filnam(nf)(1:length), - 2 position=cpos(nf),err=95,iostat=ios,recl=lrec) - elseif (cstat(nf).eq.'NEW') then - open(unit=iunit(nf),form=cform(nf),status='NEW', - 1 access=cacces(nf),file=filnam(nf)(1:length), - 2 position=cpos(nf),err=95,iostat=ios,recl=lrec) - elseif (cstat(nf).eq.'UNKNOWN') then - open(unit=iunit(nf),form=cform(nf),status='UNKNOWN', - 1 access=cacces(nf),file=filnam(nf)(1:length), - 2 position=cpos(nf),err=95,iostat=ios,recl=lrec) - else - open(unit=iunit(nf),form=cform(nf),status=cstat(nf), - 1 access=cacces(nf), - 2 position=cpos(nf),err=95,iostat=ios,recl=lrec) - endif + open(unit=iunit(nf),form=cform(nf),status=cstat(nf), + 1 access=cacces(nf),file=filnam(nf)(1:length), + 2 position=cpos(nf),err=95,iostat=ios,recl=lrec) endif ENDIF ENDDO