C******************************************************************** program uvlist C******************************************************************** C$$$ PROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: uvlist generate city list bulletin C PRGMMR: Hai-Tien Lee ORG: W/NMC53 DATE: 94-04-29 C C ABSTRACT: Generate the UV forecast City list bulletin C C PROGRAM HISTORY LOG: C 94-04-29 Hai-Tien Lee C 94-05-24 HTLEE Bulletin Header and number of digit modified C 94-05-25 HTLEE Apply MOS cloud modification to clear-sky UVI C 05-08-26 CS Long Altered subroutine to be program, took out C cards computing UVI, replaced mos parms with C UV trans, Aero, and Snow Albedo values in C validation output C C USAGE: CALL uvlist C INPUT FILES: (DELETE IF NO INPUT FILES IN SUBPROGRAM) C 10 - clear sky erythemal values C 11 - cloudy sky erythemal values C 12 - UV transmissivity C 13 - Solar Zenith Angles C 14 - Aerosol ratio C 15 - Total Ozone C 31 - city list for the interested cities/stations C 32 - city list for the additional cities/stations C C OUTPUT FILES: (DELETE IF NO OUTPUT FILES IN SUBPROGRAM) C 61 - City list bulletin C 62 - verification data C C ATTRIBUTES: C LANGUAGE: FORTRAN77 C MACHINE: WCOSS C C 12-04-2012 change: changed open statements to use symbolic linked C file names C took out open/close statements, C put back unit number in script C corrected STI/STJ computation given Citylist values C C 02-12-2020 Added additional cites to bulletin C 01-24-2022 Hai-Tien Lee C Change City list index calculation for 0.25 grid (was for 0.5) C 08-09-2023 Hai-Tien Lee C "IO" was undefined. Remove IF test block; Always read Ozone. C C********************************************************************* C$$$ parameter(nx=1440,ny=721,nxy=nx*ny) parameter(mxcity=900) C character*20 city character*2 state, country character*26 station character*3 callid, stnx character*40 buffer(mxcity),head, abuffer(mxcity) character*50 title character*80 prefix(30) character*2 Blank character*20 AdCity C real uv(nx,ny), huv, uvc(nx,ny), huvc, uvt(nx,ny), huvt, > sza(nx,ny), hsza, aero(nx,ny), haero, ozone(nx,ny), hoz C integer tomorrow integer indx(mxcity) integer afos C C common /uvdata/ozone,uv,a0,a1,a2,idate C--------------------------------------------------------------------- head='CITY STATE UVI' Blank=' ' AdCity='ADDITIONAL LOCATIONS' C C...read erythemal UV values C read(10,900) idate, icyc, ifhr read(10,901) uvc C read(11,900) idate, icyc, ifhr read(11,901) uv C read(12,900) idate, icyc, ifhr read(12,901) uvt C read(13,900) idate, icyc, ifhr read(13,901) sza C read(14,900) idate, icyc, ifhr read(14,901) aero C C 20230829 Hai-Tien Lee C "IO" was undefined. Remove IF test block; Always read Ozone. read(15,900) idate, icyc, ifhr read(15,901) ozone C C...flip uv field...GRID (1,1) FROM 0E,90N TO 0E,90S C CALL FLIP_FIELD(UVC) CALL FLIP_FIELD(UV) CALL FLIP_FIELD(UVT) CALL FLIP_FIELD(sza) CALL FLIP_FIELD(aero) CALL FLIP_FIELD(ozone) C C...W3FT01 parameters NCYCLK=1 LIN=1 i=1 C read(5,*) tomorrow C C...read bulletin header loop C 20 continue read(5,902,end=22) prefix(i) i=i+1 goto 20 22 continue nprefix=i-1 C C...write valid date to validation file C write(62,903) tomorrow C C...read mos citylist loop C ncity=0 10 continue read(31,904,end=99) city,state,country,sti,stj,itopo,callid,afos C C...interpolate clear and cloudy UVI, SZA, Ozone grid to city location C C....LOCATION ON UV_CITYLIST IS OFF...ACTUAL LOCATION SHOULD BE: C....REAL LAT= LAT+1, REAL LON=LON-1 C....OR LAT-91, 361-LON c C...GRID (1,1) IS NOW 0E,90S, C for 1x1 360x181 c G=1+LON 1E=GRID 2, 180E=GRID 181, 359E=GRID 360 C G=1+(LAT+90) -89=GRID 2, EQ =GRID 91, 90N=GRID 181 C C for 0.5x0.5 720x361 C G=1+2*LON 1E=GRID 3, 180E=GRID 361, 359E=GRID 719 C G=1+2*(LAT+90) -89=GRID 3, EQ =GRID 181, 90N=GRID 361 C C for 0.25x0.25 1440x721 C G=1+4*LON 1E=GRID 5, 180E=GRID 721, 359E=GRID 1437 c G=1+4*(LAT+90) -89=GRID 5, EQ =GRID 361, 90N=GRID 721 C RLON = STI-1.0 RLAT = STJ-1.0 C for 0.5 grid C STJ = 1.0 + 2.0*RLAT C STI = 1.0 + 2.0*RLON C 20220124: for 0.25 grid STJ = 1.0 + 4.0*RLAT STI = 1.0 + 4.0*RLON C...1-361, 90S-90N call W3FT01(STI,STJ,uvc,huvc,nx,ny,NCYCLK,LIN) call W3FT01(STI,STJ,uv,huv,nx,ny,NCYCLK,LIN) call W3FT01(STI,STJ,uvt,huvt,nx,ny,NCYCLK,LIN) call W3FT01(STI,STJ,sza,hsza,nx,ny,NCYCLK,LIN) call W3FT01(STI,STJ,aero,haero,nx,ny,NCYCLK,LIN) call W3FT01(STI,STJ,ozone,hoz,nx,ny,NCYCLK,LIN) C if (huvc .lt. -10.0) huvc = -1.00 if (huv .lt. -10.0) huv = -1.00 if (huvt .lt. -10.0) huvt = -1.00 if (hsza .lt. -10.0) hsza = -1.00 if (haero .lt. -10.0) haero = -1.00 if (hoz .lt. -10.0) hoz = -1.00 C if (huvc .gt. 0.0) huvc = huvc/25.0 if (huv .gt. 0.0) huv = huv/25.0 station=city//' '//state c...Compose the bulletin C...only write stations to AFOS Bulletin if afos=1 c...also round the UV Index if (afos .eq. 1) then ncity=ncity+1 write(buffer(ncity),910) station,int(huv+0.5) endif C C...Write out data to validation file C fill = -1.0 write(62,912) callid,huvc,huv,huvt,hsza,haero,hoz goto 10 C 99 continue write(6,*) 'UVLIST : NCITY=',ncity do i=1,nprefix write(61,920) prefix(i) enddo write(61,921) head,head ncol2=ncity/2+mod(ncity,2) c C...sort bulletin by cities (58) c call indexx(ncity,buffer,indx) c do i=1,ncity/2 write(6,921) buffer(indx(i)),buffer(indx(ncol2+i)) write(61,921) buffer(indx(i)),buffer(indx(ncol2+i)) enddo if (mod(ncity,2) .eq. 1) then write(6,921) buffer(indx(ncol2)) write(61,921) buffer(indx(ncol2)) endif C ========================================================== C Adding additional cities is on hold for UVI v2.0 upgrade C Code section is reserved for future upgrade use. C ========================================================== CCC CCC...add additional cities sorted by state CCC CC na = 0 CC 30 read(32,913,end=98) city, state, sti, stj CCC CC na = na + 1 CCC CC RLON = STI-1.0 CC RLAT = STJ-1.0 CCC for 0.5 grid CCC STJ = 1.0 + 2.0*RLAT CCC STI = 1.0 + 2.0*RLON CCC 20220124: for 0.25 grid CC STJ = 1.0 + 4.0*RLAT CC STI = 1.0 + 4.0*RLON CC CCC...1-361, 90S-90N CC call W3FT01(STI,STJ,uv,huv,nx,ny,NCYCLK,LIN) CCC CC if (huv .lt. -10.0) huv = -1.00 CCC CC if (huv .gt. 0.0) huv = huv/25.0 CC CC station=city//' '//state CC write(abuffer(na),910) station,int(huv+0.5) CC CC goto 30 CC CCc...Add more cities to the bulletin CC CC 98 continue CC CC write(6,*) 'UVLIST : NCITY=',na CC write(61,922) Blank CC write(61,923) AdCity CC write(61,922) Blank CC write(61,921) head, head CC ncol2=na/2+mod(na,2) CCc CC do i=1,na/2 CC write(6,921) abuffer(i), abuffer(ncol2+i) CC write(61,921) abuffer(i), abuffer(ncol2+i) CC enddo CC if (mod(na,2) .eq. 1) then CC write(6,921) abuffer(ncol2) CC write(61,921) abuffer(ncol2) CC endif CCc C ========================================================== 900 format(I8,1x,I2,1x,I3) 901 format(10f8.2) 902 format(a80) 903 format(i8.8) 904 format(a20,1x,a2,1x,a2,1x,2(f6.2,1x),i4,1x,a3,1x,i1) 905 format(1x,'*** Ozone Field Not Available ***') 910 format(a26,1x,i2) 912 format(1x,a3,1x,2(f5.2,1x),3(f5.1,1x),f5.1) 913 format(a20,1x,a2,1x,f6.2,1x,f6.2) 920 format(a65) 921 format(a32,4x,a29) 922 format(a2) 923 format(a20) C STOP END