C ------------------------------------------------------------ PROGRAM VERIFY_MODEL C C Written by James Franklin C C NHC forecast verification program. Verifies official and C model forecasts from the ATCF a- and b-decks for the C Atlantic, eastern Pacific, and central Pacific basins. C C Current version 4.11 C ------------------------------------------------------------ C C C Modification history: C --------------------- C 13 Sep 2021 - V4.11 Adds user-editable file with all C the interpolated "2" models to be taken as C "I" models. C C C 12 Jun 2021 - V4.10.2 Adds option to calculate the C fractional cases written to the spreadsheet C based on the intensity forecasts, rather C than the track forecasts. C C C 03 Jun 2021 - V4.10.1 Adds option to only include verifying C times when there are differences in track or C intensity among the models. The check for C differences is done separately at each C verification time and separately for track C vs intensity. C C C 08 May 2021 - V4.10.0 Changes the way combined basin runs are C made, to not require any copying of decks as C done in V4.5.3. Now, entering EC as the basin C identifier simply cycles through the EP storms C and then the CP storms for a given year. C C Allows combined AL/EP verifications by entering C AE as the basin. C C Also allows running of CP storms CLP/SHF variants C using the EP coefficients. Previously, you C couldn't generate the skill baselines on CP C storms. C C Fixed formatting error in storm log files. C C C 02 Nov 2020 - V4.9.1 Treats EMX/EMXI/EMX2 interchangeably with C EMH/EMHI/EMH2; the latter is an earlier-arriving C tracker for the former. Requesting an EMH model C will be interpreted as a request for EMX/I/2, C and any occurrence of EMH/I/2 in the a-deck will C be treated as an occurrence of EMX/I/2. Note that C when both EMX and EMH appear in the a-deck for C a particular forecast, the first one will be used C and the second one ignored. C C 09 Sep 2020 - V4.9.0 Modifies the way multiple storms are C conveyed in the input ATCFID. Old scheme was C going to be unable to distinguish whether C ALAL2021 was for the 2021 season or for the two C seasons 2020-21. C C In the new scheme, characters 3-4 of the input C will either be a number, "SY" or "MY", which C refer to a single storm, a single year, or C multiple years, respectively. For example: C AL042021 refers to Atl storm 4 of 2021 C ALSY2021 refers to all Atl storms from 2021 C ALMY2021 refers to all Atl storms from 2020-21. C C C 18 Jun 2020 - V4.8.1 Corrects a bug that caused calculated C values of OCD5 at 60 h to be thrown away. C Went ahead and saved all the 12-h points while C I was at it. Previously non-official times C had been tossed after being calculated, C whereas all OCD5 from the a-decks were C retained. No reason to treat the two sources C differently. C C 27 Feb 2020 - V4.8.0 Adds 60 h to the list of OFCL forecast C times. C C Corrects a bug introduced in V4.5.0 in which C the presence of W/W at specific verification C times would have been assigned to the wrong C verification time (e.g., a W/W up at 168 h C would have been ascribed to 108 h). The C flawed subroutine WWUS7 has been replaced by C WWUS15. C C 22 Nov 2019 - V4.7.0 Adds capability to compute the HFIP RI C metric, which defines the sample as those times C when either RI was occurring or was forecast, for C a specified period ending at verification time, C including in any of the components of a consensus. C C 16 Jun 2019 - V4.6.3 Modification to format of the forecast C list file verify_model_fcstlist.txt. Now the C file should begin with a comment line that C describes what the list represents. This C comment line (up to 60 characters) will be C echoed in the log file output. C C 07 Mar 2019 - V4.6.2 Modifications to support parallel C processing. Note that this changed the handling C of individual forecaster samples and the C storm-size sample check. C C The number of threads to be used is set in C verify_model.cmd. Recommended number of threads C varies by machine: C For Mac: setenv OMP_NUM_THREADS 2 C For Linux: setenv OMP_NUM_THREADS 4 C C 01 Mar 2019 - V4.6.1 Can restrict sample to times of C rapid weakening. C C 24 Aug 2018 - V4.6.0 Now supports forecast verifications C for the central Pacific basin. C C Fixes a bug in the along/cross-track C error calculation when a forecast or best- C track crosses the Date Line. C C 23 Aug 2018 - V4.5.3 Allows a combined verification of EP C and CP together with the basin ID of "EC", C (as long as there aren't more than 39 storms). C Decks need to be renamed aec01yyyy, bec01yyyy, C etc. Convention is to copy EP01 > EC01, etc., C and CP01 > EC31, etc. C C Adds check to prevent attempts to generate C CLP/SHF if basin isn't AL or EP. C C Fixes erroneous track error if forecast and C verifying longitudes are in different C hemispheres. C C 23 Aug 2018 - V4.5.2 Decision whether to suppress non-OFCL C times for OFCL samples is now controled in the C options file. C C 16 Aug 2018 - V4.5.1 Changes format of storm log file to C output average errors in tenths. C C 10 Aug 2018 - V4.5.0 Adds verification times of 60, 84, 108, C 132, and 156 h. This is helpful for evaluating C certain models, but is actually a nuisance for C evaluating OFCL, which has no entries at these C times. Therefore, additional logic was C added to omit these intermediate times from C the output files if OFCL was part of the C homogeneous sample. C C Additional modifications made to facilitate C future changes to the verification times. C Places that would need modification when the C number of verification times change can be C identified by searching for "NVTX" or "NVTX C dependency". C C 27 Jul 2018 - V4.2.1 Stopped automatically tossing OFCL 48-h C 64-kt radii forecasts. NHC began making public C 48-h 64-kt radii forecasts in 2018. Now only C those prior to 2018 will get tossed. C C 27 Jul 2018 - V4.2.0 Added a flag in the options file to C discard ensemble member fcsts when a-decks are C loaded into memory. The individual members are C hardly ever verified and not loading them speeds C program execution time significantly. The C specific members skipped are defined in C LOAD_ADECK. C C Increased the number of variable consensus models C from 2 to 10. These are now specified as CONA, C CONB, ..., CONJ. CONV and CONW no longer used. C C Allows specification of RI thresholds in options C file. C C 24 Jul 2018 - V4.1.3 Fixed an error where cliper/shifor data C from the c-decks were read after the a-deck, so C if model was in both files the c-deck version would C be ignored. Now the c-deck is read before the a-deck. C C 16 Jul 2018 - V4.1.2 Fixed a minor formatting error in the kgrf C output file for when there are more than 19 models, C and fixed a minor formatting error in the individual C storm log file. C C 10 Jul 2018 - V4.1.1 Standardized names of input files: C verify_model_conx.txt C verify_model_cony.txt C verify_model_conv.txt C verify_model_conw.txt C verify_model_fcstlist.txt C C Moved supporting CLIPER/SHIFOR/TCLIP files to C subdirectory support_files. C C 09 Jul 2018 - V4.1.0 Added capability to have the forecast list C apply to verification times as well as initial C times. Invoked by setting VER_LIST = "B". C C 30 Jun 2018 - V4.0.1 Changed the name of input file from C verifym_ctrl.dat to verify_model_options.dat. C C 22 Jun 2018 - V4.0.0 Migrated to Mac. C C Modified decay_old in atcflib.f to change imax C from 21 to 11 to match how the routine was being C called. Previous compilers allowed the arrays being C passed to be shorter than 21 but it was an error in C gfortran. The modified routine seems to give largely C repeatable results compared to the PGF compiler on C halfmoon, but it's possible C that some errors had gone undetected. C C 00 Aug 2017 - V3.2.0 Modifications by Matt Onderlinde for gfortran C compiler. C C 25 Jul 2016 - V3.1.3 Increased array size for large a-decks from C 250,000 to 500,000 (atcflib.f/LOAD_ADECK). C C 05 Jul 2016 - V3.1.2 Accepts OFCP as OFCL if ACPTALLST_IT is C true. C C 13 Jan 2014 - V3.1.1 Disables special b-deck directory OFCP. C C 30 Apr 2013 - V3.1.0 Adds capability to generate DeMaria TCLP. C C 03 Oct 2012 - V3.0.5 Increased array size for large a-decks from C 200,000 to 250,000 (atcflib.f). C C 01 Oct 2012 - V3.0.4 Excludes experimental 6-7-day forecasts C from composite skill calculation. C C 11 Sep 2012 - V3.0.3 Excludes PT status from verification. C PT is not supposed to ever be in the best tracks, C but sometimes gets erroneously put there in real C time. C C 14 May 2012 - V3.0.2 Reordered inputs of verifym_ctrl.dat to a C more logical sequence. C C 09 May 2012 - V3.0.1 Corrected an issue with the accurate C computation of dates for limiting a verification C to specific yyyymmdd range. A FLOAT command was C killing precision of the exact day. Unclear if this C was introduced by the new compiler when we went to C RH5. C C 09 Mar 2012 - V3.0.0 Adds capability to verify forecasts even if C system is not a cyclone (i.e., admits any status C flag into the verification). Purpose is to C evaluate the provision (OFCP) forecasts being C made for disturbances. Note: original C implementation had the code read special b-decks C in opcp directory if ACPTALLST_IT was TRUE, but C this special directory was disabled Jan 2014. C The regular b-decks are now used. C C 02 Feb 2012 - V2.5.3 Corrects bug that allowed DB stage to C incorrectly be included in a verification. C C 25 Jan 2012 - V2.5.2 Can now set the minimum number of models C required to compute the variable consensus. Used C to be hard-wired as a minimum of 1 present. This C allows replication of the operational consensus C procedure. C C 31 Oct 2011 - V2.5.1 Added ability to turn on/off the acceptance C of 12-h-old interpolated models "I" interpolations. C C 12 Jul 2011 - V2.5.0 Allows variable track/int consensus members C to be entered via an input file, rather than be C hard-wired in the code. These get specified C as either CONV or CONW. The fixed-member consensus C models are still CONX and CONY. C C 11 Jul 2011 - V2.4.4 Modified order of A-deck input. Now C supplementary file is read in first. C C 20 Apr 2011 - V2.4.3 Adds ability to apply WSMIN/WSMAX only to C the initial time, ignoring strength at verification C time. C C 13 Sep 2010 - V2.4.2 Added ECM2 and AFW2 as 12-h interpolations C that get treated as "I" models. C Adds ability to select storms by ROCI. C C 27 Jul 2010 - V2.4.1 Modified to accomodate minutes in the best C tracks. C C 28 Apr 2010 - V2.4.0 Adds ability to read models from a C supplemental a-deck. C C 26 Mar 2010 - V2.3.1 Entering TVCN will now accept CONU as well C (CONU was renamed TVCN in 2008). C C 17 Feb 2010 - V2.3.0 Can now request two fixed consensus models, C CONX and CONY. These are specified now in conx.txt C and cony.txt. C C 06 Jan 2010 - V2.2.0 Input W/W data file now specified in C verifym_ctrl.dat C C 05 Jan 2010 - V2.1.1 Allows the program to find SHIPS forecasts C made from 1996-1998, when they were included under C LBAR. C C 08 Dec 2009 - V2.1.0 Added ability to toss forecast points within C or beyond DIST_LAND nmi of land. C C 10 Jul 2009 - V2.0.0 Modifications to support 7-day C verification. C C 20 May 2009 - V1.28.2 Changed formats of the allt and alli C files to reflect change in policy of only showing C homogeneous verifications in the TCRs. Now these C files do not append from run to run of C verify_model, and format changed to conform to new C TCR table style. C C 23 Jan 2009 - V1.28.1 Changed time to independence from 30 h C to 18 h, based on TIND numbers from recent 5-yr OFCL C serial correlation tests, and also supported by C tests done by Aberson and DeMaria (1994). C C 03 Nov 2008 - V1.28.0 Added ability to only verify forecasts C verifying within NWINDOW hours prior to landfall. C Requires the over-water option to be selected. C C 22 Sep 2008 - V1.27.2 Added FM82 and FM92 as 12-h C interpolations to get converted to "I" models. C C 04 Jun 2008 - V1.27.1 Accomodates non-synoptic records in B C decks by skipping over them on read. C C 25 Mar 2008 - V1.27.0 Adds ability to send along/cross track C errors to kgrf output file. Adds ability to select C when hurricane watches/warnings are in effect. C C 10 Jan 2008 - V1.26.1 Adds exclusion for STATUS=DB. C C 15 May 2007 - V1.26.0 Adds check if forecast and BT are in C different hemispheres and computes error C accordingly. Should work, but not tested! C C 23 Mar 2007 - V1.25.1 Adds ability to count forecast C occurrances of rapid intensification (defined by C 24 h change of at least DELTA_RI kt). C C 22 Mar 2007 - V1.25.0 Adds ability to restrict sample to those C forecasts verifying during rapid intensification, C defined as 30 kt or more increase in wind in the C 24 h prior to verification time. C C 20 Mar 2007 - V1.24.0 Computes independence time (Siegel method). C C 23 Jan 2007 - V1.23.0 Computes relative errors in main log file C for multiple models, using 2nd model as standard. C C 06 Nov 2006 - V1.22.2 Modified calculations of CLIPER/SHIFOR C fcsts to round lat/lon to the nearest 10th and wind C to the nearest kt. This makes the "on the fly" C calculations have the same precision as the C forecasts in the A decks. Also, if a CLP/SHF C forecast fails to run (if, for example, no CARQ or C incomplete CARQ) then the tau=0 CLP/SHF forecast C is tossed out as well). This will cause some C tau = 0 verification differences with runs made C prior to this time. Should not be an issue with C best-track CLP/SHF, which do not depend on CARQ and C should not fail to run. C C 31 Oct 2006 - V1.22.1 Added ability to write out recomputed C CLIPER/SHIFOR forecasts to supplemental "c" file so C that they didn't need to be computed every time. C C 04 Oct 2006 - V1.22.0 Added a decay-SHIFOR model, which takes the C SHF5 intensity and the CLP5 track, and decays C the intensity forecast along the track using the C decay module from SHIPS. To access this, enter C OCD5 or BCD5 as the model ID. There is also a C test version accessible via OCDT. C C 26 Sep 2006 - V1.21.0 Added ability to select forecasts from C specific synoptic times (0,6,12,18Z) get verified. C C 25 Sep 2006 - V1.20.1 Modified calculation of all consensus C forecasts to round track to the nearest tenth and C intensity to the nearest whole knot, for C consistency with the precision of the other aids. C C 24 Sep 2006 - V1.20.0 Adds calculation of combined track and C intensity consensus CONS. This is a hard-wired C consensus made up of designated track and intensity C models. Only 1 model is required to be present to C compute the consensus. C C 21 Sep 2006 - V1.19.2 Adds indicator to header if C fcst_list.txt was used. C C 20 Sep 2006 - V1.19.1 Corrected bug which ignored individual C forecasters when a special was issued. C C 14 Sep 2006 - V1.19.0 Added ability to select forecast issuance C times by date. C C 04 Jul 2006 - V1.18.5 Added extra output file for all C intensity models. Changed name of old allm track C output to allt. C C 20 Jun 2006 - V1.18.4 Modified calculation of frequency of C superior performance, such that if there is a tie, C a model gets credit for a fraction of a forecast. C This way, summing over all the models will give 100% C for the total FSP. C C 12 May 2006 - V1.18.3 Allows user to pull A-decks from a C different directory, specified by ADECK_DIR (4-char). C This directory must still be under the parent atcf C directory. C C 14 Mar 2006 - V1.18.2 Allows user to specify individual C storms in forecast list file (set month, day, and C hour to 99 to get all forecasts from an C individual storm. C C 13 Mar 2006 - V1.18.1 Modified ATSHIF5D and EPSHIF5D so C negative wind forecasts get set to 1 kt. This C prevents the loss of our skill baseline when C rerunning OCS5 or BCS5. C C 21 Jan 2006 - V1.18.0 Adds capability to exclude forecasts over C land. When selected, forecasts will be excluded C anytime after occurs, either in the forecast or in C the best track. C C 03 Jan 2006 - V1.17.2 Fixes bug that prevented verification C of forecasts that cross over January 1st. C C 21 Nov 2005 - V1.17.1 Adds ability to send along/cross track C std dev results to KGRF output file. C C 09 Nov 2005 - V1.17.0 Adds ability to lag a forecast by up to C 24 h. For example, by setting the lag=6 h, you C can verify the 6 h old version of a model. In this C case, the 6 h forecast from the model is verified C against the 0 h best track position, ..., and the C 126 h forecast from the model is verified against C the t=120 h best track position. Any of the first C 5 models in the model list can be lagged. C C 05 Nov 2005 - V1.16.1 Added ability to verify using SAB C classifications instead of best track data. SAB C position and CI intensity are used only if their C fix is within an hour of the best track time to be C verified. C C 05 Nov 2005 - V1.16.0 Added ability to verify using operational C position and intensity estimates, rather than from C the best track. These estimates are obtained from C the q[STMID].txt file, created by atcf2tcr.f. C Only works from 2001 to present, since that is C when the A-decks put the compute data into OFCL(0), C however, with additional modifications to C atcf2tcr, such values could also be obtained from C the CARQ lines. C C 18 Aug 2005 - V1.15.0 Modified subroutine LOAD_ADECK to accept C all interpolated forecasts under the xxxI C nomenclature, i.e., the 12-hr interpolated C forecasts (e.g., UKM2) will be lumped together C with the UKMI's. It is not possible to C separately verify the 12-hr interpolations, as C the aid ID is immediately changed from 2 to I as C soon as it is read in from the A-deck. C C 28 May 2005 - V1.14.0 Modified subroutine GET_MODEL_FCSTC to C ignore special advisory forecasts and instead C verify the original issuance. In the ATCF a-decks, C these original forecasts are saved under the C id OFCO. The saving of original forecasts as OFCO C begins with the 2005 a-decks. Prior to the ATCF C era, however, I believe the decks are populated C with original forecasts, rather than specials. C C C 27 Apr 2005 - V1.13.0 CLIPER5 model modified to use new dependent C data set (1931-2004 ATL, 1949-2004 EPAC), C as well as a couple of other minor changes. C C 04 Apr 2005 - V1.12.1 Set of changes to handle 3-character model C IDs. On input, a dash is added as the fourth C character, but it is stripped in output log files. C C 26 Nov 2004 - V1.12.0 Can put radii verification in output C Kgraph file. C C 15 May 2004 - V1.11.2 AVNO, AVNI appear in output as GFSO, C GFSI. User can also input GFSO,I and get AVNO,I. C C 17 Feb 2004 - V1.11.1 Tests Sim Aberson's recreation of C Charlie's original cliper in a best track mode. C C 26 Jan 2004 - V1.11.0 Can recreate operational 3-day CLIPER fcsts C using the operational (GOM-correction) version C of CLIPER. Note that when running best-track C 3-day CLIPER fcsts, the un-modified CLIPER is C used. C C 16 Jan 2004 - V1.10.0 Adds ability to limit verification to fcst C positions contained within a lat/lon box. C C 16 Jan 2004 - V1.9.0 Added second parameter control file. C C 16 Jan 2004 - V1.8.1 Can put X-Y errors in spreadsheet C output. Changed missing data flag in C spreadsheet from -999 to -9999 since component C errors can be lower than -999. C C 15 Jan 2004 - V1.8.0 Can recompute operational 5-day C CLIPER/SHIFOR forecasts from compute data C (OCS5). C C 07 Jan 2004 - V1.7.0 Adds along/cross track error verification. C Reference direction is from the BT using C positions at VT and VT-6 h. C C 06 Jan 2004 - V1.6.0 Adds wind radii verification. C C 27 Nov 2003 - V1.5.0 Reads BT wind radii, can accomodate C multi-line best track files. C C 16 May 2003 - V1.4.1 Extracts storm name from A deck. C C 09 Apr 2003 - V1.4.0 Allows lat/lon domain to be specified. C C 08 Apr 2003 - V1.3.0 Allows user to exlude fcsts in a list. C C 22 Jan 2003 - V1.2.0 Added ability to generate consensus fcsts. C C 16 Nov 2002 - V1.1.0 Speeded up processing by only reading C A-deck once, storing contents in a COMMON block C (call to GET_MODEL_FCSTC). C C 19 Nov 2001 - V1.0.0 Initial release. C ----------------------------------------------------------------- C C C Number of verification times NVTX and max models NMDX. C NVTO is the number of verification times used by OFCL C (including experimental forecasts). C ------------------------------------------------------ PARAMETER (NBTX = 200, NVTX = 15, NVTO = 11, NMDX=20) PARAMETER (NCATX = 5) PARAMETER (NACPTS = 29) PARAMETER (NMINTX = 200) C CHARACTER*1 WWARN, VER_LIST, VER_EXTRAT, VER_SUBT, FTYPE CHARACTER*1 VER_NONBT, ADUM1, KGRFPAR, FCSTNEARLAND CHARACTER*1 SIZECHECK, SPRD_FRC CHARACTER*1 DASH,SLASH,COLON, LASIGN, LOSIGN, SKIP CHARACTER*2 STATUS, BST(NBTX), VST, SPRD_PAR, CMSP CHARACTER*3 FCSTR(NMDX), FCSTRV CHARACTER*4 MODEL(NMDX), MODEL_LC, MODELCX(NMDX), MODELCY(NMDX) CHARACTER*4 MODELO(NMDX), MODELCXO(NMDX), MODELCYO(NMDX) CHARACTER*4 MODELTA(NMDX), MODELIA(NMDX) CHARACTER*4 MODELTB(NMDX), MODELIB(NMDX) CHARACTER*4 MODELTC(NMDX), MODELIC(NMDX) CHARACTER*4 MODELTD(NMDX), MODELID(NMDX) CHARACTER*4 MODELTE(NMDX), MODELIE(NMDX) CHARACTER*4 MODELTF(NMDX), MODELIF(NMDX) CHARACTER*4 MODELTG(NMDX), MODELIG(NMDX) CHARACTER*4 MODELTH(NMDX), MODELIH(NMDX) CHARACTER*4 MODELTI(NMDX), MODELII(NMDX) CHARACTER*4 MODELTJ(NMDX), MODELIJ(NMDX) CHARACTER*4 MODELTAO(NMDX), MODELIAO(NMDX) CHARACTER*4 MODELTBO(NMDX), MODELIBO(NMDX) CHARACTER*4 MODELTCO(NMDX), MODELICO(NMDX) CHARACTER*4 MODELTDO(NMDX), MODELIDO(NMDX) CHARACTER*4 MODELTEO(NMDX), MODELIEO(NMDX) CHARACTER*4 MODELTFO(NMDX), MODELIFO(NMDX) CHARACTER*4 MODELTGO(NMDX), MODELIGO(NMDX) CHARACTER*4 MODELTHO(NMDX), MODELIHO(NMDX) CHARACTER*4 MODELTIO(NMDX), MODELIIO(NMDX) CHARACTER*4 MODELTJO(NMDX), MODELIJO(NMDX) CHARACTER*4 MODELINT2(NMINTX), MODELINTI(NMINTX) CHARACTER*4 ADECK_DIR, ADECK_DIR_SUPA, SYNOPTIC_TIME CHARACTER*7 LABEL(NMDX,2*NVTX) CHARACTER*8 STMID, STMID_LC, STMIDL, BASIN CHARACTER*10 STMNAME, LOGNAME, STMNAMEX CHARACTER*18 FNAMEIN1, FNAMEIN2 CHARACTER*20 SAMPLE, SAMPLE_SPRD CHARACTER*60 LIST_LABEL CHARACTER*60 FNAME_CTRL, FNAME_CTRL2, FNAME_LOG, FNAME_STLOG CHARACTER*60 FNAME_WW, FNAME_MINT CHARACTER*60 FNAME_FL, FNAME_SPRD, FNAME_ALLT, FNAME_ALLI CHARACTER*60 FNAME_CONA, FNAME_CONB, FNAME_CONC, FNAME_COND CHARACTER*60 FNAME_CONE, FNAME_CONF, FNAME_CONG, FNAME_CONH CHARACTER*60 FNAME_CONI, FNAME_CONJ, FNAME_CONX, FNAME_CONY CHARACTER*60 FNAME_KGRF, FNAME_CLSH, FNAME_SUPA CHARACTER*60 FORMATSTRING, CLIPSTRING DIMENSION MDAYS(12), IRADQ(4) DIMENSION BYEAR(NBTX), BMO(NBTX), BDY(NBTX), BHR(NBTX) DIMENSION BTIME(NBTX), BLAT(NBTX), BLON(NBTX), BWS(NBTX) DIMENSION BRAD(NBTX,3,4), VRAD(3,4) DIMENSION FLAT(NVTX,NMDX), FLON(NVTX,NMDX), FWND(NVTX,NMDX) DIMENSION FRAD(NVTX,3,4,NMDX), NFRI(NVTX,NMDX) DIMENSION CLAT(10),CLON(10),SWND(10) DIMENSION TCLAT(NVTX),TCLON(NVTX),TCWND(NVTX) DIMENSION ERRT(NVTX,NMDX), ERRI(NVTX,NMDX), ERRIABS(NVTX,NMDX) DIMENSION ERRR(NVTX,3,4,NMDX), ERRRABS(NVTX,3,4,NMDX) DIMENSION XERR(NVTX,NMDX), YERR(NVTX,NMDX) DIMENSION AERR(NVTX,NMDX), CERR(NVTX,NMDX) DIMENSION FOR_INT(NVTX,NMDX), VER_INT(NVTX,NMDX) DIMENSION FOR_RAD(NVTX,3,4,NMDX), VER_RAD(NVTX,3,4,NMDX) DIMENSION ITIME(NVTX), NSFT(NVTX), NSFI(NVTX), NSFR(NVTX,3,4) DIMENSION ITIMO(NVTO) DIMENSION NSFAC(NVTX), NYFAC(NVTX) DIMENSION NYFT(NVTX), NYFI(NVTX), NYFR(NVTX,3,4) DIMENSION STERRAVG(NVTX,NMDX), SIERRAVG(NVTX,NMDX) DIMENSION SIERRAVGA(NVTX,NMDX) DIMENSION STERRTOT(NVTX,NMDX), SIERRTOT(NVTX,NMDX) DIMENSION SIERRTOTA(NVTX,NMDX) DIMENSION SIERRSSQ(NVTX,NMDX) DIMENSION SRERRTOT(NVTX,3,4,NMDX), SRERRTOTA(NVTX,3,4,NMDX) DIMENSION SRERRSSQ(NVTX,3,4,NMDX) DIMENSION SRERRAVG(NVTX,3,4,NMDX), SRERRAVGA(NVTX,3,4,NMDX) DIMENSION STXERTOT(NVTX,NMDX), STXERAVG(NVTX,NMDX) DIMENSION STYERTOT(NVTX,NMDX), STYERAVG(NVTX,NMDX) DIMENSION STAERTOT(NVTX,NMDX), STAERAVG(NVTX,NMDX) DIMENSION STCERTOT(NVTX,NMDX), STCERAVG(NVTX,NMDX) DIMENSION STAERTOTSQ(NVTX,NMDX), STAERSTD(NVTX,NMDX) DIMENSION STCERTOTSQ(NVTX,NMDX), STCERSTD(NVTX,NMDX) DIMENSION STAERTOTA(NVTX,NMDX), STAERAVGA(NVTX,NMDX) DIMENSION STCERTOTA(NVTX,NMDX), STCERAVGA(NVTX,NMDX) DIMENSION STDIRAVG(NVTX,NMDX), STMAGAVG(NVTX,NMDX) DIMENSION STLATTOT(NVTX,NMDX), STLATAVG(NVTX,NMDX) DIMENSION STM_ACE(NBTX,NVTX,NMDX), STM_CCE(NBTX,NVTX,NMDX) DIMENSION YTLATTOT(NVTX,NMDX), YTLATAVG(NVTX,NMDX) DIMENSION YTERRAVG(NVTX,NMDX), YIERRAVG(NVTX,NMDX) DIMENSION YIERRAVGA(NVTX,NMDX) DIMENSION YTERRTOT(NVTX,NMDX), YIERRTOT(NVTX,NMDX) DIMENSION YIERRTOTA(NVTX,NMDX) DIMENSION YIERRSSQ(NVTX,NMDX), YIERRTSTAT(NVTX,NMDX) DIMENSION YTXERTOT(NVTX,NMDX), YTXERAVG(NVTX,NMDX) DIMENSION YTYERTOT(NVTX,NMDX), YTYERAVG(NVTX,NMDX) DIMENSION YTAERTOT(NVTX,NMDX), YTAERAVG(NVTX,NMDX) DIMENSION YTCERTOT(NVTX,NMDX), YTCERAVG(NVTX,NMDX) DIMENSION YTAERTOTSQ(NVTX,NMDX), YTAERSTD(NVTX,NMDX) DIMENSION YTCERTOTSQ(NVTX,NMDX), YTCERSTD(NVTX,NMDX) DIMENSION YTAERTOTA(NVTX,NMDX), YTAERAVGA(NVTX,NMDX) DIMENSION YTCERTOTA(NVTX,NMDX), YTCERAVGA(NVTX,NMDX) DIMENSION YTDIRAVG(NVTX,NMDX), YTMAGAVG(NVTX,NMDX) DIMENSION YTERRRAT(NVTX), YIERRRATA(NVTX) DIMENSION YRERRTOT(NVTX,3,4,NMDX), YRERRTOTA(NVTX,3,4,NMDX) DIMENSION YRERRSSQ(NVTX,3,4,NMDX) DIMENSION YRERRAVG(NVTX,3,4,NMDX), YRERRAVGA(NVTX,3,4,NMDX) DIMENSION STNSP(NVTX,NMDX), STFSP(NVTX,NMDX) DIMENSION SINSP(NVTX,NMDX), SIFSP(NVTX,NMDX) DIMENSION YTNSP(NVTX,NMDX), YTFSP(NVTX,NMDX) DIMENSION YINSP(NVTX,NMDX), YIFSP(NVTX,NMDX) DIMENSION SICATTOT(NVTX,NMDX,NCATX,NCATX) DIMENSION YICATTOT(NVTX,NMDX,NCATX,NCATX) DIMENSION IYR1(NVTX),IYR2(NVTX), FRACN(NVTX) DIMENSION IMO1(NVTX),IMO2(NVTX) DIMENSION IDY1(NVTX),IDY2(NVTX) DIMENSION HR1(NVTX),HR2(NVTX) DIMENSION ACBTLAT(NACPTS), ACBTLON(NACPTS) DIMENSION ACFCLAT(NACPTS), ACFCLON(NACPTS) DIMENSION CROSSE(NACPTS), ALONGE(NACPTS) DIMENSION IXACE(NACPTS), IXACEI(NVTX) DIMENSION STIND_AT(NVTX,NMDX), STIND_CT(NVTX,NMDX) DIMENSION YTIND_AT(NVTX,NMDX), YTIND_CT(NVTX,NMDX) DIMENSION MLAG(NMDX) DOUBLE PRECISION BDATE(NBTX), DATEMIN, DATEMAX C LOGICAL VER_YEAR, INTERP12, OFCLT(NVTX), OFCL_INC, OFCL_SUP LOGICAL TSWATCH(NVTX), TSWARN(NVTX) LOGICAL HWATCH(NVTX), HWARN(NVTX) LOGICAL CLIMO, STATSIG, VER_TD_INIT, VER_NY34, VICAT LOGICAL VER_RADII, TIERR_SPRD, ACERR_SPRD, XYERR_SPRD LOGICAL FIERR_SPRD, RDERR_SPRD(3,4) LOGICAL VERIFY_BOX, VER_OPER, VER_SAB, VER_RI, VER_RW LOGICAL VER_RIF LOGICAL KGRFRAD, WATER_ONLY, WS_CRIT_VT LOGICAL ACPTALLST_IT, ACPTALLST_VT LOGICAL READ_CLSH, WRITE_CLSH, MODEL_CL, READ_SUPA LOGICAL IN_LIST, VT_LIST, SKP_ENSM LOGICAL RI_BEST,RI_FCST(NVTX) LOGICAL COMBO_EPCP, COMBO_ALEP LOGICAL FDIFF_ONLY, PDIFF, WDIFF, FRACN_TRK C DATA MDAYS/31,28,31,30,31,30,31,31,30,31,30,31/ C C C ITIME lists times that will be verified, length NVTX. C OFCLT identifies which of these appear in OFCL forecasts, C ITIMO also identifies OFCL times, length NVTO. C The latter two facilitiate outputs only showing OFCL C forecast verification times. NVTX dependency. C --------------------------------------------------------- DATA ITIME/ 0, 12, 24, 36, 48, * 60, 72, 84, 96, 108, * 120, 132, 144, 156, 168/ DATA OFCLT/ .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., * .TRUE., .TRUE.,.FALSE., .TRUE.,.FALSE., * .TRUE.,.FALSE., .TRUE.,.FALSE., .TRUE./ DATA ITIMO/ 0,12,24,36,48,60,72,96,120,144,168/ C C C Arrays relating to along/cross-track errors, which work on 6-h C intervals. First array places a sequential number in each 6-h C interval that corresponds to a verification time, while the C second array identifies which 6-h elements correspond to C verification times. NVTX dependency. C -------------------------------------------------------------- DATA IXACE/1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11, * 0,12,0,13,0,14,0,15/ DATA IXACEI/1,3,5,7,9,11,13,15,17,19,21,23,25,27,29/ C C C C Initialize variables C -------------------- LUT = 1 LUFI1 = 121 !Control file - user input LUFI2 = 122 !Options file - user editable LUFIB = 123 !B-deck LUFIA = 124 !Primary a-deck LUFIS = 125 !Supplementary a-decks LUFIW = 126 !Watch/warning file LUFIL = 127 !Forecast list LUFIC = 128 !Consensus LUFII = 129 !Interpolated "2" models list C LUFO1 = 131 !Individual storm log LUFO2 = 132 !Expanded sample summary log LUFOS = 133 !Spreadsheet log LUFOK = 134 !Kaleidagraph output LUFOT = 135 !All track models for TCRs LUFOI = 136 !All intensity models for TCRs LUFOC = 137 !CLIPER files C OPEN(LUT,FILE='/dev/tty') FNAME_CTRL = 'verify_model.ctl' FNAME_CTRL2 = 'verify_model_options.dat' FNAME_LOG = 'model_logs/BB##YEAR_MODL.log' FNAME_STLOG = 'model_logs/STORMIDX_MODL.log' FNAME_SPRD = 'model_logs/verifym_sprd.log' FNAME_ALLT = 'model_logs/verifym_allt.log' FNAME_ALLI = 'model_logs/verifym_alli.log' FNAME_KGRF = 'model_logs/verifym_kgrf.log' FNAME_FL = 'verify_model_fcstlist.txt' FNAME_MINT = 'verify_model_intplist.txt' FNAME_CONA = 'verify_model_cona.txt' FNAME_CONB = 'verify_model_conb.txt' FNAME_CONC = 'verify_model_conc.txt' FNAME_COND = 'verify_model_cond.txt' FNAME_CONE = 'verify_model_cone.txt' FNAME_CONF = 'verify_model_conf.txt' FNAME_CONG = 'verify_model_cong.txt' FNAME_CONH = 'verify_model_conh.txt' FNAME_CONI = 'verify_model_coni.txt' FNAME_CONJ = 'verify_model_conj.txt' FNAME_CONX = 'verify_model_conx.txt' FNAME_CONY = 'verify_model_cony.txt' CLIPSTRING = ', 0, , 0, , 0, 0, 0, 0, ' C BAD = -999. BADD = -9999. VER_YEAR = .FALSE. OFCL_INC = .FALSE. COMBO_EPCP = .FALSE. COMBO_ALEP = .FALSE. LOGNAME = ' ' NS = 0 NVTX2 = NVTX*2 NVTO2 = NVTO*2 DASH = '-' SLASH = '/' COLON = ':' CMSP = ', ' IMN = 0 ISE = 0 C NMCX = 0 NMCY = 0 NMTA = 0 NMIA = 0 NMTB = 0 NMIB = 0 NMTC = 0 NMIC = 0 NMTD = 0 NMID = 0 NMTE = 0 NMIE = 0 NMTF = 0 NMIF = 0 NMTG = 0 NMIG = 0 NMTH = 0 NMIH = 0 NMTI = 0 NMII = 0 NMTJ = 0 NMIJ = 0 C DO 50 L = 1,NBTX DO 55 K = 1,3 DO 60 M = 1,4 BRAD(L,K,M) = BAD 60 CONTINUE 55 CONTINUE 50 CONTINUE C DO 65 L = 1, NMDX MLAG(L) = 0 65 CONTINUE C C C Special verification for those points within NWINDOW hours prior C to actual landfall. Only invoked if WATER_ONLY is true and C NWINDOW is greater than zero. C ---------------------------------------------------------------- NWINDOW = 0 C C C C ----------------------------------------------------------------------- C Read first control file verify_model_options.dat to get parameters C that don't change much. This input file must be edited by C hand to make changes. Parameters: C ----------------------------------------------------------------------- C C ADECK_DIR Subdirectory for a-decks (normally "data") C C READ_SUPA True to read from supplemental a-decks C C ADECK_DIR_SUPA Subdirectory for supplemental a-decks C C FNAME_WW File name containing watch/warning data. C C DATEMIN,DATEMAX Minimum and maximum dates forecast issuance C dates to include in verification (YYYYMMDD). C Should be 0 to include all dates. C C SYNOPTIC_TIME CHAR*4 variable to identify which synoptic times C get verified (Y=yes, N=no; normally set to C "YYYY". For example, to verify only 06 and 18Z, C set SYNOPTIC_TIME = "NYNY". C C RLATMIN,RLATMAX define acceptable lats for tau=0 BT points. C RLONMIN,RLONMAX likewise for longitude (E). C C VERIFY_BOX If true, then only forecasts verifying C within lat/lon box below are included. C FLATMIN,FLATMAX define acceptable lats for forecast points. C FLONMIN,FLONMAX likewise for longitude (E). C C ICS_PROC Option for special CLIPER/SHIFOR processing: C 0 Normal (compute cliper on the fly) C 1 Compute and write out results to supplemental file C 2 Read CLP/SHF from supplemental file C 3 Read CLP/SHF from regular A-deck C C MLAG(5) Lag (h) for the first 5 input models. Lag is C subtracted from requested time, i.e., will read C an older version of the model. C C INTERP12 True to use 12 h interpolated models if 6-h not there. C C NMMIN Minimum number of required models for variable consensus. C C WATER_ONLY Stop verification when either forecast or C best track hits land? C C FCSTNEARLAND "A" to keep all fcsts C "N" to keep only forecasts near land C "F" to keep only forecasts far from land C C SIZECHECK "A" to keep all fcsts C "L" to keep only storms with ROCI large C "S" to keep only storms with ROCI small C C DIST_LAND Threshold (nmi) for FCSTNEARLAND C C STMSIZE Threshold (nmi) for SIZECHECK C C WSDIS Intensity assigned to dissipation stage (kt) C C WS_CRIT_VT True to apply the WSMIN/WSMAX selection criteria C to the verification time (it's always applied to C to the forecast initial time). C C ACPTALLST_IT True to accept all status types at the forecast C initial time (intended to evaluate disturbance C forecasts). C C ACPTALLST_VT True to accept all status types at the forecast C verification time (intended to evaluate disturbance C forecasts). C C VER_TD_INIT True to only verify forecasts issued when C system was a TD at T=0. C C VER_NY34 True to only verify forecasts issued prior to C the system reaching 34 kt or higher wind. C C VER_RI True to only verify forecasts issued when rapid C intensification or weakening has occurred in the C period ending at the verification time. C C VER_RIF True to only verify forecasts issued when rapid C intensification (but not RW) either occurred OR C was forecast to occur for the period ending at the C verification time. Note that this will be triggered C if RI occurs either in the best track or in ANY of C the models composing the sample, including consensus C members. C C DELW_RI,DELT_RI Definition of RI (DELW_RI kt increase in DELT_RI hours). C DELT_RI must be in intervals of 6 h. Note that DELW_RI C defines rapid weakening if less than zero, C C VICAT True to verify intensity categories, i.e., C forecast depression and verified as hurricane. C NOTE: Setting VICAT to true will override C choices for WSMIN and VER_NONBT. WSMIN C will be set to 0 and we will verify the C dissipation stage. C C VER_OPER Verify using operational track? C C VER_SAB Verify using SAB classification? C C SKP_ENSM Skip over ensemble members in a-decks to save time? C C SPRD_PAR defines what parameters are written to the C spreadsheet output file: C TI gives track and intensity errors C AC gives along/cross track position errors C XY gives x and y component position errors C FI gives fcst and ver intensities C 31 gives fcst and ver 34 kt radii, quad1 C 32 gives fcst and ver 34 kt radii, quad2 C 33 gives fcst and ver 34 kt radii, quad3 C 34 gives fcst and ver 34 kt radii, quad4 C 51 gives fcst and ver 50 kt radii, quad1 C 52 gives fcst and ver 50 kt radii, quad2 C 53 gives fcst and ver 50 kt radii, quad3 C 54 gives fcst and ver 50 kt radii, quad4 C 61 gives fcst and ver 64 kt radii, quad1 C 62 gives fcst and ver 64 kt radii, quad2 C 63 gives fcst and ver 64 kt radii, quad3 C 64 gives fcst and ver 64 kt radii, quad4 C C SPRD_FRC Count fractional sprd cases based on (T)rack C or (I)ntensity forecast availability C C KGRFPAR Determines parameters to go in Kgraph file. C N - Normal track/intensity means C R - Radii verification C A - Along/cross track errors C V - Variability (stdev) of along/cross track errors C F - Track/intensity FSP C C VER_RADII Do radii verification? C C CLIMO True to print statistics about the sample. C C STATSIG True to gives T statistic on the wind speed C error. C C OFCL_SUP True to suppress printing of non-OFCL times when C OFCL is part of the sample. C --------------------------------------------------------------------------- C 100 OPEN(LUFI2,FILE=FNAME_CTRL2,STATUS='OLD',ERR=9000) READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A4)',ERR=9000) ADECK_DIR READ(LUFI2,'(A1)',ERR=9000) ADUM1 READ_SUPA = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') READ_SUPA=.TRUE. READ(LUFI2,'(A4)',ERR=9000) ADECK_DIR_SUPA READ(LUFI2,'(A15)',ERR=9000) FNAME_WW READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,*,ERR=9000) DATEMIN,DATEMAX READ(LUFI2,'(A4)') SYNOPTIC_TIME READ(LUFI2,*,ERR=9000) RLATMIN,RLATMAX READ(LUFI2,*,ERR=9000) RLONMIN,RLONMAX READ(LUFI2,'(A1)',ERR=9000) ADUM1 VERIFY_BOX = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VERIFY_BOX=.TRUE. READ(LUFI2,*,ERR=9000) FLATMIN,FLATMAX READ(LUFI2,*,ERR=9000) FLONMIN,FLONMAX IF (.NOT.VERIFY_BOX) THEN FLATMIN = BAD FLONMIN = BAD FLATMAX = BAD FLONMAX = BAD ENDIF READ(LUFI2,*) ICS_PROC WRITE_CLSH = .FALSE. READ_CLSH = .FALSE. IF (ICS_PROC .EQ. 1) THEN WRITE_CLSH = .TRUE. READ_CLSH = .FALSE. ENDIF IF (ICS_PROC .EQ. 2) THEN WRITE_CLSH = .FALSE. READ_CLSH = .TRUE. ENDIF READ(LUFI2,*) (MLAG(L),L=1,5) READ(LUFI2,'(A1)',ERR=9000) ADUM1 INTERP12 = .TRUE. IF (ADUM1.EQ.'N'.OR.ADUM1.EQ.'n') INTERP12=.FALSE. READ(LUFI2,*,ERR=9000) NMMIN READ(LUFI2,'(A1)',ERR=9000) ADUM1 WATER_ONLY = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') WATER_ONLY=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 FCSTNEARLAND = 'A' IF (ADUM1.EQ.'F'.OR.ADUM1.EQ.'f') FCSTNEARLAND='F' IF (ADUM1.EQ.'N'.OR.ADUM1.EQ.'n') FCSTNEARLAND='N' READ(LUFI2,'(A1)',ERR=9000) ADUM1 SIZECHECK = 'A' IF (ADUM1.EQ.'L'.OR.ADUM1.EQ.'l') SIZECHECK='L' IF (ADUM1.EQ.'S'.OR.ADUM1.EQ.'s') SIZECHECK='S' READ(LUFI2,*,ERR=9000) DIST_LAND READ(LUFI2,*,ERR=9000) STMSIZE READ(LUFI2,*,ERR=9000) WSDIS READ(LUFI2,'(A1)',ERR=9000) ADUM1 WS_CRIT_VT = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') WS_CRIT_VT=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 ACPTALLST_IT = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') ACPTALLST_IT=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 ACPTALLST_VT = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') ACPTALLST_VT=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_TD_INIT = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_TD_INIT=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_NY34 = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_NY34=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 FDIFF_ONLY = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') FDIFF_ONLY = .TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_RI = .FALSE. VER_RW = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_RI=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_RIF = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_RIF=.TRUE. READ(LUFI2,*,ERR=9000) DELW_RI, DELT_RI IF (VER_RI) THEN IF (DELW_RI.LT.0 .AND. DELW_RI.GT.-100) VER_RW = .TRUE. ENDIF READ(LUFI2,'(A1)',ERR=9000) ADUM1 VICAT = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VICAT=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_OPER = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_OPER=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_SAB = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_SAB=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 SKP_ENSM = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') SKP_ENSM=.TRUE. READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP READ(LUFI2,'(A1)',ERR=9000) SKIP C READ(LUFI2,'(A2)',ERR=9000) SPRD_PAR TIERR_SPRD = .FALSE. ACERR_SPRD = .FALSE. XYERR_SPRD = .FALSE. FIERR_SPRD = .FALSE. DO 106 I=1,3 DO 105 J=1,4 RDERR_SPRD(I,J) = .FALSE. 105 CONTINUE 106 CONTINUE IF (SPRD_PAR.EQ.'TI'.OR.SPRD_PAR.EQ.'ti') TIERR_SPRD = .TRUE. IF (SPRD_PAR.EQ.'AC'.OR.SPRD_PAR.EQ.'ac') ACERR_SPRD = .TRUE. IF (SPRD_PAR.EQ.'XY'.OR.SPRD_PAR.EQ.'xy') XYERR_SPRD = .TRUE. IF (SPRD_PAR.EQ.'FI'.OR.SPRD_PAR.EQ.'fi') FIERR_SPRD = .TRUE. IF (SPRD_PAR.EQ.'31') RDERR_SPRD(1,1) = .TRUE. IF (SPRD_PAR.EQ.'32') RDERR_SPRD(1,2) = .TRUE. IF (SPRD_PAR.EQ.'33') RDERR_SPRD(1,3) = .TRUE. IF (SPRD_PAR.EQ.'34') RDERR_SPRD(1,4) = .TRUE. IF (SPRD_PAR.EQ.'51') RDERR_SPRD(2,1) = .TRUE. IF (SPRD_PAR.EQ.'52') RDERR_SPRD(2,2) = .TRUE. IF (SPRD_PAR.EQ.'53') RDERR_SPRD(2,3) = .TRUE. IF (SPRD_PAR.EQ.'54') RDERR_SPRD(2,4) = .TRUE. IF (SPRD_PAR.EQ.'61') RDERR_SPRD(3,1) = .TRUE. IF (SPRD_PAR.EQ.'62') RDERR_SPRD(3,2) = .TRUE. IF (SPRD_PAR.EQ.'63') RDERR_SPRD(3,3) = .TRUE. IF (SPRD_PAR.EQ.'64') RDERR_SPRD(3,4) = .TRUE. C READ(LUFI2,'(A1)',ERR=9000) ADUM1 CALL UPPERCASE(ADUM1) SPRD_FRC = ADUM1 FRACN_TRK = .TRUE. IF (SPRD_FRC.EQ.'I') FRACN_TRK=.FALSE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 CALL UPPERCASE(ADUM1) KGRFPAR = ADUM1 READ(LUFI2,'(A1)',ERR=9000) ADUM1 VER_RADII = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') VER_RADII=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 CLIMO = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') CLIMO=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 STATSIG = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') STATSIG=.TRUE. READ(LUFI2,'(A1)',ERR=9000) ADUM1 OFCL_SUP = .FALSE. IF (ADUM1.EQ.'Y'.OR.ADUM1.EQ.'y') OFCL_SUP=.TRUE. CLOSE(LUFI2) C C C C C C ----------------------------------------------------------- C Read second control file to get verification parameters C that are set by the user in verify_model.cmd: C ----------------------------------------------------------- C STMID Storm(s) to be verified. To verify a C single storm, enter the 8-char ATCF stm C id. To verify all storms in a season, C replace the storm number with "SY", e.g., C EPSY2003 verifies all the eastpac for C 2003. To do multiple years, use "MY" and the C last two digits of the beginning and C ending years in the year slot, e.g., C ALMY9403 verifies the Atlantic from C 1994 through 2003. C C NMD Number of models to be verified. If more C than 1, a homogeneous verification is C performed. C C MODEL list List of model ATCF identifiers (CHAR*4), C one model per line of input file. C C WSMIN, WXMAX Wind speed range to verify. Storm must C have winds in this range at the initial C time and the verifying time. C C VER_SUBT True to include subtropical stage. C C VER_EXTRAT True to include extratropical stage. C C VER_NONBT True to assign WSDIS kt to forecasts of C dissipation, and to verifying times when C nothing exists in the best track. So, if C dissipation is forecast and there is a 50 kt C storm at the verification time, this would be C an error of 50-WSDIS kt. Similarly, if the C forecast is for a 50 kt storm and the system C is gone, that would be a similar error. C No verification is done if BOTH the forecast C and the verifying status is for dissipation. C C WWARN Verify based on whether C watches and warnings were in effect: C N - All forecasts without regard to W/W status C I - Forecasts issued when W/W in effect C J - Forecasts issued when W/W NOT in effect C V - Forecasts verifying when W/W in effect C W - Forecasts verifying when W/W NOT in effect C H - Forecasts issued when hurricane W/W in effect C C VER_LIST Verify only those forecasts from a list contained C in file fcst_list.txt. Options are: C I - Includes all forecast initial times from the list C E - Excludes all forecast initial times from the list C B - Includes forecast if BOTH the initial time AND C the verifying time appears in the list C Note that the cases defined by the input sample, e.g., C alal1517, still applies. Forecasts in the list but which C are outside of the requested input sample will NOT be C included. C Note that answering "Y" is equivalent to "I". C C FCSTRV Verify a particular forecaster, or "ALL". C ------------------------------------------------------------- C 130 OPEN(LUFI1,FILE=FNAME_CTRL,STATUS='OLD',ERR=9000) READ(LUFI1,'(A8)',ERR=9000) STMID READ(LUFI1,*) NMD DO 131 L=1,NMD READ(LUFI1,'(A4)',ERR=9000) MODEL(L) IF (MODEL(L)(4:4).EQ.' ') MODEL(L)(4:4) = DASH DO 132 K = 1,NVTX2 IF (K.LE.NVTX) THEN IVT = ITIME(K) FTYPE = 'T' IF (ACERR_SPRD) FTYPE = 'A' IF (XYERR_SPRD) FTYPE = 'X' IF (FIERR_SPRD) FTYPE = 'F' IF (SPRD_PAR(1:1).EQ.'3' .OR. * SPRD_PAR(1:1).EQ.'5' .OR. * SPRD_PAR(1:1).EQ.'6') FTYPE = 'F' ELSE IVT = ITIME(K-NVTX) FTYPE = 'I' IF (ACERR_SPRD) FTYPE = 'C' IF (XYERR_SPRD) FTYPE = 'Y' IF (FIERR_SPRD) FTYPE = 'V' IF (SPRD_PAR(1:1).EQ.'3' .OR. * SPRD_PAR(1:1).EQ.'5' .OR. * SPRD_PAR(1:1).EQ.'6') FTYPE = 'V' ENDIF WRITE(LABEL(L,K),'(I3.3,"h",A1,I2.2)') IVT,FTYPE,L 132 CONTINUE 131 CONTINUE C READ(LUFI1,*) WSMIN, WSMAX READ(LUFI1,'(A1)') VER_SUBT READ(LUFI1,'(A1)') VER_EXTRAT READ(LUFI1,'(A1)') VER_NONBT READ(LUFI1,'(A1)') WWARN READ(LUFI1,'(A1)') VER_LIST READ(LUFI1,'(A3)') FCSTRV C C C Modify some input parameters if we are doing an C intensity category verification. C ----------------------------------------------- IF (VICAT) THEN WSMIN = 0 VER_NONBT = 'Y' WRITE(LUT,'(/"Verifying intensity categories. Resetting")') WRITE(LUT,'("WSMIN = 0 and verifying dissipation stage."/)') ENDIF C C C Finish cleaning up input parameters. C ------------------------------------ STMID_LC = STMID CALL UPPERCASE(WWARN) CALL UPPERCASE(VER_LIST) IF (VER_LIST.EQ.'Y') VER_LIST='I' VT_LIST=.FALSE. IF (VER_LIST.EQ.'B') THEN VER_LIST='I' VT_LIST=.TRUE. ENDIF CALL UPPERCASE(VER_EXTRAT) CALL UPPERCASE(VER_NONBT) CALL UPPERCASE(VER_SUBT) DO 135 L=1,4 CALL UPPERCASE(SYNOPTIC_TIME(L:L)) 135 CONTINUE C C C Some preliminary processing based on model C selections. C ------------------------------------------ DO 140 K = 1,NMD DO 141 L = 1,4 CALL UPPERCASE(MODEL(K)(L:L)) 141 CONTINUE C C If OFCL is one of the models, set flag so C that output files won't include verification C times for non-official times. C --------------------------------------------- IF (MODEL(K).EQ.'OFCL') OFCL_INC = .TRUE. C C C Accept GFSO, GFSI as requests for AVNO, AVNI. C Change output of AVNO, AVNI to GFSO, GFSI. C Also, treat EMH as a request for EMX. C -------------------------------------------- IF (MODEL(K).EQ.'GFSO') MODEL(K) = 'AVNO' IF (MODEL(K).EQ.'GFSI') MODEL(K) = 'AVNI' IF (MODEL(K).EQ.'EMH-') MODEL(K) = 'EMX-' IF (MODEL(K).EQ.'EMHI') MODEL(K) = 'EMXI' IF (MODEL(K).EQ.'EMH2') MODEL(K) = 'EMX2' C MODELO(K) = MODEL(K) IF (MODELO(K)(4:4).EQ."-") MODELO(K)(4:4) = " " IF (MODEL(K).EQ.'AVNO') MODELO(K) = 'GFSO' IF (MODEL(K).EQ.'AVNI') MODELO(K) = 'GFSI' C CC IF (MODEL(K).EQ.'CONA') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONA, * NMTA,MODELTA,NMIA,MODELIA) IF (MODEL(K).EQ.'CONB') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONB, * NMTB,MODELTB,NMIB,MODELIB) IF (MODEL(K).EQ.'CONC') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONC, * NMTC,MODELTC,NMIC,MODELIC) IF (MODEL(K).EQ.'COND') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_COND, * NMTD,MODELTD,NMID,MODELID) IF (MODEL(K).EQ.'CONE') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONE, * NMTE,MODELTE,NMIE,MODELIE) IF (MODEL(K).EQ.'CONF') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONF, * NMTF,MODELTF,NMIF,MODELIF) IF (MODEL(K).EQ.'CONG') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONG, * NMTG,MODELTG,NMIG,MODELIG) IF (MODEL(K).EQ.'CONH') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONH, * NMTH,MODELTH,NMIH,MODELIH) IF (MODEL(K).EQ.'CONI') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONI, * NMTI,MODELTI,NMII,MODELII) IF (MODEL(K).EQ.'CONJ') * CALL GET_VCONSENSUS(LUFIC,LUT,FNAME_CONJ, * NMTJ,MODELTJ,NMIJ,MODELIJ) C IF (MODEL(K).EQ.'CONX') * CALL GET_CONSENSUS(LUFIC,LUT,FNAME_CONX,NMCX,MODELCX) IF (MODEL(K).EQ.'CONY') * CALL GET_CONSENSUS(LUFIC,LUT,FNAME_CONY,NMCY,MODELCY) 140 CONTINUE C DO 145 K = 1,NMCX MODELCXO(K) = MODELCX(K) IF (MODELCXO(K)(4:4).EQ."-") MODELCXO(K)(4:4) = " " IF (MODELCX(K).EQ.'AVNO') MODELCXO(K) = 'GFSO' IF (MODELCX(K).EQ.'AVNI') MODELCXO(K) = 'GFSI' 145 CONTINUE DO 146 K = 1,NMCY MODELCYO(K) = MODELCY(K) IF (MODELCYO(K)(4:4).EQ."-") MODELCYO(K)(4:4) = " " IF (MODELCY(K).EQ.'AVNO') MODELCYO(K) = 'GFSO' IF (MODELCY(K).EQ.'AVNI') MODELCYO(K) = 'GFSI' 146 CONTINUE C DO 147 K = 1,NMTA MODELTAO(K) = MODELTA(K) IF (MODELTAO(K)(4:4).EQ."-") MODELTAO(K)(4:4) = " " IF (MODELTA(K).EQ.'AVNO') MODELTAO(K) = 'GFSO' IF (MODELTA(K).EQ.'AVNI') MODELTAO(K) = 'GFSI' 147 CONTINUE DO 148 K = 1,NMIA MODELIAO(K) = MODELIA(K) IF (MODELIAO(K)(4:4).EQ."-") MODELIAO(K)(4:4) = " " IF (MODELIA(K).EQ.'AVNO') MODELIAO(K) = 'GFSO' IF (MODELIA(K).EQ.'AVNI') MODELIAO(K) = 'GFSI' 148 CONTINUE C DO 149 K = 1,NMTB MODELTBO(K) = MODELTB(K) IF (MODELTBO(K)(4:4).EQ."-") MODELTBO(K)(4:4) = " " IF (MODELTB(K).EQ.'AVNO') MODELTBO(K) = 'GFSO' IF (MODELTB(K).EQ.'AVNI') MODELTBO(K) = 'GFSI' 149 CONTINUE DO 150 K = 1,NMIB MODELIBO(K) = MODELIB(K) IF (MODELIBO(K)(4:4).EQ."-") MODELIBO(K)(4:4) = " " IF (MODELIB(K).EQ.'AVNO') MODELIBO(K) = 'GFSO' IF (MODELIB(K).EQ.'AVNI') MODELIBO(K) = 'GFSI' 150 CONTINUE C DO 151 K = 1,NMTC MODELTCO(K) = MODELTC(K) IF (MODELTCO(K)(4:4).EQ."-") MODELTCO(K)(4:4) = " " IF (MODELTC(K).EQ.'AVNO') MODELTCO(K) = 'GFSO' IF (MODELTC(K).EQ.'AVNI') MODELTCO(K) = 'GFSI' 151 CONTINUE DO 152 K = 1,NMIC MODELICO(K) = MODELIC(K) IF (MODELICO(K)(4:4).EQ."-") MODELICO(K)(4:4) = " " IF (MODELIC(K).EQ.'AVNO') MODELICO(K) = 'GFSO' IF (MODELIC(K).EQ.'AVNI') MODELICO(K) = 'GFSI' 152 CONTINUE C DO 153 K = 1,NMTD MODELTDO(K) = MODELTD(K) IF (MODELTDO(K)(4:4).EQ."-") MODELTDO(K)(4:4) = " " IF (MODELTD(K).EQ.'AVNO') MODELTDO(K) = 'GFSO' IF (MODELTD(K).EQ.'AVNI') MODELTDO(K) = 'GFSI' 153 CONTINUE DO 154 K = 1,NMID MODELIDO(K) = MODELID(K) IF (MODELIDO(K)(4:4).EQ."-") MODELIDO(K)(4:4) = " " IF (MODELID(K).EQ.'AVNO') MODELIDO(K) = 'GFSO' IF (MODELID(K).EQ.'AVNI') MODELIDO(K) = 'GFSI' 154 CONTINUE C DO 155 K = 1,NMTE MODELTEO(K) = MODELTE(K) IF (MODELTEO(K)(4:4).EQ."-") MODELTEO(K)(4:4) = " " IF (MODELTE(K).EQ.'AVNO') MODELTEO(K) = 'GFSO' IF (MODELTE(K).EQ.'AVNI') MODELTEO(K) = 'GFSI' 155 CONTINUE DO 156 K = 1,NMIE MODELIEO(K) = MODELIE(K) IF (MODELIEO(K)(4:4).EQ."-") MODELIEO(K)(4:4) = " " IF (MODELIE(K).EQ.'AVNO') MODELIEO(K) = 'GFSO' IF (MODELIE(K).EQ.'AVNI') MODELIEO(K) = 'GFSI' 156 CONTINUE C DO 157 K = 1,NMTF MODELTFO(K) = MODELTF(K) IF (MODELTFO(K)(4:4).EQ."-") MODELTFO(K)(4:4) = " " IF (MODELTF(K).EQ.'AVNO') MODELTFO(K) = 'GFSO' IF (MODELTF(K).EQ.'AVNI') MODELTFO(K) = 'GFSI' 157 CONTINUE DO 158 K = 1,NMIF MODELIFO(K) = MODELIF(K) IF (MODELIFO(K)(4:4).EQ."-") MODELIFO(K)(4:4) = " " IF (MODELIF(K).EQ.'AVNO') MODELIFO(K) = 'GFSO' IF (MODELIF(K).EQ.'AVNI') MODELIFO(K) = 'GFSI' 158 CONTINUE C DO 159 K = 1,NMTG MODELTGO(K) = MODELTG(K) IF (MODELTGO(K)(4:4).EQ."-") MODELTGO(K)(4:4) = " " IF (MODELTG(K).EQ.'AVNO') MODELTGO(K) = 'GFSO' IF (MODELTG(K).EQ.'AVNI') MODELTGO(K) = 'GFSI' 159 CONTINUE DO 160 K = 1,NMIG MODELIGO(K) = MODELIG(K) IF (MODELIGO(K)(4:4).EQ."-") MODELIGO(K)(4:4) = " " IF (MODELIG(K).EQ.'AVNO') MODELIGO(K) = 'GFSO' IF (MODELIG(K).EQ.'AVNI') MODELIGO(K) = 'GFSI' 160 CONTINUE C DO 161 K = 1,NMTH MODELTHO(K) = MODELTH(K) IF (MODELTHO(K)(4:4).EQ."-") MODELTHO(K)(4:4) = " " IF (MODELTH(K).EQ.'AVNO') MODELTHO(K) = 'GFSO' IF (MODELTH(K).EQ.'AVNI') MODELTHO(K) = 'GFSI' 161 CONTINUE DO 162 K = 1,NMIH MODELIHO(K) = MODELIH(K) IF (MODELIHO(K)(4:4).EQ."-") MODELIHO(K)(4:4) = " " IF (MODELIH(K).EQ.'AVNO') MODELIHO(K) = 'GFSO' IF (MODELIH(K).EQ.'AVNI') MODELIHO(K) = 'GFSI' 162 CONTINUE C DO 163 K = 1,NMTI MODELTIO(K) = MODELTI(K) IF (MODELTIO(K)(4:4).EQ."-") MODELTIO(K)(4:4) = " " IF (MODELTI(K).EQ.'AVNO') MODELTIO(K) = 'GFSO' IF (MODELTI(K).EQ.'AVNI') MODELTIO(K) = 'GFSI' 163 CONTINUE DO 164 K = 1,NMII MODELIIO(K) = MODELII(K) IF (MODELIIO(K)(4:4).EQ."-") MODELIIO(K)(4:4) = " " IF (MODELII(K).EQ.'AVNO') MODELIIO(K) = 'GFSO' IF (MODELII(K).EQ.'AVNI') MODELIIO(K) = 'GFSI' 164 CONTINUE C DO 165 K = 1,NMTJ MODELTJO(K) = MODELTJ(K) IF (MODELTJO(K)(4:4).EQ."-") MODELTJO(K)(4:4) = " " IF (MODELTJ(K).EQ.'AVNO') MODELTJO(K) = 'GFSO' IF (MODELTJ(K).EQ.'AVNI') MODELTJO(K) = 'GFSI' 165 CONTINUE DO 166 K = 1,NMIJ MODELIJO(K) = MODELIJ(K) IF (MODELIJO(K)(4:4).EQ."-") MODELIJO(K)(4:4) = " " IF (MODELIJ(K).EQ.'AVNO') MODELIJO(K) = 'GFSO' IF (MODELIJ(K).EQ.'AVNI') MODELIJO(K) = 'GFSI' 166 CONTINUE C C MODEL_LC = MODEL(1) DO 167 L = 1,4 CALL LOWERCASE(MODEL_LC(L:L)) 167 CONTINUE DO 168 L = 1,8 CALL LOWERCASE(STMID_LC(L:L)) CALL UPPERCASE(STMID(L:L)) 168 CONTINUE DO 169 L = 1,3 CALL UPPERCASE(FCSTRV(L:L)) 169 CONTINUE CLOSE(LUFI1) BASIN = 'UNKNOWN ' IF (STMID(1:2).EQ.'AL') BASIN = 'ATLANTIC' IF (STMID(1:2).EQ.'EP') BASIN = 'EAST PAC' IF (STMID(1:2).EQ.'CP') BASIN = 'CENT PAC' IF (STMID(1:2).EQ.'EC') THEN BASIN = 'EPCP COM' COMBO_EPCP = .TRUE. NCOMB = 1 ENDIF IF (STMID(1:2).EQ.'AE') THEN BASIN = 'ALEP COM' COMBO_ALEP = .TRUE. NCOMB = 1 ENDIF SAMPLE_SPRD = STMID C C C Check to see if domain is consistent with basin. C ------------------------------------------------ IF (STMID(1:2).EQ.'CP' .AND. RLONMIN.GE.-140.) THEN WRITE(LUT,'(/"Domain inconsistent with basin."/)') STOP ENDIF IF (STMID(1:2).EQ.'EC' .AND. RLONMIN.GE.-140.) THEN WRITE(LUT,'(/"Domain inconsistent with basin."/)') STOP ENDIF C C Can only generate CLIP/SHIF for AL and EP C ----------------------------------------- C IF (ICS_PROC.LE.1 .AND. (BASIN.EQ.'UNKNOWN ' .OR. C * BASIN.EQ.'EPCP COM' .OR. BASIN.EQ.'CENT PAC')) THEN C WRITE(LUT,'("Cannot generate CLP/SHF for this basin.")') C STOP C ENDIF C C C Open watch/warning, forecast list files? C ---------------------------------------- IF (WWARN.NE.'N') THEN WRITE(LUT,'("Opening watch/warning file...")') OPEN(LUFIW,FILE=FNAME_WW,STATUS='OLD',ERR=9000) ENDIF IF (VER_LIST.EQ.'I' .OR. VER_LIST.EQ.'E') THEN WRITE(LUT,'("Opening list of forecasts to verify...")') OPEN(LUFIL,FILE=FNAME_FL,STATUS='OLD',ERR=9000) LIST_LABEL = ' ' READ(LUFIL,'(A60)') LIST_LABEL ENDIF C C C Read list of interpolated models C ---------------------------------------- WRITE(LUT,'("Opening interpolated models file...")') OPEN(LUFII,FILE=FNAME_MINT,STATUS='OLD',ERR=9000) READ(LUFII,'(A1)',ERR=9000) SKIP NMINT = 0 185 NMINT = NMINT+1 IF (NMINT.GT.NMINTX) THEN WRITE(LUT,'("Error: Too many entries in intplist.")') STOP ENDIF READ(LUFII,'(A4,1X,A4)') MODELINT2(NMINT), MODELINTI(NMINT) IF (MODELINT2(NMINT)(1:4).EQ.'STOP') THEN NMINT = NMINT-1 GOTO 186 ENDIF IF (INTERP12) * WRITE(LUT,'(A4," > ",A4)') MODELINT2(NMINT), MODELINTI(NMINT) GOTO 185 C C C Do we want to do an entire year (or multiple years)? C ---------------------------------------------------- 186 IF (STMID(3:4).EQ.'AL') GOTO 9030 IF (STMID(3:4).EQ.'SY' .OR. STMID(3:4).EQ.'MY') THEN VER_YEAR = .TRUE. DO 171 K = 1,NMD DO 170 L = 1,NVTX NYFT(L) = 0 NYFI(L) = 0 NFRI(L,K) = 0 YTERRTOT(L,K) = 0. YTLATTOT(L,K) = 0. YTXERTOT(L,K) = 0. YTYERTOT(L,K) = 0. YTAERTOT(L,K) = 0. YTCERTOT(L,K) = 0. YTAERTOTSQ(L,K) = 0. YTCERTOTSQ(L,K) = 0. YTAERTOTA(L,K) = 0. YTCERTOTA(L,K) = 0. YTIND_AT(L,K) = 0. YTIND_CT(L,K) = 0. YIERRTOT(L,K) = 0. YIERRTOTA(L,K) = 0. YIERRSSQ(L,K) = 0. YTNSP(L,K) = 0. YINSP(L,K) = 0. YTERRAVG(L,K) = BAD YTLATAVG(L,K) = BAD YTDIRAVG(L,K) = BAD YTMAGAVG(L,K) = BAD YTAERAVG(L,K) = BAD YTAERSTD(L,K) = BAD YTAERAVGA(L,K) = BAD YTCERAVG(L,K) = BAD YTCERSTD(L,K) = BAD YTCERAVGA(L,K) = BAD YIERRAVG(L,K) = BAD YIERRAVGA(L,K) = BAD YIERRTSTAT(L,K) = BAD YTFSP(L,K) = BAD YIFSP(L,K) = BAD DO 172 M = 1,NCATX DO 173 N = 1,NCATX YICATTOT(L,K,M,N) = 0 173 CONTINUE 172 CONTINUE DO 174 M=1,3 DO 175 N=1,4 NYFR(L,M,N) = 0 YRERRTOT(L,M,N,K) = 0. YRERRTOTA(L,M,N,K) = 0. YRERRSSQ(L,M,N,K) = 0. YRERRAVG(L,M,N,K) = BAD YRERRAVGA(L,M,N,K) = BAD 175 CONTINUE 174 CONTINUE 170 CONTINUE 171 CONTINUE C C READ(STMID(5:8),'(I4)') IXYEAR C C C Are we asking for multiple years? C --------------------------------- C IF (IXYEAR.GE.2050 .OR. IXYEAR.LT.1900) THEN C READ(STMID(5:6),'(I2)') IVYEAR1 C READ(STMID(7:8),'(I2)') IVYEAR2 C IVYEAR1 = IVYEAR1+1900 C IF (IVYEAR1.LT.1944) IVYEAR1 = IVYEAR1+100 C IVYEAR2 = IVYEAR2+1900 C IF (IVYEAR2.LT.1944) IVYEAR2 = IVYEAR2+100 C IVYEAR = IVYEAR1 C ELSE C IVYEAR1 = IXYEAR C IVYEAR2 = IXYEAR C IVYEAR = IXYEAR C ENDIF C C C Determine if it's one year or a range of years C ---------------------------------------------- IF (STMID(3:4).EQ.'SY') THEN IVYEAR1 = IXYEAR IVYEAR2 = IXYEAR IVYEAR = IXYEAR ENDIF IF (STMID(3:4).EQ.'MY') THEN READ(STMID(5:6),'(I2)') IVYEAR1 READ(STMID(7:8),'(I2)') IVYEAR2 IVYEAR1 = IVYEAR1+1900 IF (IVYEAR1.LT.1950) IVYEAR1 = IVYEAR1+100 IVYEAR2 = IVYEAR2+1900 IF (IVYEAR2.LT.1950) IVYEAR2 = IVYEAR2+100 IVYEAR = IVYEAR1 ENDIF C C Open up output log files. C ------------------------- 180 FNAME_LOG(12:19) = STMID_LC WRITE(FNAME_LOG(16:19),'(I4.4)') IXYEAR FNAME_LOG(20:20) = '_' FNAME_LOG(21:24) = MODEL_LC OPEN(LUFO2,FILE=FNAME_LOG,STATUS='UNKNOWN',ERR=9000) OPEN(LUFOK,FILE=FNAME_KGRF,STATUS='UNKNOWN',ERR=9000) SAMPLE = ' ' IF (IVYEAR1.EQ.IVYEAR2) THEN WRITE(SAMPLE,'(A8,1X,I4.4)') BASIN,IVYEAR ELSE WRITE(SAMPLE,'(A8,1X,I4.4,"-",I4.4)') BASIN,IVYEAR1,IVYEAR2 ENDIF SAMPLE_SPRD = SAMPLE CALL LOG_HEADER(LUFO2,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE,LOGNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) CALL LOG_HEADER(LUFOK,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE,LOGNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO2,8194) WRITE(LUFO2,'(179("="))') ELSE WRITE(LUFO2,194) WRITE(LUFO2,'(239("="))') ENDIF C 8194 FORMAT('YEAR',2X,'PARAM',3X,' ERR000 N000', * ' ERR012 N012', * ' ERR024 N024', * ' ERR036 N036', * ' ERR048 N048', * ' ERR060 N060', * ' ERR072 N072', * ' ERR096 N096', * ' ERR120 N120', * ' ERR144 N144', * ' ERR168 N168') 194 FORMAT('YEAR',2X,'PARAM',3X,' ERR000 N000', * ' ERR012 N012', * ' ERR024 N024', * ' ERR036 N036', * ' ERR048 N048', * ' ERR060 N060', * ' ERR072 N072', * ' ERR084 N084', * ' ERR096 N096', * ' ERR108 N108', * ' ERR120 N120', * ' ERR132 N132', * ' ERR144 N144', * ' ERR156 N156', * ' ERR168 N168') ENDIF C C C Open up spreadsheet output C -------------------------- OPEN(LUFOS,FILE=FNAME_SPRD,STATUS='UNKNOWN',ERR=9000) CALL LOG_HEADER(LUFOS,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE_SPRD,LOGNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8196) * ((LABEL(I,IXTAU(ITIMO(J))),J=1,NVTO), * (LABEL(I,NVTX+IXTAU(ITIMO(J))),J=1,NVTO),I=1,NMD) 8196 FORMAT('Date/Time ',14X, * 'STMID',2X, * 'F012',2X, * 'F024',2X, * 'F036',2X, * 'F048',2X, * 'F060',2X, * 'F072',2X, * 'F096',2X, * 'F120',2X, * 'F144',2X, * 'F168',7X, * 'Lat',5X, * 'Lon',4X, * 'WS',400(2X,A7)) ELSE WRITE(LUFOS,196) ((LABEL(I,J),J=1,NVTX2),I=1,NMD) 196 FORMAT('Date/Time ',14X, * 'STMID',2X, * 'F012',2X, * 'F024',2X, * 'F036',2X, * 'F048',2X, * 'F060',2X, * 'F072',2X, * 'F084',2X, * 'F096',2X, * 'F108',2X, * 'F120',2X, * 'F132',2X, * 'F144',2X, * 'F156',2X, * 'F168',7X, * 'Lat',5X, * 'Lon',4X, * 'WS',400(2X,A7)) ENDIF C C C Open up all-model TCR file outputs C ------------------------------------------------- OPEN(LUFOT,FILE=FNAME_ALLT,STATUS='UNKNOWN',ERR=9000) CALL LOG_HEADER(LUFOT,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE_SPRD,LOGNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C OPEN(LUFOI,FILE=FNAME_ALLI,STATUS='UNKNOWN',ERR=9000) CALL LOG_HEADER(LUFOI,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE_SPRD,LOGNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C C C C -------------------------------------------- C Begin cycling through storms to be verified. C Determine storm ID if doing a whole season. C -------------------------------------------- 200 IF (VER_YEAR) THEN NS = NS+1 C C For combined basins determine which we're doing. C ------------------------------------------------ IF (COMBO_EPCP) THEN IF (NCOMB.EQ.1 .AND. NS.EQ.40) THEN NS = 1 NCOMB = 2 ENDIF IF (NCOMB.EQ.1) THEN STMID(1:2) = 'EP' STMID_LC(1:2) = 'ep' ENDIF IF (NCOMB.EQ.2) THEN STMID(1:2) = 'CP' STMID_LC(1:2) = 'cp' ENDIF ENDIF C IF (COMBO_ALEP) THEN IF (NCOMB.EQ.1 .AND. NS.EQ.40) THEN NS = 1 NCOMB = 2 ENDIF IF (NCOMB.EQ.1) THEN STMID(1:2) = 'AL' STMID_LC(1:2) = 'al' ENDIF IF (NCOMB.EQ.2) THEN STMID(1:2) = 'EP' STMID_LC(1:2) = 'ep' ENDIF ENDIF C IF (NS.EQ.40) GOTO 2100 WRITE(STMID(3:4),'(I2.2)') NS WRITE(STMID_LC(3:4),'(I2.2)') NS WRITE(STMID(5:8),'(I4.4)') IVYEAR WRITE(STMID_LC(5:8),'(I4.4)') IVYEAR ENDIF C C C Open files for current storm C ---------------------------- 210 WRITE(LUT,'(/,"Verifying storm ",A8,"...")') STMID FNAMEIN1(1:5) = 'data/' FNAMEIN1(6:6) = 'b' FNAMEIN1(7:14) = STMID FNAMEIN1(15:18) = '.dat' FNAMEIN2 = FNAMEIN1 FNAMEIN2(1:4) = ADECK_DIR FNAMEIN2(5:6) = '/a' IF (VER_OPER) THEN FNAMEIN1(6:6) = 'q' FNAMEIN1(15:18) = '.txt' ENDIF FNAME_CLSH = FNAMEIN1 FNAME_CLSH(6:6) = 'c' FNAME_SUPA = FNAMEIN1 FNAME_SUPA(6:6) = 'a' FNAME_SUPA(1:4) = ADECK_DIR_SUPA C DO 220 L = 1,18 CALL LOWERCASE(FNAMEIN1(L:L)) CALL LOWERCASE(FNAMEIN2(L:L)) CALL LOWERCASE(FNAME_CLSH(L:L)) CALL LOWERCASE(FNAME_SUPA(L:L)) 220 CONTINUE C IF (VER_OPER) THEN WRITE(LUT,'("Opening operational track file...")') ELSE WRITE(LUT,'("Opening best track file...")') ENDIF C OPEN(LUFIB,FILE=FNAMEIN1,STATUS='OLD',ERR=9010) WRITE(LUT,'("Opening aids file...")') OPEN(LUFIA,FILE=FNAMEIN2,STATUS='OLD',ERR=9020) IF (WRITE_CLSH) * OPEN(LUFOC,FILE=FNAME_CLSH,STATUS='UNKNOWN', * ERR=9000) C C C Build a-deck common block from various inputs. C Order is important since only the first occurrence C of a VT line is accepted. C ----------------------------------------------------- NLINES = 0 C C C Read in data from a supplementary file, if specified. C Supplementary data has highest priority. C ----------------------------------------------------- IF (READ_SUPA) THEN OPEN(LUFIS,FILE=FNAME_SUPA,STATUS='OLD',ERR=240) CALL LOAD_ADECK(LUT,LUFIS,STMNAMEX,NLINES,INTERP12, * ACPTALLST_IT,SKP_ENSM, * NMINT,MODELINT2,MODELINTI) ENDIF C C Add in extra cliper/shifor data. Read-in data has C priority over data in the a-decks C -------------------------------------------------- 240 IF (READ_CLSH) THEN OPEN(LUFOC,FILE=FNAME_CLSH,STATUS='OLD',ERR=250) CALL LOAD_ADECK(LUT,LUFOC,STMNAMEX,NLINES,INTERP12, * ACPTALLST_IT,SKP_ENSM, * NMINT,MODELINT2,MODELINTI) ENDIF C C Then read in primary file C ------------------------- 250 CALL LOAD_ADECK(LUT,LUFIA,STMNAME,NLINES,INTERP12, * ACPTALLST_IT,SKP_ENSM, * NMINT,MODELINT2,MODELINTI) C C C C Create output log file for this storm C ------------------------------------- FNAME_STLOG(12:19) = STMID_LC FNAME_STLOG(20:20) = '_' FNAME_STLOG(21:24) = MODEL_LC IF (FNAME_STLOG(24:24).EQ.' ') THEN FNAME_STLOG(24:59) = FNAME_STLOG(25:60) FNAME_STLOG(60:60) = ' ' ENDIF OPEN(LUFO1,FILE=FNAME_STLOG,STATUS='UNKNOWN',ERR=9000) SAMPLE = STMID CALL LOG_HEADER(LUFO1,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE,STMNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C C C Write header info to Kaleidagraph summary file, only if C we are verifying a single storm C ------------------------------------------------------- IF (.NOT. VER_YEAR) THEN OPEN(LUFOK,FILE=FNAME_KGRF,STATUS='UNKNOWN',ERR=9000) SAMPLE = STMID CALL LOG_HEADER(LUFOK,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE,STMNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) ENDIF C C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN IF (.NOT.VER_OPER .AND. .NOT.VER_SAB) WRITE(LUFO1,8294) IF (VER_OPER) WRITE(LUFO1,8295) IF (VER_SAB) WRITE(LUFO1,8296) 8294 FORMAT(15X,'BEST TRACK',14X,'POSITION ERRORS',69X,'WIND ERRORS') 8295 FORMAT(15X,'OPER TRACK',14X,'POSITION ERRORS',69X,'WIND ERRORS') 8296 FORMAT(15X,'SAB CLASS ',14X,'POSITION ERRORS',69X,'WIND ERRORS') WRITE(LUFO1,8297) (ITIMO(I),I=1,NVTO),(ITIMO(I),I=1,NVTO) 8297 FORMAT('DTG',9X,'LAT LON WS MODL',1X,11I8,4X,11I8,/,212('=')) ELSE IF (.NOT.VER_OPER .AND. .NOT.VER_SAB) WRITE(LUFO1,294) IF (VER_OPER) WRITE(LUFO1,295) IF (VER_SAB) WRITE(LUFO1,296) 294 FORMAT(15X,'BEST TRACK',14X,'POSITION ERRORS',109X,'WIND ERRORS') 295 FORMAT(15X,'OPER TRACK',14X,'POSITION ERRORS',109X,'WIND ERRORS') 296 FORMAT(15X,'SAB CLASS ',14X,'POSITION ERRORS',109X,'WIND ERRORS') WRITE(LUFO1,297) (ITIME(I),I=1,NVTX),(ITIME(I),I=1,NVTX) 297 FORMAT('DTG',9X,'LAT LON WS MODL',1X,15I8,4X,15I8,/,276('=')) ENDIF C C C Read best track file C -------------------- DO 299 L=2,NVTX IYR1(L) = 1800 IMO1(L) = 1 IDY1(L) = 1 HR1(L) = 0.0 299 CONTINUE IMOB1 = 0 NB = 0 NBF34 = 999 NBFET = 999 BTIME_LAST = 0. C 300 IF (VER_OPER) THEN CALL READ_OPERTRACK(LUFIB,NB,IERR,IYEAR,IMO,IDY,IHR, * RLAT,RLON,IWS,IPR,IRAD,IRADQ,STATUS) ELSE CALL READ_ATCF_BESTM(LUFIB,IERR,NCYC,IYEAR,IMO,IDY,IHR,IMI, * RLAT,RLON,IWS,IPR,IRAD,IRADQ,STATUS) ENDIF C IF (IERR.EQ.1) GOTO 300 IF (IERR.EQ.2) THEN CLOSE(LUFIB) GOTO 1000 ENDIF C C Skip over any lines that are not at 00, 06, 12, or 18Z C ------------------------------------------------------ IF (IMI.LT.0) IMI = 0 IF (MOD(IHR,6).NE.0 .OR. IMI.NE.0) THEN WRITE(LUT,'("Skipping best track time: ",2i2.2,"/",2i2.2)') * IMO,IDY,IHR,IMI GOTO 300 ENDIF C IYEAROUT = IYEAR IF (IMOB1.EQ.0) IMOB1 = IMO IDYX = IDY C C Had to modify following line for year crossings C ----------------------------------------------- IF (IMO.NE.IMOB1) IDYX = IDY+MDAYS(IMOB1) NB = NB+1 BYEAR(NB) = IYEAR BMO(NB) = IMO BDY(NB) = IDY BHR(NB) = IHR BTIME(NB) = FLOAT(IHR) + FLOAT(IDYX)*24. BDATE(NB) = IYEAR*10000+IMO*100+IDY IRX = INDEX_WRAD(IRAD) IF (IRX.NE.0) THEN BRAD(NB,IRX,1) = IRADQ(1) BRAD(NB,IRX,2) = IRADQ(2) BRAD(NB,IRX,3) = IRADQ(3) BRAD(NB,IRX,4) = IRADQ(4) ENDIF IF (BTIME(NB).EQ.BTIME_LAST) THEN NB = NB-1 GOTO 300 ENDIF BTIME_LAST = BTIME(NB) BLAT(NB) = RLAT BLON(NB) = RLON BWS(NB) = IWS C IF (VER_SAB) THEN CALL EXTRACT_FIXES(LUT,STMID,IMO,IDY,IHR,60.,'DVTS','KSAB', * RLATF,RLONF,WSFIX) BLAT(NB) = BAD BLON(NB) = BAD BWS(NB) = BAD IF (RLATF.NE.BAD) BLAT(NB) = RLATF IF (RLONF.NE.BAD) BLON(NB) = RLONF IF (WSFIX.NE.BAD) BWS(NB) = WSFIX ENDIF C C Non-existent radii are assigned as missing. Alternative C would be to assign them to 0. C -------------------------------------------------------- IF (BWS(NB).LT.64) THEN BRAD(NB,3,1) = BAD BRAD(NB,3,2) = BAD BRAD(NB,3,3) = BAD BRAD(NB,3,4) = BAD ENDIF IF (BWS(NB).LT.50) THEN BRAD(NB,2,1) = BAD BRAD(NB,2,2) = BAD BRAD(NB,2,3) = BAD BRAD(NB,2,4) = BAD ENDIF IF (BWS(NB).LT.34) THEN BRAD(NB,1,1) = BAD BRAD(NB,1,2) = BAD BRAD(NB,1,3) = BAD BRAD(NB,1,4) = BAD ENDIF BST(NB) = STATUS IF (NBF34.EQ.999 .AND. BWS(NB).GE.34.) NBF34=NB IF (NBFET.EQ.999 .AND. BST(NB).EQ.'EX') NBFET=NB GOTO 300 C C C ------------------------------------- C Now begin verification for the storm. C ------------------------------------- 1000 CONTINUE DO 1020 K = 1,NMD DO 1021 L = 1,NVTX NSFT(L) = 0 NSFI(L) = 0 NSFAC(L) = 0 STERRTOT(L,K) = 0. STLATTOT(L,K) = 0. STXERTOT(L,K) = 0. STYERTOT(L,K) = 0. STAERTOT(L,K) = 0. STCERTOT(L,K) = 0. STAERTOTSQ(L,K) = 0. STCERTOTSQ(L,K) = 0. STAERTOTA(L,K) = 0. STCERTOTA(L,K) = 0. SIERRTOT(L,K) = 0. SIERRSSQ(L,K) = 0. SIERRTOTA(L,K) = 0. STNSP(L,K) = 0. SINSP(L,K) = 0. STIND_AT(L,K) = 0. STIND_CT(L,K) = 0. STERRAVG(L,K) = BAD STLATAVG(L,K) = BAD STDIRAVG(L,K) = BAD STMAGAVG(L,K) = BAD STAERAVG(L,K) = BAD STCERAVG(L,K) = BAD STAERSTD(L,K) = BAD STCERSTD(L,K) = BAD STAERAVGA(L,K) = BAD STCERAVGA(L,K) = BAD SIERRAVG(L,K) = BAD SIERRAVGA(L,K) = BAD STFSP(L,K) = BAD SIFSP(L,K) = BAD STIND_AT(L,K) = BAD STIND_CT(L,K) = BAD DO 1022 M = 1,NCATX DO 1023 N = 1,NCATX SICATTOT(L,K,M,N) = 0 1023 CONTINUE 1022 CONTINUE DO 1024 M=1,3 DO 1025 N=1,4 NSFR(L,M,N) = 0 SRERRTOT(L,M,N,K) = 0. SRERRSSQ(L,M,N,K) = 0. SRERRTOTA(L,M,N,K) = 0. SRERRAVG(L,M,N,K) = BAD SRERRAVGA(L,M,N,K) = BAD 1025 CONTINUE 1024 CONTINUE 1021 CONTINUE 1020 CONTINUE C C C Begin looping through best track data. Determine whether this C is a time that we want to verify. C -------------------------------------------------------------- DO 1199 L = 1,NB IF (.NOT.ACPTALLST_IT) THEN IF (BST(L).EQ.'EX' .AND. VER_EXTRAT.NE.'Y') GOTO 1199 IF (BST(L).EQ.'SS' .AND. VER_SUBT.NE.'Y') GOTO 1199 IF (BST(L).EQ.'SD' .AND. VER_SUBT.NE.'Y') GOTO 1199 IF (BST(L).EQ.'LO') GOTO 1199 IF (BST(L).EQ.'DB') GOTO 1199 IF (BST(L).EQ.'PT') GOTO 1199 IF (BST(L).EQ.'WV') GOTO 1199 IF (BST(L).EQ.'XX') GOTO 1199 ENDIF IF (BWS(L).LT.WSMIN .OR.BWS(L).GT.WSMAX) GOTO 1199 IF (VER_TD_INIT .AND. BST(L).NE.'TD') GOTO 1199 IF (VER_NY34 .AND. L.GE.NBF34) GOTO 1199 IF (BLON(L).LT.RLONMIN) GOTO 1199 IF (BLON(L).GT.RLONMAX) GOTO 1199 IF (BLAT(L).LT.RLATMIN) GOTO 1199 IF (BLAT(L).GT.RLATMAX) GOTO 1199 IF (NINT(DATEMIN).NE.0 .AND. NINT(DATEMAX).NE.0) THEN IF (BDATE(L).LT.DATEMIN .OR. BDATE(L).GT.DATEMAX) GOTO 1199 ENDIF IF (NINT(BHR(L)).EQ.0.AND.SYNOPTIC_TIME(1:1).NE.'Y')GOTO 1199 IF (NINT(BHR(L)).EQ.6.AND.SYNOPTIC_TIME(2:2).NE.'Y')GOTO 1199 IF (NINT(BHR(L)).EQ.12.AND.SYNOPTIC_TIME(3:3).NE.'Y')GOTO 1199 IF (NINT(BHR(L)).EQ.18.AND.SYNOPTIC_TIME(4:4).NE.'Y')GOTO 1199 C C C Verify only from a specific list of forecasts? C ---------------------------------------------- IF (VER_LIST.EQ.'I' .OR. VER_LIST.EQ.'E') THEN IN_LIST = .FALSE. REWIND(LUFIL) READ(LUFIL,'(A60)') LIST_LABEL 1030 READ(LUFIL,'(A8,1X,3I2)',END=1034) * STMIDL,IMOL,IDYL,IHRL IF (STMID.EQ.STMIDL .AND. NINT(BMO(L)).EQ.IMOL .AND. * NINT(BDY(L)).EQ.IDYL .AND. NINT(BHR(L)).EQ.IHRL) THEN IN_LIST = .TRUE. GOTO 1034 ENDIF IF (STMID.EQ.STMIDL .AND. IMOL.EQ.99 .AND. * IDYL.EQ.99 .AND. IHRL.EQ.99) THEN IN_LIST = .TRUE. GOTO 1034 ENDIF GOTO 1030 C 1034 IF (IN_LIST .AND. VER_LIST.EQ.'E') GOTO 1199 IF (IN_LIST .AND. VER_LIST.EQ.'I') GOTO 1035 IF (.NOT.IN_LIST .AND. VER_LIST.EQ.'E') GOTO 1035 IF (.NOT.IN_LIST .AND. VER_LIST.EQ.'I') GOTO 1199 ENDIF C C C Only forecasts issued when watches and warnings up? C --------------------------------------------------- 1035 IF (WWARN.NE.'N') CALL WWUS15(LUFIW,STMID,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),TSWATCH,TSWARN,HWATCH,HWARN) IF (WWARN.EQ.'I') THEN IF (.NOT.TSWATCH(1) .AND. .NOT.TSWARN(1) .AND. * .NOT.HWATCH(1) .AND. .NOT.HWARN(1)) GOTO 1199 ENDIF IF (WWARN.EQ.'H') THEN IF (.NOT.HWATCH(1) .AND. .NOT.HWARN(1)) GOTO 1199 ENDIF IF (WWARN.EQ.'J') THEN IF (TSWATCH(1) .or. TSWARN(1) .or. * HWATCH(1) .or. HWARN(1)) GOTO 1199 ENDIF C C C Check for storm size. C ------------------------------------- IF (SIZECHECK.EQ.'L' .OR. SIZECHECK.EQ.'S') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) IF (ROCI.LE.0) THEN WRITE(LUT,'("Time skipped, ROCI not available.")') GOTO 1199 ENDIF IF (SIZECHECK.EQ.'S' .AND. ROCI.GE.STMSIZE) THEN WRITE(LUT,'("Time skipped, storm too large.")') GOTO 1199 ENDIF IF (SIZECHECK.EQ.'L' .AND. ROCI.LT.STMSIZE) THEN WRITE(LUT,'("Time skipped, storm too small.")') GOTO 1199 ENDIF ENDIF C C C ---------------------------------------------------------- C This is a best track time to verify. Initialize all C forecast parameters to missing. C ---------------------------------------------------------- WRITE(LUT,'("Verifying best track time: ",2i2.2,"/",i2.2)') * NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)) DO 1040 K=1,NMD DO 1041 I=1,NVTX FLAT(I,K) = BAD FLON(I,K) = BAD FWND(I,K) = BAD RI_FCST(I) = .FALSE. DO 1042 M=1,3 DO 1043 N=1,4 FRAD(I,M,N,K) = BAD 1043 CONTINUE 1042 CONTINUE 1041 CONTINUE 1040 CONTINUE C C C ---------------------------------------------------------- C Get model forecast. There are four options: C C 1) Run skill benchmarks CLIP/SHFRs: C C BTCLIP Neumann original 3-day CLIPER in best-track C mode. Atlantic basin only. C Specify model as BCLP. C C BTCLIP5 5-day CLIPER/SHIFOR in best-track mode for C either Atlantic or eastern North Pacific. C CLIPER model is Aberson 1998, using 1931-2004 C updated dependent data set. C SHIFOR model is DeMaria and Knaff 2001. C Specify model as BCS5. C C BTCLIPA Sim Aberson's recreation of Neumann original C 3-day CLIPER in best-track mode. C Atlantic basin only. C Specify model as BCLA. C C OCLIP Merrill modified (operational) 3-day CLIPER C run in operational mode. Atlantic basin only. C Specify model as OCLP. C C OCLIP5 5-day CLIPER/SHIFOR in operational mode, C rerun using CARQ data. C CLIPER model is Aberson 1998, using 1931-2004 C updated dependent data set. C SHIFOR model is DeMaria and Knaff 2001. C Specify model as OCS5. C C OCLIPD5 5-day CLIPER/DECAY-SHIFOR in operational mode, C rerun using CARQ data. C CLIPER model is Aberson 1998, using 1931-2004 C updated dependent data set. C SHIFOR model is DeMaria and Knaff 2001. C Specify model as OCD5. C C TRJ_CLP Mark DeMaria's trajectory-CLIPER model (TCLP) C C 2) Form special consensus forecast from existing C models in the A deck. C C 3) Extract a model from the A deck. C ---------------------------------------------------------- C C C Performs the following loop in parallel. C C Note that there is an issue generating CLIP5 forecasts C for more than one model when running in parallel. If C it necessary to generate multiple skill baselines, set C threads = 1 in verify_model.cmd. C ---------------------------------------------------------- !$OMP PARALLEL DO C DO 1050 K=1,NMD C C Compute cliper/shifor forecasts, unless special option C to read them from A-deck has been set. C ------------------------------------------------------- IF (READ_CLSH .OR. ICS_PROC.EQ.3) GOTO 1053 C IF (MODEL(K).EQ.'BCLP') THEN CALL BTCLIP(STMID(1:2),NINT(BMO(L)),NINT(BDY(L)), * NINT(BHR(L)),NB,BMO,BDY,BHR,BLAT,BLON, * BWS,CLAT,CLON,SWND) FLAT(IXTAU(0),K) = BLAT(L) FLON(IXTAU(0),K) = BLON(L) FWND(IXTAU(0),K) = BWS(L) ENDIF C IF (MODEL(K).EQ.'BCLA') THEN CALL BTCLIPA(STMID(1:2),NINT(BMO(L)),NINT(BDY(L)), * NINT(BHR(L)),NB,BMO,BDY,BHR,BLAT,BLON, * BWS,CLAT,CLON,SWND) FLAT(IXTAU(0),K) = BLAT(L) FLON(IXTAU(0),K) = BLON(L) FWND(IXTAU(0),K) = BWS(L) ENDIF C IF (MODEL(K).EQ.'BCS5') THEN CALL BTCLIP5(STMID(1:2),IYEAROUT, * NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * NB,BMO,BDY,BHR,BLAT,BLON,BWS, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = BLAT(L) FLON(IXTAU(0),K) = BLON(L) FWND(IXTAU(0),K) = BWS(L) ENDIF C IF (MODEL(K).EQ.'BCD5') THEN CALL BTCLIPD5(STMID(1:2),IYEAROUT, * NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * NB,BMO,BDY,BHR,BLAT,BLON,BWS, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = BLAT(L) FLON(IXTAU(0),K) = BLON(L) FWND(IXTAU(0),K) = BWS(L) ENDIF C C IF (MODEL(K).EQ.'OCS5') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) CALL OCLIP5(STMID(1:2),IYEAROUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)), * RLAT0 ,RLON0 ,WS0 ,DIR0 ,SPD0 , * RLAT12,RLON12,WS12,DIR12,SPD12, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = RLAT0 FLON(IXTAU(0),K) = RLON0 FWND(IXTAU(0),K) = WS0 ENDIF C IF (MODEL(K).EQ.'OCD5') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) CALL OCLIPD5(STMID(1:2),IYEAROUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)), * RLAT0 ,RLON0 ,WS0 ,DIR0 ,SPD0 , * RLAT12,RLON12,WS12,DIR12,SPD12, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = RLAT0 FLON(IXTAU(0),K) = RLON0 FWND(IXTAU(0),K) = WS0 ENDIF C IF (MODEL(K).EQ.'OCDT') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) CALL OCLIPD5_TEST(STMID(1:2),IYEAROUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)), * RLAT0 ,RLON0 ,WS0 ,DIR0 ,SPD0 , * RLAT12,RLON12,WS12,DIR12,SPD12, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = RLAT0 FLON(IXTAU(0),K) = RLON0 FWND(IXTAU(0),K) = WS0 ENDIF C IF (MODEL(K).EQ.'OCLP') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) CALL OCLIP(STMID(1:2),IYEAROUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)), * RLAT0 ,RLON0 ,WS0 ,DIR0 ,SPD0 , * RLAT12,RLON12,WS12,DIR12,SPD12, * CLAT,CLON,SWND) FLAT(IXTAU(0),K) = RLAT0 FLON(IXTAU(0),K) = RLON0 FWND(IXTAU(0),K) = WS0 ENDIF C IF (MODEL(K).EQ.'TCLP') THEN CALL GET_CARQ(NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)), * RLAT0,RLON0,WS0,DIR0,SPD0, * RLAT12,RLON12,WS12,DIR12,SPD12, * POCI,ROCI,RMW) CALL TRJ_CLP(IYEAROUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)), * RLAT0 ,RLON0 ,WS0 ,DIR0 ,SPD0 , * RLAT12,RLON12,WS12,TCLAT,TCLON,TCWND) FLAT(IXTAU(0),K) = RLAT0 FLON(IXTAU(0),K) = RLON0 FWND(IXTAU(0),K) = WS0 ENDIF C C C Round to the nearest tenth of a degree and C nearest whole knot and place CLP/SHF forecasts C into proper array slots. C ------------------------------------------------ IF (MODEL(K).EQ.'BCLP' .OR. MODEL(K).EQ.'BCS5' .OR. * MODEL(K).EQ.'OCLP' .OR. MODEL(K).EQ.'OCS5' .OR. * MODEL(K).EQ.'BCLA' .OR. MODEL(K).EQ.'OCD5' .OR. * MODEL(K).EQ.'BCD5' .OR. MODEL(K).EQ.'OCDT' .OR. * MODEL(K).EQ.'TCLP') THEN C C C NVTX dependency here C -------------------- IF (MODEL(K).EQ.'TCLP') THEN DO 1057 I =2,NVTX FLAT(I,K) = FLOAT(NINT(TCLAT(I)*10.0))/10. FLON(I,K) = FLOAT(NINT(TCLON(I)*10.0))/10. FWND(I,K) = FLOAT(NINT(TCWND(I))) 1057 CONTINUE ELSE C C NVTX dependency here, since CLIPER only has C forecasts for specific verification times. C ------------------------------------------- FLAT(IXTAU(12),K) = FLOAT(NINT(CLAT(1)*10.0))/10. FLON(IXTAU(12),K) = FLOAT(NINT(CLON(1)*10.0))/10. FWND(IXTAU(12),K) = FLOAT(NINT(SWND(1))) FLAT(IXTAU(24),K) = FLOAT(NINT(CLAT(2)*10.0))/10. FLON(IXTAU(24),K) = FLOAT(NINT(CLON(2)*10.0))/10. FWND(IXTAU(24),K) = FLOAT(NINT(SWND(2))) FLAT(IXTAU(36),K) = FLOAT(NINT(CLAT(3)*10.0))/10. FLON(IXTAU(36),K) = FLOAT(NINT(CLON(3)*10.0))/10. FWND(IXTAU(36),K) = FLOAT(NINT(SWND(3))) FLAT(IXTAU(48),K) = FLOAT(NINT(CLAT(4)*10.0))/10. FLON(IXTAU(48),K) = FLOAT(NINT(CLON(4)*10.0))/10. FWND(IXTAU(48),K) = FLOAT(NINT(SWND(4))) FLAT(IXTAU(60),K) = FLOAT(NINT(CLAT(5)*10.0))/10. FLON(IXTAU(60),K) = FLOAT(NINT(CLON(5)*10.0))/10. FWND(IXTAU(60),K) = FLOAT(NINT(SWND(5))) FLAT(IXTAU(72),K) = FLOAT(NINT(CLAT(6)*10.0))/10. FLON(IXTAU(72),K) = FLOAT(NINT(CLON(6)*10.0))/10. FWND(IXTAU(72),K) = FLOAT(NINT(SWND(6))) FLAT(IXTAU(84),K) = FLOAT(NINT(CLAT(7)*10.0))/10. FLON(IXTAU(84),K) = FLOAT(NINT(CLON(7)*10.0))/10. FWND(IXTAU(84),K) = FLOAT(NINT(SWND(7))) FLAT(IXTAU(96),K) = FLOAT(NINT(CLAT(8)*10.0))/10. FLON(IXTAU(96),K) = FLOAT(NINT(CLON(8)*10.0))/10. FWND(IXTAU(96),K) = FLOAT(NINT(SWND(8))) FLAT(IXTAU(108),K) = FLOAT(NINT(CLAT(9)*10.0))/10. FLON(IXTAU(108),K) = FLOAT(NINT(CLON(9)*10.0))/10. FWND(IXTAU(108),K) = FLOAT(NINT(SWND(9))) FLAT(IXTAU(120),K) = FLOAT(NINT(CLAT(10)*10.0))/10. FLON(IXTAU(120),K) = FLOAT(NINT(CLON(10)*10.0))/10. FWND(IXTAU(120),K) = FLOAT(NINT(SWND(10))) ENDIF C C Throw out tau=0 data if forecast failed to run. C ----------------------------------------------- FCSTR(K) = 'XXX' IF (FLAT(2,K).EQ.BAD) THEN FLAT(1,K) = BAD FLON(1,K) = BAD ENDIF IF (FWND(2,K).EQ.BAD) THEN FWND(1,K) = BAD ENDIF C C C Write out certain cliper-shifor forecasts to special file C --------------------------------------------------------- MODEL_CL = .FALSE. IF (MODEL(K).EQ.'BCD5' .OR. MODEL(K).EQ.'OCD5' .OR. * MODEL(K).EQ.'BCS5' .OR. MODEL(K).EQ.'OCS5') * MODEL_CL = .TRUE. IF (WRITE_CLSH .AND. MODEL_CL) THEN C C Only certain times get written out. Last is 120 h. C --------------------------------------------------- DO 1052 LL = 1,IXTAU(120) LASIGN = 'S' IF (FLAT(LL,K).GE.0.) LASIGN = 'N' CLPLON = FLON(LL,K) LOSIGN = 'W' IF (CLPLON.LT.-180.) THEN LOSIGN = 'E' CLPLON = CLPLON + 360. C * WRITE(LUFO2,'("CLIPER FCST W OF 180: ", C * a8,1x,3i2.2)') STMID, C * NINT(BMO(L)),NINT(BDY(L)),NINT(BHR(L)) ENDIF IF (FLAT(LL,K).NE.BAD .AND. FLON(LL,K).NE.BAD * .AND. FWND(LL,K).NE.BAD) * WRITE(LUFOC,1099) STMID(1:2),CMSP,STMID(3:4), * CMSP,NINT(BYEAR(L)),NINT(BMO(L)),NINT(BDY(L)), * NINT(BHR(L)),CMSP,'03',CMSP,MODEL(K),CMSP, * ITIME(LL),CMSP, * NINT(10.*ABS(FLAT(LL,K))),LASIGN,CMSP, * NINT(10.*ABS(CLPLON)),LOSIGN,CMSP, * NINT(FWND(LL,K)),CLIPSTRING 1052 CONTINUE ENDIF 1099 FORMAT(4A2,I4.4,3I2.2,3A2,A4,A2,I3,A2,I3, * A1,A2,I4,A1,A2,I3,A46) C GOTO 1050 ENDIF C C C Generate special user-defined consensus forecasts C These are fixed (all members must be present). C ------------------------------------------------- 1053 IF (MODEL(K).EQ.'CONX') THEN CALL CONSENSUS(NMCX,MODELCX,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONY') THEN CALL CONSENSUS(NMCY,MODELCY,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF C C C Generate variable consensus forecasts. C This version's members are read from a configuration file. C ---------------------------------------------------------- IF (MODEL(K).EQ.'CONA') THEN CALL CONSENSUS_VAR(NMTA,MODELTA,NMIA,MODELIA, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONB') THEN CALL CONSENSUS_VAR(NMTB,MODELTB,NMIB,MODELIB, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONC') THEN CALL CONSENSUS_VAR(NMTC,MODELTC,NMIC,MODELIC, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'COND') THEN CALL CONSENSUS_VAR(NMTD,MODELTD,NMID,MODELID, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONE') THEN CALL CONSENSUS_VAR(NMTE,MODELTE,NMIE,MODELIE, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONF') THEN CALL CONSENSUS_VAR(NMTF,MODELTF,NMIF,MODELIF, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONG') THEN CALL CONSENSUS_VAR(NMTG,MODELTG,NMIG,MODELIG, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONH') THEN CALL CONSENSUS_VAR(NMTH,MODELTH,NMIH,MODELIH, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONI') THEN CALL CONSENSUS_VAR(NMTI,MODELTI,NMII,MODELII, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF IF (MODEL(K).EQ.'CONJ') THEN CALL CONSENSUS_VAR(NMTJ,MODELTJ,NMIJ,MODELIJ, * NMMIN,BAD,LUFIA,LUT,NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FCSTR(K),RI_FCST,DELW_RI,DELT_RI, * VER_RIF) GOTO 1054 ENDIF C C C Get model forecast from A deck C ------------------------------ CALL GET_MODEL_FCSTC7(LUFIA,LUT,MODEL(K),NINT(BMO(L)), * NINT(BDY(L)),NINT(BHR(L)),FLAT(1,K),FLON(1,K), * FWND(1,K),FRAD(1,1,1,K),FCSTR(K),MLAG(K)) C C C C ---------------------------------------------- C Now we have the model forecast to be verified. C Here we make a few modifications to the model, C if necessary. C ---------------------------------------------- C C ------------------------------------------------ C Are we verifying post-dissipation stage? If so, C assign WSDIS kt to forecasts of dissipation. C Temporarily assign WSDIS+0.5 so we know this was C an assigned value and not an original fcst. C ------------------------------------------------ 1054 IF (VER_NONBT.EQ.'Y') THEN NVTD = NVTX C C Don't do this beyond 120 h for 2001 onward. C Don't do this beyond 72 h prior to 2001. C ------------------------------------------- NVTD = IXTAU(120) IF (IYEAROUT.LT.2001) NVTD = IXTAU(72) DO 1055 I=2,NVTD IF ((OFCL_INC .AND. OFCL_SUP).AND..NOT.OFCLT(I)) * GOTO 1055 IF (FWND(I,K).EQ.BAD .AND. FWND(1,K).NE.BAD) THEN FWND(I,K) = WSDIS+0.5 ENDIF 1055 CONTINUE ENDIF C C C ------------------------------------------------------ C Check for invalid official forecasts: C C No 00 hour verification data prior to 1970 (CARQ taken C from Best Track data base?). C ------------------------------------------------------ IF (IYEAROUT.LT.1970.AND.MODEL(K).EQ.'OFCL') THEN FLAT(IXTAU(0),K) = BAD FLON(IXTAU(0),K) = BAD FWND(IXTAU(0),K) = BAD ENDIF C C No 12 hour verification data prior to 1967 (unknown C reason, although 1967 was when official verification C time was shifted to synoptic time.) C ------------------------------------------------------ IF (IYEAROUT.LT.1967.AND.MODEL(K).EQ.'OFCL') THEN FLAT(IXTAU(12),K) = BAD FLON(IXTAU(12),K) = BAD FWND(IXTAU(12),K) = BAD ENDIF C C No 36 hour forecasts issued prior to 1988. C ------------------------------------------ IF (IYEAROUT.LT.1988.AND.MODEL(K).EQ.'OFCL') THEN FLAT(IXTAU(36),K) = BAD FLON(IXTAU(36),K) = BAD FWND(IXTAU(36),K) = BAD ENDIF C C No radii at all issued beyond 72 h. C No 64-kt radii issued beyond 48 h. C ----------------------------------- IF (IYEAROUT.LT.9999.AND.MODEL(K).EQ.'OFCL') THEN DO 1090 I=1,3 DO 1091 II=1,4 DO 1092 III=IXTAU(48)+1,NVTX IF (III.LE.IXTAU(72).AND.I.LT.3) GOTO 1092 FRAD(III,I,II,K) = BAD 1092 CONTINUE 1091 CONTINUE 1090 CONTINUE ENDIF C C No 72-hr 34 kt radii prior to 2001. C ----------------------------------- IF (IYEAROUT.LT.2001 .AND. MODEL(K).EQ.'OFCL') THEN DO 1093 II=1,4 FRAD(IXTAU(72),1,II,K) = BAD 1093 CONTINUE ENDIF C C No 72-hr 50-kt radii prior to 1995. C No 64-kt radii prior to 1995. C ----------------------------------- IF (IYEAROUT.LT.1995 .AND. MODEL(K).EQ.'OFCL') THEN DO 1094 II=1,4 FRAD(IXTAU(72),2,II,K) = BAD FRAD(IXTAU(12),3,II,K) = BAD FRAD(IXTAU(24),3,II,K) = BAD FRAD(IXTAU(36),3,II,K) = BAD FRAD(IXTAU(48),3,II,K) = BAD FRAD(IXTAU(72),3,II,K) = BAD 1094 CONTINUE ENDIF C C No 36-h 34- and 50-kt radii prior to 1988. C ------------------------------------------ IF (IYEAROUT.LT.1988 .AND. MODEL(K).EQ.'OFCL') THEN DO 1095 II=1,4 FRAD(IXTAU(36),1,II,K) = BAD FRAD(IXTAU(36),2,II,K) = BAD 1095 CONTINUE ENDIF C C No 48-h 64-kt radii prior to 2018. C ---------------------------------- IF (IYEAROUT.LT.2018 .AND. MODEL(K).EQ.'OFCL') THEN DO 1096 II=1,4 FRAD(IXTAU(48),3,II,K) = BAD 1096 CONTINUE ENDIF C C C Check for forecasts encountering land. C Routine will toss all forecast data after C the forecast track moves inland. C ------------------------------------- IF (WATER_ONLY) CALL LANDCHECK(LUT,BAD,MODEL(K),FLAT(1,K), * FLON(1,K),FWND(1,K),FRAD(1,1,1,K)) C C C Check for forecasts near land. C Routine will toss only forecast points within C DIST_LAND nmi of land. C ------------------------------------- IF (FCSTNEARLAND.EQ.'F' .OR. FCSTNEARLAND.EQ.'N') * CALL LANDCHECK_CLOSE(LUT,BAD,MODEL(K), * FLAT(1,K),FLON(1,K),FWND(1,K),FRAD(1,1,1,K), * FCSTNEARLAND,DIST_LAND) C C C Check for forecaster. Toss forecast if not requested C ----------------------------------------------------- IF ((MODEL(K).EQ.'OFCL' .OR. MODEL(K).EQ.'OFCO') * .AND. FCSTRV.NE.'ALL' .AND. FCSTR(K).NE.FCSTRV) THEN CALL TOSS_FCST(LUT,BAD,MODEL(K), * FLAT(1,K),FLON(1,K),FWND(1,K),FRAD(1,1,1,K)) ENDIF C 1050 CONTINUE C C Turns off parallel processing C ----------------------------- !$OMP END PARALLEL DO C C C ----------------------------------------------------- C All modifications to the model forecast are complete. C Begin the verification. C ----------------------------------------------------- C C Fill BT arrays for input to along and cross-track C error routine. Check if crossed the Date Line. C ------------------------------------------------- DO 1056 I=1,NACPTS ACBTLAT(I) = BAD ACBTLON(I) = BAD II = L-1+I IF (II.LE.NB) THEN ACBTLAT(I) = BLAT(II) ACBTLON(I) = BLON(II) IF (ACBTLON(I).GT.90.) ACBTLON(I) = ACBTLON(I)-360. ENDIF 1056 CONTINUE C C C Cycle through the verification times. C ------------------------------------- DO 1060 I = 1,NVTX FRACN(I) = 0. DO 1065 K = 1,NMD ERRT(I,K) = BADD ERRI(I,K) = BADD ERRIABS(I,K) = BADD FOR_INT(I,K) = BADD VER_INT(I,K) = BADD XERR(I,K) = BADD YERR(I,K) = BADD AERR(I,K) = BADD CERR(I,K) = BADD DO 1064 M=1,3 DO 1066 N=1,4 FOR_RAD(I,M,N,K) = BADD VER_RAD(I,M,N,K) = BADD ERRR(I,M,N,K) = BADD 1066 CONTINUE 1064 CONTINUE 1065 CONTINUE C C Determine whether verification time qualifies. C ---------------------------------------------- VTIME = BTIME(L)+ITIME(I) DO 1080 J = 1,NB IF (VTIME.EQ.BTIME(J)) THEN VST = BST(J) VLAT = BLAT(J) VLON = BLON(J) VWS = BWS(J) VMO = BMO(J) VDY = BDY(J) VHR = BHR(J) C C Special check for bogus b-deck disturbance entries C -------------------------------------------------- IF (NINT(VWS).EQ.2) THEN VLAT = BAD VLON = BAD VWS = BAD ENDIF C C Get wind speed DELT_RI h ago, if available. C Assumes BT points are 6 h apart. C -------------------------------------- VWS_PREV = BAD DEL_WIND = BAD J_PREV = J - NINT(DELT_RI/6.) IF (J_PREV.GE.1) VWS_PREV = BWS(J_PREV) IF (VWS.NE.BAD .AND. VWS_PREV.NE.BAD) * DEL_WIND = VWS-VWS_PREV C DO 1084 M=1,3 DO 1081 N=1,4 VRAD(M,N) = BRAD(J,M,N) 1081 CONTINUE 1084 CONTINUE GOTO 1100 ENDIF 1080 CONTINUE C C Did not find best track time that matches. C Verify non-existent systems "intensities"? C ------------------------------------------ IF (VER_NONBT.EQ.'Y') THEN VLAT = BAD VLON = BAD VWS = WSDIS+0.5 VST = 'XX' DO 1083 M=1,3 DO 1082 N=1,4 VRAD(M,N) = BAD 1082 CONTINUE 1083 CONTINUE GOTO 1100 ENDIF C GOTO 1060 C C Did find matching best track data. Do we want it? C -------------------------------------------------- 1100 CONTINUE IF (WATER_ONLY) CALL LANDCHECK_BT(BTIME,BLAT,BLON, * L,LUT,BAD,VTIME,VLAT,VLON,VWS,VRAD) IF (WATER_ONLY .AND. NWINDOW.GT.0) * CALL LANDCHECK_WINDOW(BTIME,BLAT,BLON, * L,LUT,BAD,NWINDOW,VTIME,VLAT,VLON,VWS,VRAD) C IF (.NOT.ACPTALLST_VT) THEN IF (VST.EQ.'EX' .AND. VER_EXTRAT.NE.'Y') GOTO 1060 IF (VST.EQ.'SS' .AND. VER_SUBT.NE.'Y') GOTO 1060 IF (VST.EQ.'SD' .AND. VER_SUBT.NE.'Y') GOTO 1060 IF (VST.EQ.'LO' .OR. VST.EQ.'WV' .OR. VST.EQ.'XX' * .OR. VST.EQ.'DB' .OR. VST.EQ.'PT') THEN IF (VER_NONBT.NE.'Y') GOTO 1060 IF (NBFET.LT.999.AND.VTIME.GE.BTIME(NBFET)) GOTO 1060 ENDIF ENDIF C IF (WS_CRIT_VT.AND.(VWS.LT.WSMIN .OR. VWS.GT.WSMAX)) * GOTO 1060 IF (VER_RI .AND. DEL_WIND.EQ.BAD) GOTO 1060 IF (VER_RI .AND. DELW_RI.GE.0 * .AND. DEL_WIND.LT.DELW_RI) GOTO 1060 IF (VER_RIF .AND. DELW_RI.GE.0 * .AND. DEL_WIND.GE.DELW_RI) THEN RI_BEST = .TRUE. WRITE(LUT,'("RI found in BTRK at ",i3.3, * " h, DELW = ", I3," kt")') ITIME(I),NINT(DEL_WIND) ELSE RI_BEST = .FALSE. ENDIF IF (VER_RW .AND. DELW_RI.LT.0 * .AND. DEL_WIND.GT.DELW_RI) GOTO 1060 IF (WWARN.EQ.'V') THEN IF (.NOT.TSWATCH(I) .AND. .NOT.TSWARN(I) .AND. * .NOT.HWATCH(I) .AND. .NOT.HWARN(I)) GOTO 1060 ENDIF IF (WWARN.EQ.'W') THEN IF (TSWATCH(I) .or. TSWARN(I) .or. * HWATCH(I) .or. HWARN(I)) GOTO 1060 ENDIF C C Check if verification time is on the desired list C ------------------------------------------------- IF (VER_LIST.EQ.'I' .AND. VT_LIST) THEN REWIND(LUFIL) 1070 READ(LUFIL,'(A8,1X,3I2)',END=1074) * STMIDL,IMOL,IDYL,IHRL IF (STMID.EQ.STMIDL .AND. NINT(VMO).EQ.IMOL .AND. * NINT(VDY).EQ.IDYL .AND. NINT(VHR).EQ.IHRL) GOTO 1075 IF (STMID.EQ.STMIDL .AND. IMOL.EQ.99 .AND. * IDYL.EQ.99 .AND. IHRL.EQ.99) GOTO 1075 GOTO 1070 1074 GOTO 1060 ENDIF C 1075 CONTINUE C C C Now perform a series of checks on the forecast data to C see if this verification time belongs in the sample: C C First check to see if RI had occurred in any model C forecast or the best track. If neither, skip VT. C ------------------------------------------------------- IF (VER_RIF) THEN DO 1105 K=1,NMD FWS = FWND(I,K) CALL GETPREVFWS(FWND(1,K),I,NINT(DELT_RI),FWSPRV) IF (FWS.NE.BAD .AND. FWSPRV.NE.BAD) THEN DELTA_FWS = FWS-FWSPRV IF (DELTA_FWS.GE.DELW_RI .AND. DELW_RI.GT.0) THEN RI_FCST(I) = .TRUE. WRITE(LUT,'("RI found in ",a4," at ",i3.3, * " h, DELW = ", I3," kt")') MODEL(K), * ITIME(I),NINT(DELTA_FWS) ENDIF ENDIF 1105 CONTINUE IF (.NOT.RI_BEST .AND. .NOT.RI_FCST(I)) GOTO 1060 ENDIF C C C C Check the forecast position. If we are selecting from C a box, and the forecast position is not in the desired C area, then skip this VT. C C Then check to make sure we have a homogeneous C sample for position. If not, go on to the intensity C verification. C ------------------------------------------------------ DO 1110 K=1,NMD IF (VERIFY_BOX) THEN IF (FLON(I,K).LT.FLONMIN) GOTO 1060 IF (FLON(I,K).GT.FLONMAX) GOTO 1060 IF (FLAT(I,K).LT.FLATMIN) GOTO 1060 IF (FLAT(I,K).GT.FLATMAX) GOTO 1060 ENDIF C IF (FLAT(I,K).EQ.BAD .OR. FLAT(I,K).GT.90 .OR. * FLON(I,K).EQ.BAD) GOTO 1150 1110 CONTINUE C C C We have a homogeneous comparison for position. The C FDIFF_ONLY option includes just cases where there are C differences among the models being verified. If no C differences in forecast positions among the models C are found, skip forward to the intensity verification. C Note that a separate check will be done below for C differences in forecast intensity. C ------------------------------------------------------ IF (FDIFF_ONLY .AND. NMD.GT.1) THEN PDIFF = .FALSE. DO 1106 K=2,NMD IF (FLAT(I,K).NE.FLAT(I,K-1)) PDIFF = .TRUE. IF (FLON(I,K).NE.FLON(I,K-1)) PDIFF = .TRUE. 1106 CONTINUE IF (.NOT.PDIFF) GOTO 1150 ENDIF C C C OK, VT qualifies, compute position errors. C ------------------------------------------ IF (VLAT.NE.BAD .AND. VLON.NE.BAD .AND. * VLAT.LE.90.) THEN ERRTMIN = 99999. NTSP = 1 DO 1120 K=1,NMD C C Fill model array for input to along/cross track C error routine (raw output is km). C Also need to check to see if we crossed the C Date Line. C ----------------------------------------------- DO 1121 M=1,NACPTS IF (IXACE(M).GT.0) THEN ACFCLAT(M) = FLAT(IXACE(M),K) ACFCLON(M) = FLON(IXACE(M),K) IF (ACFCLON(M).GT.90.) * ACFCLON(M) = ACFCLON(M)-360. ELSE ACFCLAT(M) = BAD ACFCLON(M) = BAD ENDIF 1121 CONTINUE CALL ACERR(ACBTLAT,ACBTLON,ACFCLAT,ACFCLON,NACPTS, * CROSSE,ALONGE,IERRAC) AERR(I,K) = ALONGE(IXACEI(I)) CERR(I,K) = CROSSE(IXACEI(I)) IF (IERRAC.NE.0.OR.AERR(I,K).EQ.BADD * .OR.CERR(I,K).EQ.BADD) THEN AERR(I,K) = BADD CERR(I,K) = BADD ELSE AERR(I,K) = AERR(I,K)*.53996 CERR(I,K) = CERR(I,K)*.53996 STAERTOT(I,K) = STAERTOT(I,K)+AERR(I,K) STCERTOT(I,K) = STCERTOT(I,K)+CERR(I,K) STAERTOTSQ(I,K) = STAERTOTSQ(I,K)+AERR(I,K)**2. STCERTOTSQ(I,K) = STCERTOTSQ(I,K)+CERR(I,K)**2. STAERTOTA(I,K) = STAERTOTA(I,K)+ABS(AERR(I,K)) STCERTOTA(I,K) = STCERTOTA(I,K)+ABS(CERR(I,K)) IF (K.EQ.1) NSFAC(I) = NSFAC(I)+1 C C Store along and cross errors for independence calculation C --------------------------------------------------------- STM_ACE(NSFAC(I),I,K) = AERR(I,K) STM_CCE(NSFAC(I),I,K) = CERR(I,K) ENDIF C AVGLAT = 0.5*(FLAT(I,K)+VLAT) CAVGL = COS(AVGLAT*3.14159/180.0) DIFFLON = FLON(I,K)-VLON DIFFLAT = FLAT(I,K)-VLAT IF (DIFFLON.LT.-180.) DIFFLON=DIFFLON+360. IF (DIFFLON.GT. 180.) DIFFLON=DIFFLON-360. XERR(I,K) = 60.0*DIFFLON*CAVGL YERR(I,K) = 60.0*DIFFLAT ERRT(I,K) = * SQRT(XERR(I,K)*XERR(I,K)+YERR(I,K)*YERR(I,K)) IF (K.EQ.1) NSFT(I) = NSFT(I)+1 STERRTOT(I,K) = STERRTOT(I,K)+ERRT(I,K) STXERTOT(I,K) = STXERTOT(I,K)+XERR(I,K) STYERTOT(I,K) = STYERTOT(I,K)+YERR(I,K) STLATTOT(I,K) = STLATTOT(I,K)+VLAT IF (ERRT(I,K).EQ.ERRTMIN) NTSP = NTSP+1 IF (ERRT(I,K).LT.ERRTMIN) THEN ERRTMIN=ERRT(I,K) NTSP = 1 ENDIF 1120 CONTINUE C C C Count up number of superior performances C ---------------------------------------- DO 1125 K=1,NMD IF (ERRT(I,K).LE.ERRTMIN) * STNSP(I,K)=STNSP(I,K)+1./FLOAT(NTSP) 1125 CONTINUE C C C Calculate time betw/fcsts. This check can be done on C either the track or intensity forecasts depending on C the value of FRACN_TRK. Output goes to spreadsheet. C ------------------------------------------------------- IF (FRACN_TRK) THEN IYR2(I) = NINT(BYEAR(L)) IMO2(I) = NINT(BMO(L)) IDY2(I) = NINT(BDY(L)) HR2(I) = BHR(L) CALL DIFTIME(IYR1(I),IMO1(I),IDY1(I),HR1(I), * IYR2(I),IMO2(I),IDY2(I),HR2(I),DELTAH) IYR1(I) = IYR2(I) IMO1(I) = IMO2(I) IDY1(I) = IDY2(I) HR1(I) = HR2(I) IF (ABS(DELTAH).GE.18.) THEN FRACN(I) = 1.0 ELSE FRACN(I) = ABS(DELTAH)/18. ENDIF ENDIF C ENDIF C C C Do we have a homogeneous sample for winds? C If both fcst and ver intensities were C set to WSDIS+0.5 kt, only verify first occurrence. C -------------------------------------------------- 1150 DO 1152 K=1,NMD IF (FWND(I,K).EQ.BAD) GOTO 1160 IF (FWND(I,K).EQ.WSDIS+0.5 .AND. VWS.EQ.WSDIS+0.5) THEN FWND(I,K) = BAD GOTO 1160 ENDIF 1152 CONTINUE C C C We have a homogeneous comparison for winds. The C FDIFF_ONLY option includes just cases where there are C differences among the models being verified. If no C differences in forecast intensities among the models C are found, skip forward to the radii verification. C Note that a separate check will be done below for C differences in forecast intensity. C ------------------------------------------------------ IF (FDIFF_ONLY .AND. NMD.GT.1) THEN WDIFF = .FALSE. DO 1153 K=2,NMD IF (FWND(I,K).NE.FWND(I,K-1)) WDIFF = .TRUE. 1153 CONTINUE IF (.NOT.WDIFF) GOTO 1160 ENDIF C C IF (VWS.NE.BAD) THEN ERRIMIN = 99999. NISP = 1 DO 1154 K=1,NMD FWS = FWND(I,K) CALL GETPREVFWS(FWND(1,K),I,NINT(DELT_RI),FWSPRV) IF (FWS.NE.BAD .AND. FWSPRV.NE.BAD) THEN DELTA_FWS = FWS-FWSPRV IF (DELTA_FWS.GE.DELW_RI .AND. DELW_RI.GT.0) * NFRI(I,K) = NFRI(I,K)+1 ENDIF CALL INT_CAT(FWS,IFC,WSDIS,'FC',NCATX) CALL INT_CAT(VWS,IVC,WSDIS,VST,NCATX) IF (FWS.EQ.WSDIS+0.5) FWS = WSDIS IF (VWS.EQ.WSDIS+0.5) VWS = WSDIS ERRI(I,K) = FWS - VWS FOR_INT(I,K) = FWS VER_INT(I,K) = VWS ERRIABS(I,K) = ABS(ERRI(I,K)) IF (K.EQ.1) NSFI(I) = NSFI(I)+1 SIERRTOT(I,K) = SIERRTOT(I,K)+ERRI(I,K) SIERRSSQ(I,K) = SIERRSSQ(I,K)+ERRI(I,K)**2.0 SIERRTOTA(I,K) = SIERRTOTA(I,K)+ERRIABS(I,K) SICATTOT(I,K,IFC,IVC) = SICATTOT(I,K,IFC,IVC)+1 IF (ERRIABS(I,K).EQ.ERRIMIN) NISP = NISP+1 IF (ERRIABS(I,K).LT.ERRIMIN) THEN ERRIMIN=ERRIABS(I,K) NISP = 1 ENDIF 1154 CONTINUE C C Count up number of superior performances C ---------------------------------------- DO 1156 K=1,NMD IF (ERRIABS(I,K).LE.ERRIMIN) * SINSP(I,K)=SINSP(I,K)+1./FLOAT(NISP) 1156 CONTINUE C C C Calculate time betw/fcsts. This check can be done on C either the track or intensity forecasts depending on C the value of FRACN_TRK. Output goes to spreadsheet. C ------------------------------------------------------- IF (.NOT. FRACN_TRK) THEN IYR2(I) = NINT(BYEAR(L)) IMO2(I) = NINT(BMO(L)) IDY2(I) = NINT(BDY(L)) HR2(I) = BHR(L) CALL DIFTIME(IYR1(I),IMO1(I),IDY1(I),HR1(I), * IYR2(I),IMO2(I),IDY2(I),HR2(I),DELTAH) IYR1(I) = IYR2(I) IMO1(I) = IMO2(I) IDY1(I) = IDY2(I) HR1(I) = HR2(I) IF (ABS(DELTAH).GE.18.) THEN FRACN(I) = 1.0 ELSE FRACN(I) = ABS(DELTAH)/18. ENDIF ENDIF C ENDIF C C C Radii verification begins here. C -------------------------------- 1160 IF (.NOT.VER_RADII) GOTO 1060 DO 1171 M=1,3 DO 1170 N=1,4 IF (VRAD(M,N).EQ.BAD) GOTO 1170 C C Do we have homogeneous comparison? C ---------------------------------- DO 1162 K=1,NMD IF (FRAD(I,M,N,K).EQ.BAD) GOTO 1170 1162 CONTINUE DO 1164 K=1,NMD ERRR(I,M,N,K) = FRAD(I,M,N,K) - VRAD(M,N) FOR_RAD(I,M,N,K) = FRAD(I,M,N,K) VER_RAD(I,M,N,K) = VRAD(M,N) ERRRABS(I,M,N,K) = ABS(ERRR(I,M,N,K)) IF (K.EQ.1) NSFR(I,M,N) = NSFR(I,M,N)+1 SRERRTOT(I,M,N,K) = * SRERRTOT(I,M,N,K)+ERRR(I,M,N,K) SRERRSSQ(I,M,N,K) = * SRERRSSQ(I,M,N,K)+ERRR(I,M,N,K)**2.0 SRERRTOTA(I,M,N,K) = * SRERRTOTA(I,M,N,K)+ERRRABS(I,M,N,K) 1164 CONTINUE C 1170 CONTINUE 1171 CONTINUE C C C Go on to next verification time C ------------------------------- 1060 CONTINUE C C C Write out results for this BT time to storm log file C and spreadsheet file. C ---------------------------------------------------- DO 1180 K=1,NMD IF (K.EQ.1) THEN C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,8190) NINT(BYEAR(L)),NINT(BMO(L)),NINT(BDY(L)), * NINT(BHR(L)),BLAT(L),-BLON(L),NINT(BWS(L)),MODELO(K), * (NINT(ERRT(IXTAU(ITIMO(I)),K)),I=1,NVTO), * (NINT(ERRI(IXTAU(ITIMO(I)),K)),I=1,NVTO) 8190 FORMAT(I4.4,3I2.2,F5.1,F6.1,I4,2X,A4,1X,11I8,4x,11I8) ELSE WRITE(LUFO1,1190) NINT(BYEAR(L)),NINT(BMO(L)),NINT(BDY(L)), * NINT(BHR(L)),BLAT(L),-BLON(L),NINT(BWS(L)),MODELO(K), * (NINT(ERRT(I,K)),I=1,NVTX),(NINT(ERRI(I,K)),I=1,NVTX) 1190 FORMAT(I4.4,3I2.2,F5.1,F6.1,I4,2X,A4,1X,15I8,4x,15I8) ENDIF ELSE IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,8191) MODELO(K), * (NINT(ERRT(IXTAU(ITIMO(I)),K)),I=1,NVTO), * (NINT(ERRI(IXTAU(ITIMO(I)),K)),I=1,NVTO) 8191 FORMAT(27X,A4,1X,11I8,4x,11I8) ELSE WRITE(LUFO1,1191) MODELO(K), * (NINT(ERRT(I,K)),I=1,NVTX),(NINT(ERRI(I,K)),I=1,NVTX) 1191 FORMAT(27X,A4,1X,15I8,4x,15I8) ENDIF ENDIF 1180 CONTINUE C IF (TIERR_SPRD) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(IXTAU(ITIMO(I))),I=2,NVTO), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((ERRT(IXTAU(ITIMO(I)),K),I=1,NVTO), * (ERRI(IXTAU(ITIMO(I)),K),I=1,NVTO),K=1,NMD) ELSE WRITE(LUFOS,1192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(I),I=2,NVTX), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((ERRT(I,K),I=1,NVTX),(ERRI(I,K),I=1,NVTX),K=1,NMD) ENDIF ENDIF C IF (ACERR_SPRD) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(IXTAU(ITIMO(I))),I=2,NVTO), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((AERR(IXTAU(ITIMO(I)),K),I=1,NVTO), * (CERR(IXTAU(ITIMO(I)),K),I=1,NVTO),K=1,NMD) ELSE WRITE(LUFOS,1192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(I),I=2,NVTX), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((AERR(I,K),I=1,NVTX),(CERR(I,K),I=1,NVTX),K=1,NMD) ENDIF ENDIF C IF (XYERR_SPRD) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(IXTAU(ITIMO(I))),I=2,NVTO), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((XERR(IXTAU(ITIMO(I)),K),I=1,NVTO), * (YERR(IXTAU(ITIMO(I)),K),I=1,NVTO),K=1,NMD) ELSE WRITE(LUFOS,1192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(I),I=2,NVTX), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((XERR(I,K),I=1,NVTX),(YERR(I,K),I=1,NVTX),K=1,NMD) ENDIF ENDIF C IF (FIERR_SPRD) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(IXTAU(ITIMO(I))),I=2,NVTO), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((FOR_INT(IXTAU(ITIMO(I)),K),I=1,NVTO), * (VER_INT(IXTAU(ITIMO(I)),K),I=1,NVTO),K=1,NMD) ELSE WRITE(LUFOS,1192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(I),I=2,NVTX), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((FOR_INT(I,K),I=1,NVTX),(VER_INT(I,K),I=1,NVTX),K=1,NMD) ENDIF ENDIF C DO 1183 M = 1,3 DO 1182 N = 1,4 IF (RDERR_SPRD(M,N)) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFOS,8192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(IXTAU(ITIMO(I))),I=2,NVTO), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((FOR_RAD(IXTAU(ITIMO(I)),M,N,K),I=1,NVTO), * (VER_RAD(IXTAU(ITIMO(I)),M,N,K),I=1,NVTO),K=1,NMD) ELSE WRITE(LUFOS,1192) NINT(BDY(L)),DASH,NINT(BMO(L)),DASH, * NINT(BYEAR(L)),SLASH,NINT(BHR(L)),COLON,IMN,COLON,ISE, * STMID,(FRACN(I),I=2,NVTX), * BLAT(L),-BLON(L),NINT(BWS(L)), * ((FOR_RAD(I,M,N,K),I=1,NVTX), * (VER_RAD(I,M,N,K),I=1,NVTX),K=1,NMD) ENDIF ENDIF 1182 CONTINUE 1183 CONTINUE C C NVTX dependency here C -------------------- 1192 FORMAT(I2.2,A1,I2.2,A1,I4,A1,I2.2,A1,I2.2,A1,I2.2,2X,A8,2X, * 14(F4.2,2X),2X,F6.1,2X,F6.1,2X,I4,20(30(2X,f7.1))) 8192 FORMAT(I2.2,A1,I2.2,A1,I4,A1,I2.2,A1,I2.2,A1,I2.2,2X,A8,2X, * 10(F4.2,2X),2X,F6.1,2X,F6.1,2X,I4,20(22(2X,f7.1))) C C C Go on to next best track time C ----------------------------- 1199 CONTINUE C C C Done looping through best track file. C Compute and write out storm averages. C ------------------------------------- C C NVTX dependency here C -------------------- 1200 IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,'(196("="))') ELSE WRITE(LUFO1,'(276("="))') ENDIF C DO 1201 K =1,NMD DO 1215 I = 1,NVTX IF (NSFT(I).EQ.0) GOTO 1205 STERRAVG(I,K) = STERRTOT(I,K)/FLOAT(NSFT(I)) STLATAVG(I,K) = STLATTOT(I,K)/FLOAT(NSFT(I)) STXERAVG(I,K) = STXERTOT(I,K)/FLOAT(NSFT(I)) STYERAVG(I,K) = STYERTOT(I,K)/FLOAT(NSFT(I)) STDIRAVG(I,K) = WDCOMP(-STXERAVG(I,K),-STYERAVG(I,K)) STMAGAVG(I,K) = WSCOMP(-STXERAVG(I,K),-STYERAVG(I,K)) STAERAVG(I,K) = STAERTOT(I,K)/FLOAT(NSFAC(I)) STCERAVG(I,K) = STCERTOT(I,K)/FLOAT(NSFAC(I)) DUM1 = FLOAT(NSFAC(I))*STAERTOTSQ(I,K) DUM2 = STAERTOT(I,K)**2.0 STAERSTD(I,K)=((DUM1-DUM2)/ * FLOAT(NSFAC(I)*(NSFAC(I)-1)))**0.5 DUM1 = FLOAT(NSFT(I))*STCERTOTSQ(I,K) DUM2 = STCERTOT(I,K)**2.0 STCERSTD(I,K)=((DUM1-DUM2)/ * FLOAT(NSFAC(I)*(NSFAC(I)-1)))**0.5 STAERAVGA(I,K) = STAERTOTA(I,K)/FLOAT(NSFAC(I)) STCERAVGA(I,K) = STCERTOTA(I,K)/FLOAT(NSFAC(I)) CALL SERIAL_CORR(NSFAC(I),STAERAVG(I,K),STCERAVG(I,K), * STM_ACE(1,I,K),STM_CCE(1,I,K), * STIND_AT(I,K),STIND_CT(I,K)) STFSP(I,K) = 100.*STNSP(I,K)/FLOAT(NSFT(I)) 1205 IF (NSFI(I).EQ.0) GOTO 1210 SIERRAVG(I,K) = SIERRTOT(I,K)/FLOAT(NSFI(I)) SIERRAVGA(I,K) = SIERRTOTA(I,K)/FLOAT(NSFI(I)) SIFSP(I,K) = 100.*SINSP(I,K)/FLOAT(NSFI(I)) 1210 DO 1211 M=1,3 DO 1212 N=1,4 IF (NSFR(I,M,N).EQ.0) GOTO 1212 SRERRAVG(I,M,N,K) = * SRERRTOT(I,M,N,K)/FLOAT(NSFR(I,M,N)) SRERRAVGA(I,M,N,K) = * SRERRTOTA(I,M,N,K)/FLOAT(NSFR(I,M,N)) 1212 CONTINUE 1211 CONTINUE 1215 CONTINUE C WRITE(LUFO1,*) C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,8290) MODELO(K), * (STERRAVG(IXTAU(ITIMO(I)),K),I=1,NVTO), * (SIERRAVGA(IXTAU(ITIMO(I)),K),I=1,NVTO) 8290 FORMAT('Model: ',a4,11X,'AVERAGE: ',11F8.1,4X,11F8.1) WRITE(LUFO1,8291) * (NINT(STDIRAVG(IXTAU(ITIMO(I)),K)), * NINT(STMAGAVG(IXTAU(ITIMO(I)),K)),I=1,NVTO), * (SIERRAVG(IXTAU(ITIMO(I)),K),I=1,NVTO) 8291 FORMAT(22X,'BIAS: ',11(1x,I3.3,'/',I3.3),4X,11F8.1) WRITE(LUFO1,8395) (NINT(STFSP(IXTAU(ITIMO(I)),K)),I=1,NVTO), * (NINT(SIFSP(IXTAU(ITIMO(I)),K)),I=1,NVTO) 8395 FORMAT(22X,'FSP (%): ',11I8,4X,11I8) WRITE(LUFO1,8292) (NSFT(IXTAU(ITIMO(I))),I=1,NVTO), * (NSFI(IXTAU(ITIMO(I))),I=1,NVTO) 8292 FORMAT(22X,'# CASES: ',11I8,4X,11I8) ELSE WRITE(LUFO1,1290) MODELO(K),(STERRAVG(I,K),I=1,NVTX), * (SIERRAVGA(I,K),I=1,NVTX) 1290 FORMAT('Model: ',a4,11X,'AVERAGE: ',15F8.1,4X,15F8.1) WRITE(LUFO1,1291) * (NINT(STDIRAVG(I,K)),NINT(STMAGAVG(I,K)),I=1,NVTX), * (SIERRAVG(I,K),I=1,NVTX) 1291 FORMAT(22X,'BIAS: ',15(1x,I3.3,'/',I3.3),4X,15F8.1) WRITE(LUFO1,1295) (NINT(STFSP(I,K)),I=1,NVTX), * (NINT(SIFSP(I,K)),I=1,NVTX) 1295 FORMAT(22X,'FSP (%): ',15I8,4X,15I8) WRITE(LUFO1,1292) (NSFT(I),I=1,NVTX),(NSFI(I),I=1,NVTX) 1292 FORMAT(22X,'# CASES: ',15I8,4X,15I8) ENDIF C C C New format for the allt and alli files. C Still only want this output at the public OFCL times C because it's for the Tropical Cyclone Reports. C ------------------------------------------------------ WRITE(LUFOT,1280) MODELO(K), * STERRAVG(IXTAU(12),K), * STERRAVG(IXTAU(24),K), * STERRAVG(IXTAU(36),K), * STERRAVG(IXTAU(48),K), * STERRAVG(IXTAU(60),K), * STERRAVG(IXTAU(72),K), * STERRAVG(IXTAU(96),K), * STERRAVG(IXTAU(120),K) IF (K.EQ.NMD) WRITE(LUFOT,1281) NSFT(IXTAU(12)), * NSFT(IXTAU(24)),NSFT(IXTAU(36)), * NSFT(IXTAU(48)),NSFT(IXTAU(60)), * NSFT(IXTAU(72)),NSFT(IXTAU(96)), * NSFT(IXTAU(120)) 1280 FORMAT(A4,10F16.1) 1281 FORMAT('NF ',10I16) WRITE(LUFOI,1280) MODELO(K), * SIERRAVGA(IXTAU(12),K), * SIERRAVGA(IXTAU(24),K), * SIERRAVGA(IXTAU(36),K), * SIERRAVGA(IXTAU(48),K), * SIERRAVGA(IXTAU(60),K), * SIERRAVGA(IXTAU(72),K), * SIERRAVGA(IXTAU(96),K), * SIERRAVGA(IXTAU(120),K) IF (K.EQ.NMD) WRITE(LUFOI,1281) NSFI(IXTAU(12)), * NSFI(IXTAU(24)),NSFI(IXTAU(36)), * NSFI(IXTAU(48)),NSFI(IXTAU(60)), * NSFI(IXTAU(72)),NSFI(IXTAU(96)), * NSFI(IXTAU(120)) C IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,8396) (STAERAVGA(IXTAU(ITIMO(I)),K),I=1,NVTO) 8396 FORMAT(/,22X,'ALTK ERR: ',11F8.1) WRITE(LUFO1,8397)(STCERAVGA(IXTAU(ITIMO(I)),K),I=1,NVTO) 8397 FORMAT(22X,'CRTK ERR: ',11F8.1) WRITE(LUFO1,8398) (STAERAVG(IXTAU(ITIMO(I)),K),I=1,NVTO) 8398 FORMAT(22X,'ALTK BIAS:',11F8.1) WRITE(LUFO1,8399)(STCERAVG(IXTAU(ITIMO(I)),K),I=1,NVTO) 8399 FORMAT(22X,'CRTK BIAS:',11F8.1) WRITE(LUFO1,8388) (STAERSTD(IXTAU(ITIMO(I)),K),I=1,NVTO) 8388 FORMAT(22X,'ALTK STDV:',11F8.1) WRITE(LUFO1,8389)(STCERSTD(IXTAU(ITIMO(I)),K),I=1,NVTO) 8389 FORMAT(22X,'CRTK STDV:',11F8.1) WRITE(LUFO1,8370) (STIND_AT(IXTAU(ITIMO(I)),K),I=1,NVTO) 8370 FORMAT(22X,'ALTK TIND:',11F8.1) WRITE(LUFO1,8371)(STIND_CT(IXTAU(ITIMO(I)),K),I=1,NVTO) 8371 FORMAT(22X,'CRTK TIND:',11F8.1) WRITE(LUFO1,8292) (NSFAC(IXTAU(ITIMO(I))),I=1,NVTO) ELSE WRITE(LUFO1,1296) (STAERAVGA(I,K),I=1,NVTX) 1296 FORMAT(/,22X,'ALTK ERR: ',15F8.1) WRITE(LUFO1,1297)(STCERAVGA(I,K),I=1,NVTX) 1297 FORMAT(22X,'CRTK ERR: ',15F8.1) WRITE(LUFO1,1298) (STAERAVG(I,K),I=1,NVTX) 1298 FORMAT(22X,'ALTK BIAS:',15F8.1) WRITE(LUFO1,1299)(STCERAVG(I,K),I=1,NVTX) 1299 FORMAT(22X,'CRTK BIAS:',15F8.1) WRITE(LUFO1,1288) (STAERSTD(I,K),I=1,NVTX) 1288 FORMAT(22X,'ALTK STDV:',15F8.1) WRITE(LUFO1,1289)(STCERSTD(I,K),I=1,NVTX) 1289 FORMAT(22X,'CRTK STDV:',15F8.1) WRITE(LUFO1,1270) (STIND_AT(I,K),I=1,NVTX) 1270 FORMAT(22X,'ALTK TIND:',15F8.1) WRITE(LUFO1,1271)(STIND_CT(I,K),I=1,NVTX) 1271 FORMAT(22X,'CRTK TIND:',15F8.1) WRITE(LUFO1,1292) (NSFAC(I),I=1,NVTX) ENDIF C IF (CLIMO) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO1,8393) (STLATAVG(IXTAU(ITIMO(I)),K),I=1,NVTO) 8393 FORMAT(22X,'AVG LAT: ',11F8.1) ELSE WRITE(LUFO1,1293) (STLATAVG(I,K),I=1,NVTX) 1293 FORMAT(22X,'AVG LAT: ',15F8.1) ENDIF ENDIF C IF (VER_RADII) CALL WRITE_RADII(LUFO1,1,K,SRERRAVG, * SRERRAVGA,NSFR,ITIME,ITIMO,IXYEAR,OFCL_INC, * OFCL_SUP) IF (VICAT) CALL WRITE_INTCAT(LUFO1,1,K,SICATTOT, * ITIME,ITIMO,OFCL_INC,OFCL_SUP) 1201 CONTINUE C C C Write a Kaleidagraph-friendly summary, if there is only C one storm being verified. C -------------------------------------------------------- 1300 IF (.NOT. VER_YEAR) THEN WRITE(LUFOK,'("Track/intensity error summary (nm/kt):",/)') WRITE(LUFOK,1380) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * ' NI',(MODELO(K),K=1,NMD) 1380 FORMAT(A6,42(1x,A7)) DO 1310 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) GOTO 1310 WRITE(FORMATSTRING,'(A12,I2.2,A16,I2.2,A10)') * '(I3.3,4X,I7,', * NMD,'(1x,F7.1),1X,I7,',NMD,'(1X,F7.1))' WRITE(LUFOK,FORMATSTRING) * ITIME(I),NSFT(I),(STERRAVG(I,K),K=1,NMD), * NSFI(I),(SIERRAVGA(I,K),K=1,NMD) 1381 FORMAT(I3.3,3X,I7,40(1x,F7.1)) 1310 CONTINUE ENDIF C C C End of storm reached. Finish or go back for another? C ----------------------------------------------------- 2000 CLOSE(LUFIB) CLOSE(LUFIA) CLOSE(LUFO1) IF (READ_CLSH .OR. WRITE_CLSH) CLOSE(LUFOC) IF (READ_SUPA) CLOSE(LUFIS) C IF (VER_YEAR) THEN DO 2051 K=1,NMD DO 2050 I=1,NVTX C C Track C ----- IF (NSFT(I).GT.0) THEN YTERRTOT(I,K) = STERRTOT(I,K)+YTERRTOT(I,K) YTLATTOT(I,K) = STLATTOT(I,K)+YTLATTOT(I,K) YTXERTOT(I,K) = STXERTOT(I,K)+YTXERTOT(I,K) YTYERTOT(I,K) = STYERTOT(I,K)+YTYERTOT(I,K) YTNSP(I,K) = STNSP(I,K)+YTNSP(I,K) IF (K.EQ.1) NYFT(I) = NYFT(I)+NSFT(I) ENDIF IF (NSFAC(I).GT.0) THEN YTAERTOT(I,K) = STAERTOT(I,K)+YTAERTOT(I,K) YTCERTOT(I,K) = STCERTOT(I,K)+YTCERTOT(I,K) YTAERTOTSQ(I,K) = STAERTOTSQ(I,K)+YTAERTOTSQ(I,K) YTCERTOTSQ(I,K) = STCERTOTSQ(I,K)+YTCERTOTSQ(I,K) YTAERTOTA(I,K) = STAERTOTA(I,K)+YTAERTOTA(I,K) YTCERTOTA(I,K) = STCERTOTA(I,K)+YTCERTOTA(I,K) YTIND_AT(I,K) = YTIND_AT(I,K)+ * STIND_AT(I,K)*FLOAT(NSFAC(I)) YTIND_CT(I,K) = YTIND_CT(I,K)+ * STIND_CT(I,K)*FLOAT(NSFAC(I)) IF (K.EQ.1) NYFAC(I) = NYFAC(I)+NSFAC(I) ENDIF C C Intensity C --------- IF (NSFI(I).GT.0) THEN YIERRTOT(I,K) = SIERRTOT(I,K)+YIERRTOT(I,K) YIERRSSQ(I,K) = SIERRSSQ(I,K)+YIERRSSQ(I,K) YIERRTOTA(I,K) = SIERRTOTA(I,K)+YIERRTOTA(I,K) YINSP(I,K) = SINSP(I,K)+YINSP(I,K) IF (K.EQ.1) NYFI(I) = NYFI(I)+NSFI(I) DO 2052 L=1,NCATX DO 2053 M = 1,NCATX YICATTOT(I,K,L,M) = * YICATTOT(I,K,L,M) + SICATTOT(I,K,L,M) 2053 CONTINUE 2052 CONTINUE ENDIF C C Wind radii C ---------- DO 2061 M=1,3 DO 2060 N=1,4 IF (NSFR(I,M,N).GT.0) THEN YRERRTOT(I,M,N,K) = SRERRTOT(I,M,N,K)+YRERRTOT(I,M,N,K) YRERRSSQ(I,M,N,K) = SRERRSSQ(I,M,N,K)+YRERRSSQ(I,M,N,K) YRERRTOTA(I,M,N,K)=SRERRTOTA(I,M,N,K)+YRERRTOTA(I,M,N,K) IF (K.EQ.1) NYFR(I,M,N) = NYFR(I,M,N)+NSFR(I,M,N) ENDIF 2060 CONTINUE 2061 CONTINUE C 2050 CONTINUE 2051 CONTINUE GOTO 200 ENDIF C C C Write out seasonal output or go back for another year? C ------------------------------------------------------ 2100 IF (VER_YEAR) THEN IF (IVYEAR.LT.IVYEAR2) THEN IVYEAR = IVYEAR+1 NS = 0 IF (COMBO_EPCP .OR. COMBO_ALEP) THEN IF (NCOMB.EQ.2) NCOMB = 1 ENDIF GOTO 200 ENDIF C C DO 2151 K = 1,NMD DO 2150 I = 1,NVTX IF (NYFT(I).GT.0) THEN YTERRAVG(I,K) = YTERRTOT(I,K)/FLOAT(NYFT(I)) YTLATAVG(I,K) = YTLATTOT(I,K)/FLOAT(NYFT(I)) YTXERAVG(I,K) = YTXERTOT(I,K)/FLOAT(NYFT(I)) YTYERAVG(I,K) = YTYERTOT(I,K)/FLOAT(NYFT(I)) YTDIRAVG(I,K) = WDCOMP(-YTXERAVG(I,K),-YTYERAVG(I,K)) YTMAGAVG(I,K) = WSCOMP(-YTXERAVG(I,K),-YTYERAVG(I,K)) YTFSP(I,K) = 100.*YTNSP(I,K)/FLOAT(NYFT(I)) ENDIF IF (NYFAC(I).GT.0) THEN YTAERAVG(I,K) = YTAERTOT(I,K)/FLOAT(NYFAC(I)) YTCERAVG(I,K) = YTCERTOT(I,K)/FLOAT(NYFAC(I)) DUM1 = FLOAT(NYFAC(I))*YTAERTOTSQ(I,K) DUM2 = YTAERTOT(I,K)**2.0 YTAERSTD(I,K)=((DUM1-DUM2)/ * FLOAT(NYFAC(I)*(NYFAC(I)-1)))**0.5 DUM1 = FLOAT(NYFAC(I))*YTCERTOTSQ(I,K) DUM2 = YTCERTOT(I,K)**2.0 YTCERSTD(I,K)=((DUM1-DUM2)/ * FLOAT(NYFAC(I)*(NYFAC(I)-1)))**0.5 YTAERAVGA(I,K) = YTAERTOTA(I,K)/FLOAT(NYFAC(I)) YTCERAVGA(I,K) = YTCERTOTA(I,K)/FLOAT(NYFAC(I)) YTIND_AT(I,K) = YTIND_AT(I,K)/FLOAT(NYFAC(I)) YTIND_CT(I,K) = YTIND_CT(I,K)/FLOAT(NYFAC(I)) ELSE YTIND_AT(I,K) = BAD YTIND_CT(I,K) = BAD ENDIF IF (NYFI(I).GT.0) THEN YIERRAVG(I,K) = YIERRTOT(I,K)/FLOAT(NYFI(I)) RNUM = FLOAT(NYFI(I))*YIERRSSQ(I,K)-YIERRTOT(I,K)**2.0 RDEN = FLOAT(NYFI(I)*(NYFI(I)-1)) SDEV = (RNUM/RDEN)**0.5 SQRN = (FLOAT(NYFI(I)))**0.5 YIERRTSTAT(I,K) = YIERRAVG(I,K)/(SDEV/SQRN) YIERRAVGA(I,K) = YIERRTOTA(I,K)/FLOAT(NYFI(I)) YIFSP(I,K) = 100.*YINSP(I,K)/FLOAT(NYFI(I)) ENDIF DO 2156 M=1,3 DO 2155 N=1,4 IF (NYFR(I,M,N).GT.0) THEN YRERRAVG(I,M,N,K) = YRERRTOT(I,M,N,K)/FLOAT(NYFR(I,M,N)) YRERRAVGA(I,M,N,K)=YRERRTOTA(I,M,N,K)/FLOAT(NYFR(I,M,N)) ENDIF 2155 CONTINUE 2156 CONTINUE C 2150 CONTINUE WRITE(LUFO2,'("Model: ",a4)') MODELO(K) IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO2,8490) * IXYEAR,' TRK (NM)', * (YTERRAVG(IXTAU(ITIMO(I)),K), * NYFT(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8491) * IXYEAR,' TRK BIAS', * (NINT(YTDIRAVG(IXTAU(ITIMO(I)),K)), * NINT(YTMAGAVG(IXTAU(ITIMO(I)),K)), * NYFT(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' TRK FSP%', * (YTFSP(IXTAU(ITIMO(I)),K), * NYFT(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' ALTK ERR', * (YTAERAVGA(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' CRTK ERR', * (YTCERAVGA(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' ALTKBIAS', * (YTAERAVG(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' CRTKBIAS', * (YTCERAVG(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' ALTKSTDV', * (YTAERSTD(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' CRTKSTDV', * (YTCERSTD(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' ALTKTIND', * (YTIND_AT(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' CRTKTIND', * (YTIND_CT(IXTAU(ITIMO(I)),K), * NYFAC(IXTAU(ITIMO(I))),I=1,NVTO) ELSE WRITE(LUFO2,2190) * IXYEAR,' TRK (NM)', * (YTERRAVG(I,K),NYFT(I),I=1,NVTX) WRITE(LUFO2,2191) * IXYEAR,' TRK BIAS', * (NINT(YTDIRAVG(I,K)),NINT(YTMAGAVG(I,K)), * NYFT(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' TRK FSP%', * (YTFSP(I,K),NYFT(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' ALTK ERR', * (YTAERAVGA(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' CRTK ERR', * (YTCERAVGA(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' ALTKBIAS', * (YTAERAVG(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' CRTKBIAS', * (YTCERAVG(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' ALTKSTDV', * (YTAERSTD(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' CRTKSTDV', * (YTCERSTD(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' ALTKTIND', * (YTIND_AT(I,K),NYFAC(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' CRTKTIND', * (YTIND_CT(I,K),NYFAC(I),I=1,NVTX) ENDIF C IF (CLIMO) THEN IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO2,8490) * IXYEAR,' AVG LAT ', * (YTLATAVG(IXTAU(ITIMO(I)),K), * NYFT(IXTAU(ITIMO(I))),I=1,NVTO) ELSE WRITE(LUFO2,2190) * IXYEAR,' AVG LAT ', * (YTLATAVG(I,K),NYFT(I),I=1,NVTX) ENDIF ENDIF C IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO2,8490) * IXYEAR,' WND (KT)', * (YIERRAVGA(IXTAU(ITIMO(I)),K), * NYFI(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' WND BIAS', * (YIERRAVG(IXTAU(ITIMO(I)),K), * NYFI(IXTAU(ITIMO(I))),I=1,NVTO) IF (STATSIG) WRITE(LUFO2,8493) * IXYEAR,' WB TSTAT', * (YIERRTSTAT(IXTAU(ITIMO(I)),K), * NYFI(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8490) * IXYEAR,' WND FSP%', * (YIFSP(IXTAU(ITIMO(I)),K), * NYFI(IXTAU(ITIMO(I))),I=1,NVTO) ELSE WRITE(LUFO2,2190) * IXYEAR,' WND (KT)', * (YIERRAVGA(I,K),NYFI(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' WND BIAS', * (YIERRAVG(I,K),NYFI(I),I=1,NVTX) IF (STATSIG) WRITE(LUFO2,2193) * IXYEAR,' WB TSTAT', * (YIERRTSTAT(I,K),NYFI(I),I=1,NVTX) WRITE(LUFO2,2190) * IXYEAR,' WND FSP%', * (YIFSP(I,K),NYFI(I),I=1,NVTX) ENDIF C IF (VER_RADII) CALL WRITE_RADII(LUFO2,2,K,YRERRAVG, * YRERRAVGA,NYFR,ITIME,ITIMO,IXYEAR,OFCL_INC,OFCL_SUP) IF (VICAT) CALL WRITE_INTCAT(LUFO2,2,K,YICATTOT, * ITIME,ITIMO,OFCL_INC,OFCL_SUP) WRITE(LUFO2,*) C C NVTX dependency here C -------------------- 2190 FORMAT(I4.4,1X,A9,15(3X,F6.1,2X,I4)) 2191 FORMAT(I4.4,1X,A9,15(2X,I3.3,'/',I3.3,2X,I4)) 2193 FORMAT(I4.4,1X,A9,15(3X,F6.2,2X,I4)) 8490 FORMAT(I4.4,1X,A9,11(3X,F6.1,2X,I4)) 8491 FORMAT(I4.4,1X,A9,11(2X,I3.3,'/',I3.3,2X,I4)) 8493 FORMAT(I4.4,1X,A9,11(3X,F6.2,2X,I4)) 2151 CONTINUE C C If at least two models, calculate ratio, C using 2nd model as standard. C --------------------------------------- IF (NMD.GE.2) THEN DO 2180 KK = 1, NMD IF (KK.EQ.2) GOTO 2180 DO 2160 I = 1,NVTX YTERRRAT(I) = * 100.*(YTERRAVG(I,KK)-YTERRAVG(I,2))/YTERRAVG(I,2) YIERRRATA(I) = * 100.*(YIERRAVGA(I,KK)-YIERRAVGA(I,2))/YIERRAVGA(I,2) 2160 CONTINUE C WRITE(LUFO2,'(//"Model: ",A4,"/",A4)') * MODELO(KK),MODELO(2) IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LUFO2,8492) * IXYEAR,' TKRE (%)', * (YTERRRAT(IXTAU(ITIMO(I))), * NYFT(IXTAU(ITIMO(I))),I=1,NVTO) WRITE(LUFO2,8492) * IXYEAR,' WDRE (%)', * (YIERRRATA(IXTAU(ITIMO(I))), * NYFI(IXTAU(ITIMO(I))),I=1,NVTO) ELSE WRITE(LUFO2,2192) * IXYEAR,' TKRE (%)', * (YTERRRAT(I),NYFT(I),I=1,NVTX) WRITE(LUFO2,2192) * IXYEAR,' WDRE (%)', * (YIERRRATA(I),NYFI(I),I=1,NVTX) ENDIF C WRITE(LUFO2,*) C C NVTX dependency here C -------------------- 2192 FORMAT(I4.4,1X,A9,15(3X,F6.1,2X,I4)) 8492 FORMAT(I4.4,1X,A9,11(3X,F6.1,2X,I4)) C C Calculate composite percentage skill score C ------------------------------------------ COMP_TOT = 0. COMP_TOTT = 0. COMP_TOTI = 0. NCOMP = 0 NCOMPT = 0 NCOMPI = 0 COMP_TFSP = 0. COMP_TFSPT = 0. COMP_TFSPI = 0. DO 2170 I = 2,NVTX IF (ITIME(I).GT.120) GOTO 2170 IF (NYFT(I).GE.1) THEN COMP_TOTT = COMP_TOTT+YTERRRAT(I)*FLOAT(NYFT(I)) COMP_TFSPT = COMP_TFSPT+YTFSP(I,KK)*FLOAT(NYFT(I)) NCOMPT = NCOMPT+NYFT(I) ENDIF IF (NYFI(I).GE.1) THEN COMP_TOTI = COMP_TOTI+YIERRRATA(I)*FLOAT(NYFI(I)) COMP_TFSPI = COMP_TFSPI+YIFSP(I,KK)*FLOAT(NYFI(I)) NCOMPI = NCOMPI+NYFI(I) ENDIF 2170 CONTINUE COMP_SKILL = -999. COMP_SKILLT = -999. COMP_SKILLI = -999. COMP_TOT = COMP_TOTT + COMP_TOTI COMP_FSP = -999. COMP_FSPT = -999. COMP_FSPI = -999. COMP_TFSP = COMP_TFSPT + COMP_TFSPI NCOMP = NCOMPT+NCOMPI IF (NCOMP.GT.0) THEN COMP_SKILL = -COMP_TOT/FLOAT(NCOMP) COMP_FSP = COMP_TFSP/FLOAT(NCOMP) ENDIF IF (NCOMPT.GT.0) THEN COMP_SKILLT = -COMP_TOTT/FLOAT(NCOMPT) COMP_FSPT = COMP_TFSPT/FLOAT(NCOMPT) ENDIF IF (NCOMPI.GT.0) THEN COMP_SKILLI = -COMP_TOTI/FLOAT(NCOMPI) COMP_FSPI = COMP_TFSPI/FLOAT(NCOMPI) ENDIF WRITE(LUFO2,'("Model: ",A4,"/",A4)') * MODELO(KK),MODELO(2) WRITE(LUFO2,'("Composite track skill (%) = ",F6.1)') * COMP_SKILLT WRITE(LUFO2,'("Composite intensity skill (%) = ",F6.1)') * COMP_SKILLI WRITE(LUFO2,'("Composite combined skill (%) = ",F6.1)') * COMP_SKILL WRITE(LUFO2,'(/,"Composite track FSP (%) = ", * F6.1)') COMP_FSPT WRITE(LUFO2,'("Composite intensity FSP (%) = ",F6.1)') * COMP_FSPI WRITE(LUFO2,'("Composite combined FSP (%) = ",F6.1)') * COMP_FSP 2180 CONTINUE ENDIF C C C C Write a Kaleidagraph-friendly summary. C -------------------------------------- 2300 CONTINUE C C C Special radii output C -------------------- IF (KGRFPAR.EQ.'R') THEN WRITE(LUFOK,'("Wind radii error summary:",/)') WRITE(LUFOK,2380) 'VT (h)', * ' N34NE',(MODELO(K),K=1,NMD), * ' N34SE',(MODELO(K),K=1,NMD), * ' N34SW',(MODELO(K),K=1,NMD), * ' N34NW',(MODELO(K),K=1,NMD), * ' N50NE',(MODELO(K),K=1,NMD), * ' N50SE',(MODELO(K),K=1,NMD), * ' N50SW',(MODELO(K),K=1,NMD), * ' N50NW',(MODELO(K),K=1,NMD), * ' N64NE',(MODELO(K),K=1,NMD), * ' N64SE',(MODELO(K),K=1,NMD), * ' N64SW',(MODELO(K),K=1,NMD), * ' N64NW',(MODELO(K),K=1,NMD) 2380 FORMAT(A6,36(1x,A7)) DO 2320 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2320 WRITE(LUFOK,2381) ITIME(I), * FLOAT(NYFR(I,1,1)),(YRERRAVGA(I,1,1,K),K=1,NMD), * FLOAT(NYFR(I,1,2)),(YRERRAVGA(I,1,2,K),K=1,NMD), * FLOAT(NYFR(I,1,3)),(YRERRAVGA(I,1,3,K),K=1,NMD), * FLOAT(NYFR(I,1,4)),(YRERRAVGA(I,1,4,K),K=1,NMD), * FLOAT(NYFR(I,2,1)),(YRERRAVGA(I,2,1,K),K=1,NMD), * FLOAT(NYFR(I,2,2)),(YRERRAVGA(I,2,2,K),K=1,NMD), * FLOAT(NYFR(I,2,3)),(YRERRAVGA(I,2,3,K),K=1,NMD), * FLOAT(NYFR(I,2,4)),(YRERRAVGA(I,2,4,K),K=1,NMD), * FLOAT(NYFR(I,3,1)),(YRERRAVGA(I,3,1,K),K=1,NMD), * FLOAT(NYFR(I,3,2)),(YRERRAVGA(I,3,2,K),K=1,NMD), * FLOAT(NYFR(I,3,3)),(YRERRAVGA(I,3,3,K),K=1,NMD), * FLOAT(NYFR(I,3,4)),(YRERRAVGA(I,3,4,K),K=1,NMD) 2381 FORMAT(I3.3,3X,36(1x,F7.1)) 2320 CONTINUE ENDIF C C C Special steadiness output C ------------------------- IF (KGRFPAR.EQ.'V') THEN WRITE(LUFOK, * '("Along/Cross track std dev summary (n mi):",/)') WRITE(LUFOK,1380) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * (MODELO(K),K=1,NMD) DO 2355 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2355 WRITE(LUFOK,2381) ITIME(I),FLOAT(NYFT(I)), * (YTAERSTD(I,K),K=1,NMD),(YTCERSTD(I,K),K=1,NMD) 2355 CONTINUE ENDIF C C C Special FSP output C ------------------------- IF (KGRFPAR.EQ.'F') THEN WRITE(LUFOK,'("Track/intensity FSP summary (%):",/)') WRITE(LUFOK,1380) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * ' NI',(MODELO(K),K=1,NMD) DO 2356 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2356 WRITE(FORMATSTRING,'(A12,I2.2,A16,I2.2,A10)') * '(I3.3,4X,I7,',NMD,'(1x,F7.1),1X,I7,',NMD,'(1X,F7.1))' WRITE(LUFOK,FORMATSTRING) * ITIME(I),NYFT(I),(YTFSP(I,K),K=1,NMD), * NYFI(I),(YIFSP(I,K),K=1,NMD) 2356 CONTINUE ENDIF C C C Special RI frequency output C --------------------------- IF (KGRFPAR.EQ.'I') THEN WRITE(LUFOK, * '("RI count/intensity error summary (N/kt):",/)') WRITE(LUFOK,1380) 'VT (h)',' NI',(MODELO(K),K=1,NMD), * ' NI',(MODELO(K),K=1,NMD) DO 2357 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2357 WRITE(FORMATSTRING,'(A12,I2.2,A16,I2.2,A10)') * '(I3.3,4X,I7,',NMD,'(1x,F7.1),1X,I7,',NMD,'(1X,F7.1))' WRITE(LUFOK,FORMATSTRING) * ITIME(I),NYFI(I),(FLOAT(NFRI(I,K)),K=1,NMD), * NYFI(I),(YIERRAVGA(I,K),K=1,NMD) 2357 CONTINUE ENDIF C C C Special along/cross output C ------------------------- IF (KGRFPAR.EQ.'A') THEN WRITE(LUFOK, * '("Along/Cross track error summary (n mi):",/)') WRITE(LUFOK,1380) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * (MODELO(K),K=1,NMD) DO 2358 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2358 WRITE(LUFOK,2381) ITIME(I),FLOAT(NYFT(I)), * (YTAERAVGA(I,K),K=1,NMD),(YTCERAVGA(I,K),K=1,NMD) 2358 CONTINUE ENDIF C C C Special bias output C ------------------------- IF (KGRFPAR.EQ.'B') THEN WRITE(LUFOK, * '("Track/intensity bias summary (n mi):",/)') WRITE(LUFOK,2382) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * ' NI',(MODELO(K),K=1,NMD) DO 2359 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2359 WRITE(FORMATSTRING,'(A12,I2.2,A24,I2.2,A10)') * '(I3.3,4X,I8,',NMD,'(2x,i3.3,a1,i3.3),1X,I8,',NMD, * '(1X,F8.1))' WRITE(LUFOK,FORMATSTRING) ITIME(I),NYFT(I), * (NINT(YTDIRAVG(I,K)),'/',NINT(YTMAGAVG(I,K)),K=1,NMD), * NYFI(I),(YIERRAVG(I,K),K=1,NMD) 2359 CONTINUE 2382 FORMAT(A6,40(1x,A8)) ENDIF C C C Standard KGRF output C -------------------- IF (KGRFPAR.EQ.'N') THEN WRITE(LUFOK,'("Track/intensity error summary (nm/kt):",/)') WRITE(LUFOK,1380) 'VT (h)',' NT',(MODELO(K),K=1,NMD), * ' NI',(MODELO(K),K=1,NMD) DO 2310 I = 1,NVTX IF ((OFCL_INC.AND.OFCL_SUP) .AND. .NOT.OFCLT(I)) * GOTO 2310 WRITE(FORMATSTRING,'(A12,I2.2,A16,I2.2,A10)') * '(I3.3,4X,I7,',NMD,'(1x,F7.1),1X,I7,',NMD,'(1X,F7.1))' WRITE(LUFOK,FORMATSTRING) * ITIME(I),NYFT(I),(YTERRAVG(I,K),K=1,NMD), * NYFI(I),(YIERRAVGA(I,K),K=1,NMD) 2310 CONTINUE ENDIF C C 2400 CLOSE(LUFO2) CLOSE(LUFOS) CLOSE(LUFOT) CLOSE(LUFOI) ENDIF C C C Finish up. C ---------- CLOSE(LUFOK) IF (WWARN.NE.'N') CLOSE(LUFIW) IF (VER_LIST.EQ.'I' .OR. VER_LIST.EQ.'E') CLOSE(LUFIL) WRITE(LUT,'("Program verify_model completed.")') STOP C C C Errors C ------ 9000 WRITE(LUT,'("*** FATAL ERROR: FILE I/O ERROR ***")') STOP C 9010 WRITE(LUT,'("CANNOT OPEN BTRK FILE FOR STMID ",A8)') STMID IF (VER_YEAR) GOTO 200 STOP C 9020 WRITE(LUT,'("CANNOT OPEN AIDS FILE FOR STMID ",A8)') STMID IF (VER_YEAR) GOTO 200 STOP C 9030 WRITE(LUT,'(/"ERROR SPECIFYING MULTIPLE-STORM SAMPLE: ", * A8)') STMID WRITE(LUT,'("Use of AL has been replaced by SY/MY to")') WRITE(LUT,'("designate single/multiple years. For example,")') WRITE(LUT,'("EPSY2019 verifies all EPAC 2019 storms, and")') WRITE(LUT,'("EPMY2021 verifies all EPAC 2020-2021 storms.")') STOP C END C C C C ---------------------------------------------------------------- SUBROUTINE LOG_HEADER(LU,NMD,MODELO,NMCX,MODELCXO,NMCY,MODELCYO, * NMTA,MODELTAO,NMIA,MODELIAO, * NMTB,MODELTBO,NMIB,MODELIBO, * NMTC,MODELTCO,NMIC,MODELICO, * NMTD,MODELTDO,NMID,MODELIDO, * NMTE,MODELTEO,NMIE,MODELIEO, * NMTF,MODELTFO,NMIF,MODELIFO, * NMTG,MODELTGO,NMIG,MODELIGO, * NMTH,MODELTHO,NMIH,MODELIHO, * NMTI,MODELTIO,NMII,MODELIIO, * NMTJ,MODELTJO,NMIJ,MODELIJO,NMMIN, * SAMPLE,STMNAME,LIST_LABEL, * WSMIN,WSMAX,VER_SUBT,VER_EXTRAT,VER_NONBT, * VER_TD_INIT,VER_RI,VER_NY34,VER_LIST,WWARN, * FCSTRV,WSDIS,RLATMIN,RLATMAX,RLONMIN,RLONMAX, * FLATMIN,FLATMAX,FLONMIN,FLONMAX,VER_OPER, * DATEMIN,DATEMAX,VER_SAB,WATER_ONLY,MLAG, * SYNOPTIC_TIME,NWINDOW,ADECK_DIR, * FCSTNEARLAND,DIST_LAND,FNAME_WW, * SIZECHECK,STMSIZE,WS_CRIT_VT,INTERP12, * ACPTALLST_IT,ACPTALLST_VT,DELW_RI,DELT_RI, * VER_RIF,FDIFF_ONLY) C C Writes header information in output files. C ---------------------------------------------------------------- C PARAMETER (NMDX=20) DIMENSION MLAG(NMDX) CHARACTER*1 WWARN, VER_EXTRAT, VER_SUBT, VER_NONBT, VER_LIST CHARACTER*1 FCSTNEARLAND, SIZECHECK CHARACTER*3 FCSTRV CHARACTER*4 MODELO(NMDX), MODELCXO(NMDX), MODELCYO(NMDX) CHARACTER*4 MODELTAO(NMDX), MODELIAO(NMDX) CHARACTER*4 MODELTBO(NMDX), MODELIBO(NMDX) CHARACTER*4 MODELTCO(NMDX), MODELICO(NMDX) CHARACTER*4 MODELTDO(NMDX), MODELIDO(NMDX) CHARACTER*4 MODELTEO(NMDX), MODELIEO(NMDX) CHARACTER*4 MODELTFO(NMDX), MODELIFO(NMDX) CHARACTER*4 MODELTGO(NMDX), MODELIGO(NMDX) CHARACTER*4 MODELTHO(NMDX), MODELIHO(NMDX) CHARACTER*4 MODELTIO(NMDX), MODELIIO(NMDX) CHARACTER*4 MODELTJO(NMDX), MODELIJO(NMDX) CHARACTER*4 SYNOPTIC_TIME CHARACTER*4 ADECK_DIR CHARACTER*8 INCLUDE CHARACTER*10 STMNAME CHARACTER*20 SAMPLE CHARACTER*60 LIST_LABEL CHARACTER*60 FNAME_WW DOUBLE PRECISION DATEMIN, DATEMAX LOGICAL VER_TD_INIT, VER_NY34, VER_OPER, VER_SAB, WATER_ONLY LOGICAL VER_RI,WS_CRIT_VT,INTERP12,ACPTALLST_IT,ACPTALLST_VT LOGICAL VER_RIF,FDIFF_ONLY C C C WRITE(LU,190) SAMPLE, STMNAME 190 FORMAT('Verification statistics for: ',A20,2X,A10) WRITE(LU,191) (MODELO(I),I=1,NMD) 191 FORMAT('Model(s) verified: ',20(A4,1X)) DO 192 L = 1,NMD IF (MODELO(L).EQ.'CONX') THEN WRITE(LU,193) MODELO(L),(MODELCXO(I),I=1,NMCX) ENDIF IF (MODELO(L).EQ.'CONY') THEN WRITE(LU,193) MODELO(L),(MODELCYO(I),I=1,NMCY) ENDIF IF (MODELO(L).EQ.'CONA') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTAO(I),I=1,NMTA) WRITE(LU,195) MODELO(L),NMMIN,(MODELIAO(I),I=1,NMIA) ENDIF IF (MODELO(L).EQ.'CONB') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTBO(I),I=1,NMTB) WRITE(LU,195) MODELO(L),NMMIN,(MODELIBO(I),I=1,NMIB) ENDIF IF (MODELO(L).EQ.'CONC') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTCO(I),I=1,NMTC) WRITE(LU,195) MODELO(L),NMMIN,(MODELICO(I),I=1,NMIC) ENDIF IF (MODELO(L).EQ.'COND') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTDO(I),I=1,NMTD) WRITE(LU,195) MODELO(L),NMMIN,(MODELIDO(I),I=1,NMID) ENDIF IF (MODELO(L).EQ.'CONE') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTEO(I),I=1,NMTE) WRITE(LU,195) MODELO(L),NMMIN,(MODELIEO(I),I=1,NMIE) ENDIF IF (MODELO(L).EQ.'CONF') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTFO(I),I=1,NMTF) WRITE(LU,195) MODELO(L),NMMIN,(MODELIFO(I),I=1,NMIF) ENDIF IF (MODELO(L).EQ.'CONG') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTGO(I),I=1,NMTG) WRITE(LU,195) MODELO(L),NMMIN,(MODELIGO(I),I=1,NMIG) ENDIF IF (MODELO(L).EQ.'CONH') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTHO(I),I=1,NMTH) WRITE(LU,195) MODELO(L),NMMIN,(MODELIHO(I),I=1,NMIH) ENDIF IF (MODELO(L).EQ.'CONI') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTIO(I),I=1,NMTI) WRITE(LU,195) MODELO(L),NMMIN,(MODELIIO(I),I=1,NMII) ENDIF IF (MODELO(L).EQ.'CONJ') THEN WRITE(LU,194) MODELO(L),NMMIN,(MODELTJO(I),I=1,NMTJ) WRITE(LU,195) MODELO(L),NMMIN,(MODELIJO(I),I=1,NMIJ) ENDIF 193 FORMAT(A4,' consensus members: ',20(A4,1X)) 194 FORMAT(A4,' trk cons members (min=',i1,'): ',20(A4,1X)) 195 FORMAT(A4,' int cons members (min=',i1,'): ',20(A4,1X)) IF (MLAG(L).NE.0) THEN WRITE(LU,181) MODELO(L),MLAG(L) 181 FORMAT('Model 'A4,' lagged ',i2,' h.') ENDIF 192 CONTINUE WRITE(LU,196) NINT(WSMIN),NINT(WSMAX) 196 FORMAT("Min, max wind speed verified: ",2X,I2.2,i4," kt.") IF (.NOT.WS_CRIT_VT) WRITE(LU, * '("WS criteria applied only to initial time.")') INCLUDE = 'excluded' IF (VER_SUBT.EQ.'Y') INCLUDE = 'included' WRITE(LU,'("Subtropical stage (if any) ",a8,".")') INCLUDE INCLUDE = 'excluded' IF (VER_EXTRAT.EQ.'Y') INCLUDE = 'included' WRITE(LU,'("Extratropical stage (if any) ",a8,".")') INCLUDE IF (VER_NONBT.EQ.'Y') THEN WRITE(LU,'("Dissipation forecasts included; ", * i2," kt assigned when needed.")') NINT(WSDIS) ELSE WRITE(LU,'("Dissipation forecasts excluded.")') ENDIF IF (ACPTALLST_IT) WRITE(LU, * '("ALL stages included at initial time ", * "(supercedes ST/EX above). OFCL includes OFCP.")') IF (ACPTALLST_VT) WRITE(LU, * '("ALL stages included at verification time ", * "(supercedes ST/EX above).")') IF (RLATMIN.NE.0. .OR. RLATMAX.NE.90. .OR. * RLONMIN.NE.-140. .OR. RLONMAX.NE.0.) WRITE(LU, * '("Initial position domain: "2f6.1,"N ",2f6.1,"W")') * ABS(RLATMIN),ABS(RLATMAX),ABS(RLONMAX),ABS(RLONMIN) IF (FLATMIN.GE.0) WRITE(LU, * '("Forecast position domain: "2f6.1,"N ",2f6.1,"W")') * ABS(FLATMIN),ABS(FLATMAX),ABS(FLONMAX),ABS(FLONMIN) IF (NINT(DATEMIN).NE.0 .AND. NINT(DATEMAX).NE.0) WRITE(LU, * '("Includes forecasts issued between ",i8," and ",i8,".")') * NINT(DATEMIN),NINT(DATEMAX) IF (SYNOPTIC_TIME(1:1).NE.'Y') WRITE(LU, * '("Excludes 00Z forecasts.")') IF (SYNOPTIC_TIME(2:2).NE.'Y') WRITE(LU, * '("Excludes 06Z forecasts.")') IF (SYNOPTIC_TIME(3:3).NE.'Y') WRITE(LU, * '("Excludes 12Z forecasts.")') IF (SYNOPTIC_TIME(4:4).NE.'Y') WRITE(LU, * '("Excludes 18Z forecasts.")') IF (ADECK_DIR.NE.'data') WRITE(LU, * '("A-decks taken from directory ",a4,".")') ADECK_DIR IF (VER_TD_INIT) WRITE(LU, * '("Only includes forecasts issued for TDs.")') IF (VER_RI .AND. DELW_RI.GE.0) WRITE(LU, * '("Only includes forecast if RI obs at VT (", * I2,"kt/",I2,"h).")') NINT(DELW_RI),NINT(DELT_RI) IF (VER_RI .AND. DELW_RI.LT.0) WRITE(LU, * '("Only includes forecast if RW obs at VT (", * I3,"kt/",I2,"h).")') NINT(DELW_RI),NINT(DELT_RI) IF (VER_RIF .AND. DELW_RI.GE.0) WRITE(LU, * '("Only includes forecast if RI obs or fcst at VT (", * I2,"kt/",I2,"h).")') NINT(DELW_RI),NINT(DELT_RI) IF (VER_NY34) WRITE(LU, * '("Excludes fcsts issued after BT wind exceeds 34 kt.")') IF (FDIFF_ONLY) WRITE(LU, * '("Excludes identical forecasts.")') IF (WATER_ONLY) WRITE(LU, * '("Excludes forecasts after landfall.")') IF (NWINDOW.NE.0) WRITE(LU, * '("Excludes forecasts more than ",i3," h prior to landfall.")') * NWINDOW IF (FCSTNEARLAND.EQ.'N') WRITE(LU, * '("Includes only forecast points within ",i3, * " n mi of land.")') * NINT(DIST_LAND) IF (FCSTNEARLAND.EQ.'F') WRITE(LU, * '("Includes only forecast points beyond ",i3, * " n mi of land.")') * NINT(DIST_LAND) IF (SIZECHECK.EQ.'L') WRITE(LU, * '("Includes only storms w/ROCI >= ",i3, * " n mi.")') * NINT(STMSIZE) IF (SIZECHECK.EQ.'S') WRITE(LU, * '("Includes only storms w/ROCI < ",i3, * " n mi.")') * NINT(STMSIZE) IF (VER_LIST.EQ.'I') WRITE(LU, * '("Only includes forecasts in verify_model_fcstlist.txt: ", * A60)') LIST_LABEL IF (VER_LIST.EQ.'E') WRITE(LU, * '("Excludes forecasts in verify_model_fcstlist.txt: ", * A60)') LIST_LABEL IF (.NOT.INTERP12) WRITE(LU, * '("Excludes 12-h interpolated forecasts.")') IF (VER_OPER) WRITE(LU, * '("VERIFIED AGAINST OPERATIONAL DATA.")') IF (VER_SAB) WRITE(LU, * '("VERIFIED AGAINST SAB CLASSIFICATIONS.")') IF (WWARN.EQ.'I') WRITE(LU, * '("Forecasts issued when w/w in effect. File: ",a15)') * FNAME_WW IF (WWARN.EQ.'H') WRITE(LU, * '("Forecasts issued when H w/w in effect. File: ",a15)') * FNAME_WW IF (WWARN.EQ.'J') WRITE(LU, * '("Forecasts issued when w/w NOT in effect. File: ",a15)') * FNAME_WW IF (WWARN.EQ.'V') WRITE(LU, * '("Forecasts verify when w/w in effect. File: ",a15)') * FNAME_WW IF (WWARN.EQ.'W') WRITE(LU, * '("Forecasts verify when w/w NOT in effect. File: ",a15)') * FNAME_WW IF (FCSTRV.NE.'ALL') WRITE(LU,'("Forecaster: ",A3)') FCSTRV C WRITE(LU,*) RETURN END C C C C ------------------------------------------------------- SUBROUTINE INT_CAT(WS,ICAT,WSDIS,ST,NCAT) C C Determines intensity category based on wind speed. C 1 = Dissipation C 2 = Depression C 3 = Storm C 4 = Hurricane C 5 = Major hurricane C C If NCAT=4 then Hurricane and Maj. Hurricane are merged. C C ST contains the best track status for verifying inputs, C and is set to 'FC' for forecast inputs. C ------------------------------------------------------- C CHARACTER*2 ST C ICAT = 0 C C Category is "dissipated" if there was no best track C intensity present or if verifying status was expicitly C a LOW, WAVE, or UNKNOWN. C ------------------------------------------------------- IF (ST.EQ.'LO' .OR. ST.EQ.'WV' .OR. ST.EQ.'XX' .OR. * WS.EQ.WSDIS+0.5) THEN ICAT = 1 RETURN ENDIF C C We will arbritrarily also assign "dissipated" to any C forecast of 20 kt or less, since there is no way to C distinguish a forecast of a 20 kt remnant low from a C forecast of a depression in the A deck. C ---------------------------------------------------- IF (ST.EQ.'FC' .AND. WS.LE.20.) THEN ICAT = 1 RETURN ENDIF C C Otherwise, the wind speed determines category. C ---------------------------------------------- IF (WS.GT.0. .AND. WS.LT. 34.) ICAT = 2 IF (WS.GE.34. .AND. WS.LT. 64.) ICAT = 3 IF (NCAT.EQ.4) THEN IF (WS.GE.64.) ICAT = 4 ENDIF IF (NCAT.EQ.5) THEN IF (WS.GE.64. .AND. WS.LT. 97.) ICAT = 4 IF (WS.GE.97.) ICAT = 5 ENDIF C IF (ICAT.EQ.0) THEN WRITE(1,*) 'UNABLE TO DETERMINE INTENSITY CATEGORY' STOP ENDIF C RETURN END C C C C --------------------------------------------------- SUBROUTINE WRITE_INTCAT(LU,IFMT,K,CATTOT, * ITIME,ITIMO,OFCL_INC,OFCL_SUP) C C Writes out total intensity category data. C IFMT = 1 for storm total, IFMT = 2 for yearly data. C --------------------------------------------------- C PARAMETER (NVTX = 15, NVTO = 11, NMDX=20, NCATX = 5) DIMENSION CATTOT(NVTX,NMDX,NCATX,NCATX) DIMENSION CATPCT(NVTX,NMDX,NCATX,NCATX) DIMENSION ITIME(NVTX), ITIMO(NVTO) CHARACTER*3 CATLABEL(NCATX) LOGICAL OFCL_INC,OFCL_SUP C CATLABEL(1) = 'DIS' CATLABEL(2) = 'DEP' CATLABEL(3) = 'STM' CATLABEL(4) = 'HUR' IF (NCATX.EQ.5) THEN CATLABEL(4) = 'H12' CATLABEL(5) = 'H35' ENDIF C IF (IFMT.EQ.1) GOTO 100 IF (IFMT.EQ.2) GOTO 200 RETURN C C C Storm total output. NVTX dependency. C ------------------------------------- 100 WRITE(LU,*) WRITE(LU,190) 190 FORMAT(22X,'FOR/VER CATEGORY VERIFICATION TABLE',/,22X,35("=")) DO 110 M = 1,NCATX DO 120 N = 1,NCATX IF (M.EQ.1 .AND. N.EQ.1) GOTO 120 IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,196) CATLABEL(M),CATLABEL(N), * (NINT(CATTOT(IXTAU(ITIMO(I)),K,M,N)),I=1,NVTO) 196 FORMAT(22X,A3,'/',A3,3X,11I8) ELSE WRITE(LU,195) CATLABEL(M),CATLABEL(N), * (NINT(CATTOT(I,K,M,N)),I=1,NVTX) 195 FORMAT(22X,A3,'/',A3,3X,15I8) ENDIF 120 CONTINUE WRITE(LU,*) 110 CONTINUE RETURN C C C Annual total output C ------------------- 200 DO 205 I = 1,NVTX DO 210 M = 1,NCATX TOT = 0 DO 220 N = 1,NCATX TOT = TOT + CATTOT(I,K,M,N) 220 CONTINUE DO 225 N = 1,NCATX IF (TOT.GT.0) THEN CATPCT(I,K,M,N) = NINT(100*CATTOT(I,K,M,N)/TOT) ELSE CATPCT(I,K,M,N) = 0. ENDIF 225 CONTINUE 210 CONTINUE 205 CONTINUE C WRITE(LU,*) WRITE(LU,290) 290 FORMAT('INTENSITY CATEGORY VERIFICATION TABLE') C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,292) WRITE(LU,'(164("="))') ELSE WRITE(LU,291) WRITE(LU,'(239("="))') ENDIF 291 FORMAT('FOR/VER',7X,' (%)000 000N', * ' (%)012 012N', * ' (%)024 024N', * ' (%)036 036N', * ' (%)048 048N', * ' (%)060 060N', * ' (%)072 072N', * ' (%)084 084N', * ' (%)096 096N', * ' (%)108 108N', * ' (%)120 120N', * ' (%)132 132N', * ' (%)144 144N', * ' (%)156 156N', * ' (%)168 168N') 292 FORMAT('FOR/VER',7X,' (%)000 000N', * ' (%)012 012N', * ' (%)024 024N', * ' (%)036 036N', * ' (%)048 048N', * ' (%)072 072N', * ' (%)096 096N', * ' (%)120 120N', * ' (%)144 144N', * ' (%)168 168N') C DO 250 M = 1,NCATX DO 260 N = 1,NCATX C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,296) CATLABEL(M),CATLABEL(N), * (NINT(CATPCT(IXTAU(ITIMO(I)),K,M,N)), * NINT(CATTOT(IXTAU(ITIMO(I)),K,M,N)),I=1,NVTO) ELSE WRITE(LU,295) CATLABEL(M),CATLABEL(N), * (NINT(CATPCT(I,K,M,N)),NINT(CATTOT(I,K,M,N)),I=1,NVTX) ENDIF 295 FORMAT(A3,'/',A3,7X,15(3X,I6,1X,I5)) 296 FORMAT(A3,'/',A3,7X,11(3X,I6,1X,I5)) 260 CONTINUE WRITE(LU,*) 250 CONTINUE RETURN C END C C C C ----------------------------------------------------------- SUBROUTINE WRITE_RADII(LU,IFMT,K,ERRAVG,ERRAVGA,NFR,ITIME, * ITIMO,IXYEAR,OFCL_INC,OFCL_SUP) C C Writes out radii verification. C IFMT = 1 for storm total, IFMT = 2 for yearly data. C --------------------------------------------------- C PARAMETER (NVTX = 15, NVTO = 11, NMDX=20) DIMENSION ERRAVG(NVTX,3,4,NMDX) DIMENSION ERRAVGA(NVTX,3,4,NMDX) DIMENSION NFR(NVTX,3,4) DIMENSION ITIME(NVTX), ITIMO(NVTO) CHARACTER*2 QLABEL(4) CHARACTER*2 WLABEL(3) LOGICAL OFCL_INC,OFCL_SUP C QLABEL(1) = 'NE' QLABEL(2) = 'SE' QLABEL(3) = 'SW' QLABEL(4) = 'NW' WLABEL(1) = '34' WLABEL(2) = '50' WLABEL(3) = '64' C IF (IFMT.EQ.1) GOTO 100 IF (IFMT.EQ.2) GOTO 200 RETURN C C C Storm total output C ------------------ 100 WRITE(LU,*) IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,191) (ITIMO(I),I=1,NVTO) ELSE WRITE(LU,190) (ITIME(I),I=1,NVTX) ENDIF 191 FORMAT(22X,'WIND RADII',11I8,/,22X,98("=")) 190 FORMAT(22X,'WIND RADII',15I8,/,22X,130("=")) C C NVTX dependency here C -------------------- DO 110 M = 1,3 DO 120 N = 1,4 IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,194) WLABEL(M),QLABEL(N),' AVG', * (ERRAVGA(IXTAU(ITIMO(I)),M,N,K),I=1,NVTO) WRITE(LU,194) WLABEL(M),QLABEL(N),'BIAS', * (ERRAVG(IXTAU(ITIMO(I)),M,N,K),I=1,NVTO) 194 FORMAT(22X,2A2,' ',A4,1X,11F8.1) ELSE WRITE(LU,195) WLABEL(M),QLABEL(N),' AVG', * (ERRAVGA(I,M,N,K),I=1,NVTX) WRITE(LU,195) WLABEL(M),QLABEL(N),'BIAS', * (ERRAVG(I,M,N,K),I=1,NVTX) 195 FORMAT(22X,2A2,' ',A4,1X,15F8.1) ENDIF 120 CONTINUE IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,197) WLABEL(M),'NE',' #', * (NFR(IXTAU(ITIMO(I)),M,1),I=1,NVTO) ELSE WRITE(LU,196) WLABEL(M),'NE',' #', * (NFR(I,M,1),I=1,NVTX) ENDIF C C NVTX dependency here C -------------------- 196 FORMAT(22X,2A2,' ',A4,1X,15I8) 197 FORMAT(22X,2A2,' ',A4,1X,11I8) WRITE(LU,*) 110 CONTINUE RETURN C C C Annual total output C ------------------- 200 DO 210 M=1,3 DO 220 N=1,4 C C NVTX dependency here C -------------------- IF (OFCL_INC .AND. OFCL_SUP) THEN WRITE(LU,290) IXYEAR,WLABEL(M),QLABEL(N),' AVG', * (ERRAVGA(IXTAU(ITIMO(I)),M,N,K), * NFR(IXTAU(ITIMO(I)),M,N),I=1,NVTO) WRITE(LU,290) IXYEAR,WLABEL(M),QLABEL(N),' BIAS', * (ERRAVG(IXTAU(ITIMO(I)),M,N,K), * NFR(IXTAU(ITIMO(I)),M,N),I=1,NVTO) ELSE WRITE(LU,290) IXYEAR,WLABEL(M),QLABEL(N),' AVG', * (ERRAVGA(I,M,N,K),NFR(I,M,N),I=1,NVTX) WRITE(LU,290) IXYEAR,WLABEL(M),QLABEL(N),' BIAS', * (ERRAVG(I,M,N,K),NFR(I,M,N),I=1,NVTX) ENDIF 290 FORMAT(I4.4,1x,A2,A2,A5,15(3X,F6.1,2X,I4)) 291 FORMAT(I4.4,1x,A2,A2,A5,11(3X,F6.1,2X,I4)) 220 CONTINUE 210 CONTINUE RETURN C END C C C C ---------------------------------------------------------- SUBROUTINE GET_CONSENSUS(LUFIC,LUT,FNAME_CONS,NMC,MODELC) C C Reads text file to determine what models go into average. C ---------------------------------------------------------- PARAMETER (NMDX=20) CHARACTER*60 FNAME_CONS CHARACTER*4 MODELC(NMDX) C C C Determine members of the consensus C ------------------------------------------- 100 OPEN(LUFIC,FILE=FNAME_CONS,STATUS='OLD',ERR=9000) READ(LUFIC,*) NMC IF (NMC.LT.1 .OR. NMC.GT.NMDX) GOTO 9010 DO 101 K = 1,NMC READ(LUFIC,'(A4)',ERR=9000) MODELC(K) 101 CONTINUE CLOSE(LUFIC) C WRITE(LUT,'(/"Will form consensus of the following models:")') DO 106 K = 1,NMC DO 105 L = 1,4 CALL UPPERCASE(MODELC(K)(L:L)) 105 CONTINUE WRITE(LUT,'(A4)') MODELC(K) IF (MODELC(K).EQ.'GFSO') MODELC(K) = 'AVNO' IF (MODELC(K).EQ.'GFSI') MODELC(K) = 'AVNI' IF (MODELC(K)(4:4).EQ.' ') MODELC(K)(4:4) = '-' 106 CONTINUE C RETURN C C C Errors C ------ 9000 WRITE(LUT,'("*** FATAL ERROR: CONSENSUS FILE ERROR ***")') STOP 9010 WRITE(LUT,'("*** INVALID NUMBER OF CONSENSUS MEMBERS ***")') STOP C END C C C C ---------------------------------------------------------- SUBROUTINE GET_VCONSENSUS(LUFIC,LUT,FNAME_CONS, * NMT,MODELT,NMI,MODELI) C C Reads text file to determine what models go into average. C ---------------------------------------------------------- PARAMETER (NMDX=20) CHARACTER*60 FNAME_CONS CHARACTER*4 MODELT(NMDX), MODELI(NMDX) C C C Determine members of the consensus C ------------------------------------------- 100 OPEN(LUFIC,FILE=FNAME_CONS,STATUS='OLD',ERR=9000) READ(LUFIC,*) NMT IF (NMT.LT.1 .OR. NMT.GT.NMDX) GOTO 9010 DO 101 K = 1,NMT READ(LUFIC,'(A4)',ERR=9000) MODELT(K) 101 CONTINUE READ(LUFIC,*) NMI IF (NMI.LT.1 .OR. NMI.GT.NMDX) GOTO 9010 DO 102 K = 1,NMI READ(LUFIC,'(A4)',ERR=9000) MODELI(K) 102 CONTINUE CLOSE(LUFIC) C WRITE(LUT,'(/"Will form trk consensus of these models:")') DO 106 K = 1,NMT DO 105 L = 1,4 CALL UPPERCASE(MODELT(K)(L:L)) 105 CONTINUE WRITE(LUT,'(A4)') MODELT(K) IF (MODELT(K).EQ.'GFSO') MODELT(K) = 'AVNO' IF (MODELT(K).EQ.'GFSI') MODELT(K) = 'AVNI' IF (MODELT(K)(4:4).EQ.' ') MODELT(K)(4:4) = '-' 106 CONTINUE WRITE(LUT,'(/"Will form int consensus of these models:")') DO 116 K = 1,NMI DO 115 L = 1,4 CALL UPPERCASE(MODELI(K)(L:L)) 115 CONTINUE WRITE(LUT,'(A4)') MODELI(K) IF (MODELI(K).EQ.'GFSO') MODELI(K) = 'AVNO' IF (MODELI(K).EQ.'GFSI') MODELI(K) = 'AVNI' IF (MODELI(K)(4:4).EQ.' ') MODELI(K)(4:4) = '-' 116 CONTINUE C RETURN C C C Errors C ------ 9000 WRITE(LUT,'("*** FATAL ERROR: CONSENSUS FILE ERROR ***")') STOP 9010 WRITE(LUT,'("*** INVALID NUMBER OF CONSENSUS MEMBERS ***")') STOP C END C C C C -------------------------------------------------------------- SUBROUTINE CONSENSUS(NMC,MODELC,BAD,LU,LUT,IMON,IDAY,IHOUR, * FLAT,FLON,FWND,FCSTRX,RI_FCST,DELW_RI,DELT_RI, * VER_RIF) C C Creates consensus (average) forecast from a list of models. C -------------------------------------------------------------- C C PARAMETER (NVTX = 15, NMDX=20) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX), ITIME(NVTX) DIMENSION FLATX(NVTX,NMDX), FLONX(NVTX,NMDX), FWNDX(NVTX,NMDX) DIMENSION FRADX(NVTX,3,4,NMDX) CHARACTER*3 FCSTRX CHARACTER*4 MODELC(NMDX) LOGICAL POSOK, WNDOK LOGICAL RI_FCST(NVTX), VER_RIF DATA ITIME/ 0, 12, 24, 36, 48, * 60, 72, 84, 96, 108, * 120, 132, 144, 156, 168/ C C IHBACK = INT(DELT_RI) C C C Get individual member forecasts C ------------------------------- DO 100 L = 1,NMC CALL GET_MODEL_FCSTC7(LU,LUT,MODELC(L),IMON,IDAY,IHOUR, * FLATX(1,L),FLONX(1,L),FWNDX(1,L),FRADX(1,1,1,L),FCSTRX,0) 100 CONTINUE C C C Cycle through verification times C -------------------------------- DO 200 I = 1,NVTX SUMLAT = 0. SUMLON = 0. SUMWND = 0. POSOK = .TRUE. WNDOK = .TRUE. DO 210 L = 1,NMC IF (FLATX(I,L).EQ.BAD) POSOK = .FALSE. IF (FLONX(I,L).EQ.BAD) POSOK = .FALSE. IF (FWNDX(I,L).EQ.BAD) WNDOK = .FALSE. IF (POSOK) THEN SUMLAT = SUMLAT+FLATX(I,L) SUMLON = SUMLON+FLONX(I,L) ENDIF IF (WNDOK) THEN SUMWND = SUMWND+FWNDX(I,L) C C Check to see if RI occurred in forecast C --------------------------------------- CALL GETPREVFWS(FWNDX(1,L),I,IHBACK,FWSPRV) IF (FWSPRV.NE.BAD .AND. VER_RIF) THEN DELTA_FWS = FWNDX(I,L)-FWSPRV IF (DELTA_FWS.GE.DELW_RI .AND.DELW_RI.GT.0) THEN RI_FCST(I) = .TRUE. WRITE(LUT,'("RI found in ",a4," at ",i3.3, * " h, DELW = ", I3," kt")') MODELC(L), * ITIME(I),NINT(DELTA_FWS) ENDIF ENDIF C ENDIF 210 CONTINUE C IF (POSOK) THEN FLAT(I) = SUMLAT/FLOAT(NMC) FLON(I) = SUMLON/FLOAT(NMC) FLAT(I) = FLOAT(NINT(FLAT(I)*10.0))/10. FLON(I) = FLOAT(NINT(FLON(I)*10.0))/10. ELSE FLAT(I) = BAD FLON(I) = BAD ENDIF IF (WNDOK) THEN FWND(I) = SUMWND/FLOAT(NMC) FWND(I) = FLOAT(NINT(FWND(I))) ELSE FWND(I) = BAD ENDIF C 200 CONTINUE RETURN END C C C C --------------------------------------------------------------- SUBROUTINE CONSENSUS_VAR(NMT,MODELT,NMI,MODELI,NMMIN, * BAD,LU,LUT,IMON,IDAY,IHOUR, * FLAT,FLON,FWND,FCSTRX,RI_FCST,DELW_RI,DELT_RI, * VER_RIF) C C Creates combined consensus track and intensity forecasts from a C set of models. Will form a consensus if at least NMMIN of the C members are present. NMMIN=2 replicates TVCN, while NMMIN=1 C provides a useful skill baseline for the forecasters. C --------------------------------------------------------------- C C PARAMETER (NVTX = 15, NMDX=20) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX), ITIME(NVTX) DIMENSION FLATX(NVTX,NMDX), FLONX(NVTX,NMDX), FWNDX(NVTX,NMDX) DIMENSION FRADX(NVTX,3,4,NMDX) CHARACTER*3 FCSTRX CHARACTER*4 MODELT(NMDX), MODELI(NMDX) LOGICAL RI_FCST(NVTX), VER_RIF DATA ITIME/ 0, 12, 24, 36, 48, * 60, 72, 84, 96, 108, * 120, 132, 144, 156, 168/ C C IHBACK = INT(DELT_RI) C C C Track models C ------------ ITRK1 = 1 ITRK2 = NMT C C Intensity models C ---------------- IINT1 = ITRK2+1 IINT2 = IINT1+NMI-1 C C Get individual member track forecasts C ------------------------------------- DO 100 L = 1,NMT CALL GET_MODEL_FCSTC7(LU,LUT,MODELT(L),IMON,IDAY,IHOUR, * FLATX(1,L),FLONX(1,L),FWNDX(1,L),FRADX(1,1,1,L),FCSTRX,0) 100 CONTINUE C C Get individual member intensity forecasts C ----------------------------------------- DO 110 L = 1,NMI LL = NMT+L CALL GET_MODEL_FCSTC7(LU,LUT,MODELI(L),IMON,IDAY,IHOUR, * FLATX(1,LL),FLONX(1,LL),FWNDX(1,LL),FRADX(1,1,1,LL),FCSTRX,0) 110 CONTINUE C C C Cycle through verification times for track C ------------------------------------------ DO 200 I = 1,NVTX SUMLAT = 0. SUMLON = 0. NMOD = 0 DO 210 L = ITRK1,ITRK2 IF (FLATX(I,L).NE.BAD) THEN SUMLAT = SUMLAT+FLATX(I,L) SUMLON = SUMLON+FLONX(I,L) NMOD = NMOD+1 ENDIF 210 CONTINUE C IF (NMOD.GE.NMMIN) THEN FLAT(I) = SUMLAT/FLOAT(NMOD) FLON(I) = SUMLON/FLOAT(NMOD) FLAT(I) = FLOAT(NINT(FLAT(I)*10.0))/10. FLON(I) = FLOAT(NINT(FLON(I)*10.0))/10. ELSE FLAT(I) = BAD FLON(I) = BAD ENDIF 200 CONTINUE C C C Cycle through verification times for intensity C ---------------------------------------------- DO 220 I = 1,NVTX SUMWND = 0. NMOD = 0 DO 230 L = IINT1,IINT2 IF (FWNDX(I,L).NE.BAD) THEN SUMWND = SUMWND+FWNDX(I,L) NMOD = NMOD+1 C C Check to see if RI occurred in forecast C --------------------------------------- IF (.NOT. VER_RIF) GOTO 230 CALL GETPREVFWS(FWNDX(1,L),I,IHBACK,FWSPRV) IF (FWSPRV.NE.BAD) THEN DELTA_FWS = FWNDX(I,L)-FWSPRV IF (DELTA_FWS.GE.DELW_RI .AND.DELW_RI.GT.0) THEN RI_FCST(I) = .TRUE. WRITE(LUT,'("RI found in ",a4," at ",i3.3, * " h, DELW = ", I3," kt")') MODELI(L-NMT), * ITIME(I),NINT(DELTA_FWS) ENDIF ENDIF C ENDIF 230 CONTINUE C IF (NMOD.GE.NMMIN) THEN FWND(I) = SUMWND/FLOAT(NMOD) FWND(I) = FLOAT(NINT(FWND(I))) ELSE FWND(I) = BAD ENDIF C 220 CONTINUE RETURN END C C C C --------------------------------------------------------------- SUBROUTINE CONSENSUS_VARM1(NMT,MODELT,NMI,MODELI,NMMIN, * BAD,LU,LUT,IMON,IDAY,IHOUR, * FLAT,FLON,FWND,FCSTRX) C C Creates combined consensus track and intensity forecasts from a C set of models. Will form a consensus if at least NMMIN of the C members are present. NMMIN=2 replicates TVCN, while NMMIN=1 C provides a useful skill baseline for the forecasters. C C This version tosses out the member farthest from the mean C if far enough, and then recomputes the consensus. C C Turns out this doesn't improve things. :-( C --------------------------------------------------------------- C C PARAMETER (NVTX = 15, NMDX=20) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX) DIMENSION FLATX(NVTX,NMDX), FLONX(NVTX,NMDX), FWNDX(NVTX,NMDX) DIMENSION FRADX(NVTX,3,4,NMDX) DIMENSION POSDIFF(NVTX,NMDX) CHARACTER*3 FCSTRX CHARACTER*4 MODELT(NMDX), MODELI(NMDX) C C C Track models C ------------ ITRK1 = 1 ITRK2 = NMT C C Intensity models C ---------------- IINT1 = ITRK2+1 IINT2 = IINT1+NMI-1 C C Get individual member track forecasts C ------------------------------------- DO 100 L = 1,NMT CALL GET_MODEL_FCSTC7(LU,LUT,MODELT(L),IMON,IDAY,IHOUR, * FLATX(1,L),FLONX(1,L),FWNDX(1,L),FRADX(1,1,1,L),FCSTRX,0) 100 CONTINUE C C Get individual member intensity forecasts C ----------------------------------------- DO 110 L = 1,NMI LL = NMT+L CALL GET_MODEL_FCSTC7(LU,LUT,MODELI(L),IMON,IDAY,IHOUR, * FLATX(1,LL),FLONX(1,LL),FWNDX(1,LL),FRADX(1,1,1,LL),FCSTRX,0) 110 CONTINUE C C C Cycle through verification times for track C ------------------------------------------ DO 200 I = 1,NVTX SUMLAT = 0. SUMLON = 0. NMOD = 0 DO 210 L = ITRK1,ITRK2 IF (FLATX(I,L).NE.BAD) THEN SUMLAT = SUMLAT+FLATX(I,L) SUMLON = SUMLON+FLONX(I,L) NMOD = NMOD+1 ENDIF 210 CONTINUE C IF (NMOD.GE.NMMIN) THEN FLAT(I) = SUMLAT/FLOAT(NMOD) FLON(I) = SUMLON/FLOAT(NMOD) FLAT(I) = FLOAT(NINT(FLAT(I)*10.0))/10. FLON(I) = FLOAT(NINT(FLON(I)*10.0))/10. ELSE FLAT(I) = BAD FLON(I) = BAD ENDIF C C Determine which model is farthest from the mean, C assuming there are at least three models. If C there are two or fewer, there's nothing to toss. C ------------------------------------------------ IF (NMOD.LT.3) GOTO 200 POSMAX = 0. POSTOT = 0. DO 220 L = ITRK1,ITRK2 IF (FLATX(I,L).EQ.BAD) THEN POSDIFF(I,L) = BAD GOTO 220 ENDIF CALL LL2DB(FLAT(I),FLON(I),FLATX(I,L),FLONX(I,l), * POSDIFF(I,L),DIR0) POSTOT = POSTOT+POSDIFF(I,L) IF (POSDIFF(I,L) .GT. POSMAX) THEN POSMAX = POSDIFF(I,L) MODMAX = L ENDIF C write(1,*) i,l,posdiff(i,l),posmax 220 CONTINUE C C Now recompute the consensus without the outlier, C but only if the outlier exceeds the mean spread by C a specified amount. C -------------------------------------------------- POSAVG = POSTOT/FLOAT(NMOD) THRESHHOLD = 3.0 IF (POSAVG.LE.0.) GOTO 200 IF (POSMAX.LT.THRESHHOLD*POSAVG) GOTO 200 C SUMLAT = 0. SUMLON = 0. NMOD = 0 DO 230 L = ITRK1,ITRK2 IF (FLATX(I,L).NE.BAD .AND. L.NE.MODMAX) THEN SUMLAT = SUMLAT+FLATX(I,L) SUMLON = SUMLON+FLONX(I,L) NMOD = NMOD+1 ENDIF 230 CONTINUE C IF (NMOD.GE.NMMIN) THEN FLAT(I) = SUMLAT/FLOAT(NMOD) FLON(I) = SUMLON/FLOAT(NMOD) FLAT(I) = FLOAT(NINT(FLAT(I)*10.0))/10. FLON(I) = FLOAT(NINT(FLON(I)*10.0))/10. ELSE FLAT(I) = BAD FLON(I) = BAD ENDIF C 200 CONTINUE C C C Cycle through verification times for intensity C ---------------------------------------------- DO 300 I = 1,NVTX SUMWND = 0. NMOD = 0 DO 310 L = IINT1,IINT2 IF (FWNDX(I,L).NE.BAD) THEN SUMWND = SUMWND+FWNDX(I,L) NMOD = NMOD+1 ENDIF 310 CONTINUE C IF (NMOD.GE.NMMIN) THEN FWND(I) = SUMWND/FLOAT(NMOD) FWND(I) = FLOAT(NINT(FWND(I))) ELSE FWND(I) = BAD ENDIF C 300 CONTINUE RETURN END C C C C -------------------------------------------------------------- SUBROUTINE TOSS_FCST(LUT,BAD,MODELC,FLAT,FLON,FWND,FRAD) C C Tosses all forecast points for this model. C -------------------------------------------------------------- C PARAMETER (NVTX = 15) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX) DIMENSION FRAD(NVTX,3,4) CHARACTER*4 MODELC C DO 220 K = 1,NVTX FLAT(K) = BAD FLON(K) = BAD FWND(K) = BAD DO 235 KK = 1,3 DO 236 KKK = 1,4 FRAD(K,KK,KKK) = BAD 236 CONTINUE 235 CONTINUE 220 CONTINUE WRITE(LUT,'("Forecast tossed for model ", A4)') MODELC C RETURN END C C C -------------------------------------------------------------- SUBROUTINE LANDCHECK(LUT,BAD,MODELC,FLAT,FLON,FWND,FRAD) C C Checks to see when model track goes inland and tosses all C forecasts after that point. This check is not performed on C any CLIPER model, because we don't want to toss a model C forecast away because the track skill baseline went over land. C -------------------------------------------------------------- C C PARAMETER (NVTX = 15) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX), TIME(NVTX) DIMENSION FRAD(NVTX,3,4) CHARACTER*4 MODELC C C NVTX dependency here C -------------------- DATA TIME/0.,12.,24.,36.,48.,60.,72.,84.,96.,108.,120., * 132.,144.,156.,168./ C C IF (MODELC.EQ.'OCS5') GOTO 1000 IF (MODELC.EQ.'OCD5') GOTO 1000 IF (MODELC.EQ.'OCDT') GOTO 1000 IF (MODELC.EQ.'BCS5') GOTO 1000 IF (MODELC.EQ.'BCD5') GOTO 1000 IF (MODELC.EQ.'OCLP') GOTO 1000 IF (MODELC.EQ.'BCLP') GOTO 1000 IF (MODELC.EQ.'CLIP') GOTO 1000 IF (MODELC.EQ.'CLP5') GOTO 1000 IF (MODELC.EQ.'BCLA') GOTO 1000 IF (MODELC.EQ.'TCLP') GOTO 1000 IHR = 0 C 100 IHR = IHR+1 IF (IHR.GT.NINT(TIME(NVTX))) GOTO 1000 HOUR = FLOAT(IHR) CALL POLATE(NVTX,TIME,FLAT,HOUR,XLAT,M,BAD) CALL POLATE(NVTX,TIME,FLON,HOUR,XLON,M,BAD) IF (XLAT.EQ.BAD .OR. XLON.EQ.BAD) GOTO 100 CALL ALAND(XLON,XLAT,DLAND) IF (DLAND.LT.0.) GOTO 200 GOTO 100 C C Land encountered, delete all forecasts here on out C -------------------------------------------------- 200 CONTINUE WRITE(LUT,'("LAND ENCOUNTERED IN ",A4, " AT HOUR = ",I3, * 3F10.1)') MODELC,IHR,XLAT,XLON,DLAND DO 220 L = 2,NVTX IF (IHR.LE.TIME(L)) THEN DO 230 K = L,NVTX FLAT(K) = BAD FLON(K) = BAD FWND(K) = BAD DO 235 KK = 1,3 DO 236 KKK = 1,4 FRAD(K,KK,KKK) = BAD 236 CONTINUE 235 CONTINUE 230 CONTINUE GOTO 1000 ENDIF 220 CONTINUE C C 1000 RETURN END C C C -------------------------------------------------------------- SUBROUTINE LANDCHECK_CLOSE(LUT,BAD,MODELC,FLAT,FLON,FWND,FRAD, * FCSTNEARLAND,DIST_LAND) C C Checks to see which model track points are within C DIST_LAND n mi of the coast. This check is not performed on C any CLIPER model, because we don't want to toss a model C forecast away because the track skill baseline went over land. C -------------------------------------------------------------- C C PARAMETER (NVTX = 15) DIMENSION FLAT(NVTX), FLON(NVTX), FWND(NVTX), TIME(NVTX) DIMENSION FRAD(NVTX,3,4) CHARACTER*1 FCSTNEARLAND CHARACTER*4 MODELC LOGICAL TOSS C C NVTX dependency here C -------------------- DATA TIME/0.,12.,24.,36.,48.,60.,72.,84.,96.,108.,120., * 132.,144.,156.,168./ C C IF (MODELC.EQ.'OCS5') GOTO 1000 IF (MODELC.EQ.'OCD5') GOTO 1000 IF (MODELC.EQ.'OCDT') GOTO 1000 IF (MODELC.EQ.'BCS5') GOTO 1000 IF (MODELC.EQ.'BCD5') GOTO 1000 IF (MODELC.EQ.'OCLP') GOTO 1000 IF (MODELC.EQ.'BCLP') GOTO 1000 IF (MODELC.EQ.'CLIP') GOTO 1000 IF (MODELC.EQ.'CLP5') GOTO 1000 IF (MODELC.EQ.'BCLA') GOTO 1000 IF (MODELC.EQ.'TCLP') GOTO 1000 C C C Check to see how close each point is to nearest land C ---------------------------------------------------- 200 CONTINUE DO 220 K = 1,NVTX IF (FLON(K).EQ.BAD .OR. FLAT(K).EQ.BAD) GOTO 220 CALL ALAND(FLON(K),FLAT(K),DLAND) DLAND_NM = DLAND*60.0/111.1 TOSS = .FALSE. IF (FCSTNEARLAND.EQ.'F' .AND. DLAND_NM.LT.DIST_LAND) THEN TOSS = .TRUE. WRITE(LUT,'(A4," FCST TOO CLOSE TO LAND AT HR = ",I3)') * MODELC,NINT(TIME(K)) ENDIF IF (FCSTNEARLAND.EQ.'N' .AND. DLAND_NM.GE.DIST_LAND) THEN TOSS = .TRUE. WRITE(LUT,'(A4," FCST TOO FAR FROM LAND AT HR = ",I3)') * MODELC,NINT(TIME(K)) ENDIF IF (TOSS) THEN FLAT(K) = BAD FLON(K) = BAD FWND(K) = BAD DO 235 KK = 1,3 DO 236 KKK = 1,4 FRAD(K,KK,KKK) = BAD 236 CONTINUE 235 CONTINUE ENDIF 220 CONTINUE C C 1000 RETURN END C C C ----------------------------------------------------------- SUBROUTINE LANDCHECK_BT(BTIME,BLAT,BLON,L,LUT,BAD, * VTIME,VLAT,VLON,VWS,VRAD) C C Checks to see if the portion of the best track between the C forecast time and the verifying time crossed land. If it C did, throws out the BT verifying data. C ----------------------------------------------------------- C PARAMETER (NBTX = 200) DIMENSION BTIME(NBTX), BLAT(NBTX), BLON(NBTX), BWS(NBTX) DIMENSION BRAD(NBTX,3,4), VRAD(3,4) C C IHR = BTIME(L) C 100 IHR = IHR+1 IF (IHR.GT.VTIME) GOTO 1000 HOUR = FLOAT(IHR) CALL POLATE(NBTX,BTIME,BLAT,HOUR,XLAT,M,BAD) CALL POLATE(NBTX,BTIME,BLON,HOUR,XLON,M,BAD) CALL ALAND(XLON,XLAT,DLAND) IF (DLAND.LT.0.) GOTO 200 GOTO 100 C C C Land encountered, delete verification data C -------------------------------------------------- 200 CONTINUE WRITE(LUT,'("LAND ENCOUNTERED IN BT AT HOUR = ",I3,3F10.1)') * IHR-NINT(BTIME(L)),XLAT,XLON,DLAND VLAT = BAD VLON = BAD VWS = BAD DO 221 M=1,3 DO 220 N=1,4 VRAD(M,N) = BAD 220 CONTINUE 221 CONTINUE C C 1000 RETURN END C C C C ------------------------------------------------------------- SUBROUTINE LANDCHECK_WINDOW(BTIME,BLAT,BLON,L,LUT,BAD, * NWINDOW,VTIME,VLAT,VLON,VWS,VRAD) C C Checks to see if the verification time is prior to AND within C NWINDOW hours of landfall. Tosses all verifying data C if this condition is not met, i.e., we are only looking at C times close to landfall. C ------------------------------------------------------------- C PARAMETER (NBTX = 200) DIMENSION BTIME(NBTX), BLAT(NBTX), BLON(NBTX), BWS(NBTX) DIMENSION BRAD(NBTX,3,4), VRAD(3,4) C C C Search from verifying time out another NWINDOW hours to see C if landfall occurred during this interval. C ----------------------------------------------------------- C IHR = VTIME NVTHR = VTIME-BTIME(L) C 100 IHR = IHR+1 IF (IHR-NINT(VTIME).GT.NWINDOW) GOTO 1000 HOUR = FLOAT(IHR) CALL POLATE(NBTX,BTIME,BLAT,HOUR,XLAT,M,BAD) CALL POLATE(NBTX,BTIME,BLON,HOUR,XLON,M,BAD) CALL ALAND(XLON,XLAT,DLAND) IF (DLAND.LT.0.) GOTO 200 GOTO 100 C C C Land encountered within NWINDOW hours of verifying time, C so we keep verification data C ------------------------------------------------------------- 200 CONTINUE WRITE(LUT,'("LAND ENCOUNTERED WITHIN ",I3, * " HR AFTER VT=",I3," AT HOUR = ", I3)') * NWINDOW,NVTHR,IHR-NINT(BTIME(L)) RETURN C C C No landfall found within NWINDOW hours of verifying time, C so we toss the verification data C -------------------------------------------------------------- 1000 VLAT = BAD VLON = BAD VWS = BAD DO 1221 M=1,3 DO 1220 N=1,4 VRAD(M,N) = BAD 1220 CONTINUE 1221 CONTINUE RETURN C C END C C C C C --------------------------------------------------------------------------- SUBROUTINE SERIAL_CORR(NT,AERAVG,CERAVG,ACE,CCE,TIND_AT,TIND_CT) C C Evalulates effective forecast separation time using the procedure of C Siegel, by comparing the number of runs above and below the mean error C to an expected value. C C It is assumed that all the forecast errors come from forecasts issued C 6 hours apart, and that they have already been screened for missing data. C C NT = number of forecasts for a storm C AERAVG = storm mean along-track error (signed) C CERAVG = storm mean cross-track error (signed) C ACE = array of storm along-track errors C CCE = array of storm cross-track errors C C TIND_AT = returned value of along-track time between independent forecasts C TIND_CT = returned value of cross-track time between independent forecasts C --------------------------------------------------------------------------- C PARAMETER (NBTX = 200) DIMENSION ACE(NBTX), CCE(NBTX) LOGICAL PREV_AT_ABOVE, CURR_AT_ABOVE LOGICAL PREV_CT_ABOVE, CURR_CT_ABOVE C C C Calculate number of forecasts above and below the mean errors, C and the number of runs. C -------------------------------------------------------------- TIND_AT = -999. TIND_CT = -999. NA_AT = 0 NA_CT = 0 NB_AT = 0 NB_CT = 0 NRUNA_AT = 0 NRUNA_CT = 0 NRUNB_AT = 0 NRUNB_CT = 0 PREV_AT_ABOVE = .FALSE. PREV_CT_ABOVE = .FALSE. c DO 100 I=1,NT IF (ACE(I).GE.AERAVG) THEN NA_AT = NA_AT+1 CURR_AT_ABOVE = .TRUE. ENDIF IF (ACE(I).LT.AERAVG) THEN NB_AT = NB_AT+1 CURR_AT_ABOVE = .FALSE. ENDIF IF (CCE(I).GE.CERAVG) THEN NA_CT = NA_CT+1 CURR_CT_ABOVE = .TRUE. ENDIF IF (CCE(I).LT.CERAVG) THEN NB_CT = NB_CT+1 CURR_CT_ABOVE = .FALSE. ENDIF C IF (I.EQ.1) THEN IF (CURR_AT_ABOVE) THEN NRUNA_AT = NRUNA_AT+1 ELSE NRUNB_AT = NRUNB_AT+1 ENDIF IF (CURR_CT_ABOVE) THEN NRUNA_CT = NRUNA_CT+1 ELSE NRUNB_CT = NRUNB_CT+1 ENDIF ENDIF C IF (I.GT.1) THEN IF (CURR_AT_ABOVE .AND. .NOT.PREV_AT_ABOVE) * NRUNA_AT = NRUNA_AT+1 IF (.NOT.CURR_AT_ABOVE .AND. PREV_AT_ABOVE) * NRUNB_AT = NRUNB_AT+1 IF (CURR_CT_ABOVE .AND. .NOT.PREV_CT_ABOVE) * NRUNA_CT = NRUNA_CT+1 IF (.NOT.CURR_CT_ABOVE .AND. PREV_CT_ABOVE) * NRUNB_CT = NRUNB_CT+1 ENDIF C PREV_AT_ABOVE = CURR_AT_ABOVE PREV_CT_ABOVE = CURR_CT_ABOVE 100 CONTINUE C C C Calculate expected number of runs. C ---------------------------------- EXP_RUNS_AT = 1.0 + 2.0*FLOAT(NA_AT*NB_AT)/FLOAT(NA_AT+NB_AT) EXP_RUNS_CT = 1.0 + 2.0*FLOAT(NA_CT*NB_CT)/FLOAT(NA_CT+NB_CT) C C C Calculate effective sample size, time to independence C ----------------------------------------------------- EFF_AT = FLOAT(NT*(NRUNA_AT+NRUNB_AT))/EXP_RUNS_AT EFF_CT = FLOAT(NT*(NRUNA_CT+NRUNB_CT))/EXP_RUNS_CT TIND_AT = 6.*FLOAT(NT)/EFF_AT TIND_CT = 6.*FLOAT(NT)/EFF_CT C RETURN END C C C C C -------------------------------------------------------------- SUBROUTINE GETPREVFWS(FWND,K,IHBACK,FWSPRV) C C Gets forecast wind speed IHBACK hours ago C -------------------------------------------------------------- C C PARAMETER (NVTX = 15) DIMENSION FWND(NVTX), ITIME(NVTX) C C Needs updating for 12-h VTs C --------------------------- DATA ITIME/0,12,24,36,48,60,72,84,96,108,120,132,144,156,168/ C C FWSPRV = -999. IHRCUR = ITIME(K) IHRPRV = IHRCUR-IHBACK DO 100 L=1,NVTX IF (ITIME(L).EQ.IHRPRV) GOTO 200 100 CONTINUE C C No match C -------- RETURN C 200 FWSPRV = FWND(L) RETURN END