* This file contains the following subroutines, related to reading * lamp spectral irradiances: * rdlamp * adapted from rdetfl.f by Julia Lee-Taylor, NCAR-ACD, 22 May 2014. *=============================================================================* SUBROUTINE rdlamp(nw,wl,f) *-----------------------------------------------------------------------------* *= PURPOSE: =* *= Read and re-grid extra-terrestrial flux data. =* *-----------------------------------------------------------------------------* *= PARAMETERS: =* *= NW - INTEGER, number of specified intervals + 1 in working (I)=* *= wavelength grid =* *= WL - REAL, vector of lower limits of wavelength intervals in (I)=* *= working wavelength grid =* *= F - REAL, spectral irradiance at the top of the atmosphere at (O)=* *= each specified wavelength =* *-----------------------------------------------------------------------------* IMPLICIT NONE INCLUDE 'params' integer kdata parameter(kdata=20000) * input: (wavelength grid) INTEGER nw REAL wl(kw), wc INTEGER iw * output: (extra terrestrial solar flux) REAL f(kw) * INTERNAL: * work arrays for input data files: CHARACTER*50 fil REAL x1(kdata) REAL y1(kdata) INTEGER nhead, n, i, ierr REAL dum * data gridded onto wl(kw) grid: REAL yg1(kw) REAL yg2(kw) REAL yg3(kw) REAL hc PARAMETER(hc = 6.62E-34 * 2.998E8) INTEGER ilamp REAL factor ! ACCEPTABLE OPTIONS FOR "UNITS" ARE: ! units = "W m-2" ! units = "mW m-2" ! units = "quanta cm-2 s-1" ! NB: "units" IS CASE-SENSITIVE CHARACTER*20 units *_______________________________________________________________________ * select desired lamp irradiance, using ilamp: * 1 = UVLamp_CMUchamber.dat * 200-800 nm, ~0.245 nm steps. * factor specified to yield jNO2 = 3.0e-3 * 2 = UVLamp_CaltechChamber.dat * 300-850 nm, 1 nm steps. * 3 = lamp_CU_PAM.dat, mW m-2 * 184.8 - 579.1nm, irregular intervals, peaks only * 4 = lamp_CU-OFR_185H.dat, mW m-2 * 184.8 - 579.1nm, HIGH intensity * 5 = lamp_CU-OFR_185M.dat, mW m-2 * 184.8 - 579.1nm, MEDIUM intensity * 6 = lamp_CU-OFR_185L.dat, mW m-2 * 184.8 - 579.1nm, LOW intensity * 7 = lamp_CU-OFR_254H.dat, mW m-2 * 265.6 - 579.1nm, HIGH intensity * 8 = lamp_CU-OFR_254M.dat, mW m-2 * 253.6 - 579.1nm, MEDIUM intensity * 9 = lamp_CU-OFR_254L.dat, mW m-2 * 253.6 - 579.1nm, LOW intensity * 10 = caltech, quanta cm-2 s-1 * 11 = ncar cafs 2014, quanta cm-2 s-1 * 12 = ncar cafs 2016, quanta cm-2 s-1 * 13 = CU chamber Sept 5, 2018, quanta cm-2 nm-1 s-1 ! (Note that this SUPERSEDES CU version of 180504) * 14 = Georgia tech chamber, April 20, 2020, mW m-2, average intensity * (UV and VIS both available: this code currently uses UV only) * 15 = CU OFR_185M + CU chamber lamps x2, 2020-05-20, mW.m-2.nm * *_______________________________________________________________________ ilamp = 15 !ilamp = 2 1 IF(ilamp.EQ.1) THEN fil = 'DATALAMP/UVlamp_CMUchamber.dat' nhead = 4 n =2448 units = "W m-2" factor = 1.0 2 ELSEIF(ilamp.EQ.2) THEN fil = 'DATALAMP/UVlamp_CaltechChamber.dat' nhead = 4 n = 551 units = "W m-2" factor = 1.02 3 ELSEIF(ilamp.EQ.3) THEN fil = 'DATALAMP/lamp_CU_PAM.dat' nhead = 3 n = 42 units = "mW m-2" factor = 1.0 4 ELSEIF(ilamp.EQ.4) THEN fil = 'DATALAMP/lamp_CU-OFR_185H.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 5 ELSEIF(ilamp.EQ.5) THEN fil = 'DATALAMP/lamp_CU-OFR_185M.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 6 ELSEIF(ilamp.EQ.6) THEN fil = 'DATALAMP/lamp_CU-OFR_185L.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 7 ELSEIF(ilamp.EQ.7) THEN fil = 'DATALAMP/lamp_CU-OFR_254H.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 8 ELSEIF(ilamp.EQ.8) THEN fil = 'DATALAMP/lamp_CU-OFR_254M.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 9 ELSEIF(ilamp.EQ.9) THEN fil = 'DATALAMP/lamp_CU-OFR_254L.dat' nhead = 4 n = 41 units = "mW m-2" factor = 1.0 10 ELSEIF(ilamp.EQ.10) THEN fil = 'DATALAMP/caltech.dat' nhead = 2 n = 551 units = "quanta cm-2 s-1" factor = 1. 11 ELSEIF(ilamp.EQ.11) THEN fil = 'DATALAMP/ncar_cafs2014.dat' nhead = 2 n = 311 units = "quanta cm-2 s-1" factor = 1. 12 ELSEIF(ilamp.EQ.12) THEN fil = 'DATALAMP/ncar_cafs2016.dat' nhead = 2 n = 402 units = "quanta cm-2 s-1" factor = 1. 13 ELSEIF(ilamp.EQ.13) THEN fil = 'DATALAMP/CU_chamber_180905.dat' nhead = 3 n = 6201 units = "quanta cm-2 s-1" factor = 1. 14 ELSEIF(ilamp.EQ.14) THEN fil = 'DATALAMP/lamp_GeorgiaTech.dat' nhead = 3 n = 551 units = "W m-2" factor = 1. 15 ELSEIF(ilamp.EQ.15) THEN fil = 'DATALAMP/lamp_CU-OFR_185M_CU-chamber_x2.dat' nhead = 3 n = 1578 units = "mW m-2" factor = 1.0 ENDIF PRINT*,"!! CALCULATION USES LAMP SPECTRUM ",fil PRINT*,"!! IF YOU WANT SOLAR SPECTRUM, " PRINT*," ACTIVATE SUBROUTINE rdetfl IN TUV.f !!" ! --- * simple files are read and interpolated here in-line. Reading of * more complex files may be done with longer code in a read#.f subroutine. write(kout,*) fil write(90,'(a41)') '/'//fil OPEN(UNIT=kin,FILE=fil,STATUS='old') DO i = 1, nhead READ(kin,*) ENDDO DO i = 1, n IF(ilamp.EQ.10) then ! read columns 1 and 3 READ(kin,*) x1(i), dum, y1(i) else ! read columns 1 and 2 READ(kin,*) x1(i), y1(i) endif ENDDO CLOSE (kin) CALL addpnt(x1,y1,kdata,n,x1(1)*(1.-deltax),0.) CALL addpnt(x1,y1,kdata,n, 0.,0.) CALL addpnt(x1,y1,kdata,n,x1(n)*(1.+deltax),0.) CALL addpnt(x1,y1,kdata,n, 1.e+38,0.) CALL inter2(nw,wl,yg1,n,x1,y1,ierr) IF (ierr .NE. 0) THEN WRITE(*,*) ierr, fil STOP ENDIF ! assign and convert units as needed: ! new caltech and ncar cafs units are already in quanta cm-2 s-1, ! so must convert to W m-2 to use consistently DO iw = 1, nw-1 wc = 0.5*(wl(iw) + wl(iw+1)) f(iw) = max(0.,yg1(iw) * factor) IF (units(1:1).EQ."W") THEN f(iw) = f(iw) ELSEIF (units(1:2).EQ."mW") THEN f(iw) = f(iw)/1.0e3 ELSEIF (units(1:1).EQ."q") THEN f(iw) = 1.e4*f(iw) * hc / (wc * 1.e-9) ELSE print*,"CHECK units string in rdlamp.f" STOP ENDIF ENDDO PRINT*,"using lamp data: ",fil !DEBUG ! DO i=nw,1,-1 ! PRINT*,wl(i),f(i) ! ENDDO RETURN END *=============================================================================*