!$Id: linoz_mod.f,v 1.6 2012/07/13 20:09:14 nicolas Exp $ !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !MODULE: linoz_mod ! !###################################################################### ! !!! THIS CODE IS BASED ON LINOZ_MOD.F OF V9 FORWARD (hml, adj32_025) !!! !###################################################################### ! ! !DESCRIPTION: Module LINOZ\_MOD contains routines to perform the Linoz ! stratospheric ozone chemistry. !\\ !\\ ! !INTERFACE: ! MODULE LINOZ_MOD ! ! !USES: ! IMPLICIT NONE PRIVATE ! ! !DEFINED PARAMETERS: ! INTEGER, PARAMETER :: NFIELDS_LINOZ = 7 ! # of Linoz fields INTEGER, PARAMETER :: NLEVELS_LINOZ = 25 ! # of levels in Linoz fields INTEGER, PARAMETER :: NLAT_LINOZ = 18 ! # latitudes in Linoz fields INTEGER, PARAMETER :: NMONTHS_LINOZ = 12 ! # of months in Linoz fields ! ! !PRIVATE DATA MEMBERS: ! REAL*8, ALLOCATABLE :: TPARM(:,:,:,:) REAL*8, ALLOCATABLE :: TLSTT(:,:,:) ! ! !PUBLIC MEMBER FUNCTIONS: ! PUBLIC :: CLEANUP_LINOZ PUBLIC :: DO_LINOZ PUBLIC :: LINOZ_READ ! ! !PRIVATE MEMBER FUNCTIONS: ! PRIVATE :: INIT_LINOZ PRIVATE :: LINOZ_CHEM3 PRIVATE :: LINOZ_STRATL PRIVATE :: LINOZ_STRT2M PRIVATE :: LINOZ_SOMLFQ PRIVATE :: LINOZ_INTPL PRIVATE :: STRAT_INIT ! ! !REMARKS: ! Dylan Jones (dbj@atmosp.physics.utoronto.ca) wrote: ! . ! Testing this code [in v8-02-04] was more difficult that I thought. ! I began by trying to compare the output of v8-02-04 with our previous ! runs with v8-02-01. I accounted for the changes in the transport_mod.f ! and I tried to undo the changes in when the diagnostics are archived in ! v8-02-04, but I was still getting large differences between v8-02-04 ! and v8-02-01. I finally gave up on this since I may have made a mistake ! in reverting to the old way of doing the diagnostics in v8-02-04. In ! the end I took the new linoz code from v8-02-04 and used it in v8-02-01. ! I ran two GEOS-5 full chemistry simulations for 2007 and the output ! were consistent over the full year. ! . ! I think that it is safe to release [Linoz in v8-02-04]. However, we ! should acknowledge that it was [only] tested in v8-02-01, since I was ! not able to assess the quality of the output in v8-02-04. ! ! REVISION HISTORY: ! 23 Mar 2000 - P. Cameron-Smith - Initial version adapted heavily ! from McLinden's original file. ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem ! 28 May 2009 - D. Jones - Further modifications ! 18 Nov 2009 - D. Jones - Further modifications !EOP !------------------------------------------------------------------------------ !BOC CONTAINS !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: do_linoz ! ! !DESCRIPTION: Subroutine DO\_LINOZ is the main driver for the Linoz ! stratospheric Ozone chemistry package. !\\ !\\ ! !INTERFACE: ! SUBROUTINE DO_LINOZ ! ! !USES: ! USE TIME_MOD USE LOGICAL_ADJ_MOD, ONLY : LADJ USE LOGICAL_ADJ_MOD, ONLY : LADJ_STRAT # include "CMN_SIZE" ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. INTEGER, SAVE :: LASTMONTH = -99 REAL*8 :: NSCHEM ! if new month, get new parameters? IF ( GET_MONTH() /= LASTMONTH ) THEN CALL LINOZ_STRATL LASTMONTH = GET_MONTH() ENDIF ! Linoz needs time step in seconds NSCHEM = GET_TS_CHEM() * 60D0 ! Call the Linoz chemistry IF ( LADJ .and. LADJ_STRAT ) THEN CALL LINOZ_CHEM3_FORADJ( NSCHEM ) ELSE CALL LINOZ_CHEM3( NSCHEM ) ENDIF END SUBROUTINE DO_LINOZ !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_chem3 ! ! !DESCRIPTION: Subroutine LINOZ\_CHEM3 applies linearized chemistry based on ! tables from PRATMO model using climatological T, O3, time of year !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_CHEM3( DTCHEM ) ! ! !USES: ! USE DAO_MOD USE GRID_MOD, ONLY : GET_AREA_CM2 USE TRACER_MOD USE TRACERID_MOD USE TROPOPAUSE_MOD, ONLY : GET_TPAUSE_LEVEL USE TROPOPAUSE_MOD, ONLY : GET_MAX_TPAUSE_LEVEL USE PRESSURE_MOD, ONLY : GET_PEDGE USE PRESSURE_MOD, ONLY : GET_PCENTER ! hml: add for adjoint USE TIME_MOD, ONLY : GET_NHMS USE TIME_MOD, ONLY : GET_NYMD USE TIME_MOD, ONLY : GET_TAU USE CHECKPOINT_MOD, ONLY : MAKE_UPBDFLX_CHKFILE USE ADJ_ARRAYS_MOD, ONLY : PROD_SF, LOSS_SF USE LOGICAL_ADJ_MOD,ONLY : LADJ_STRAT USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD, DO_CHK_FILE # include "CMN_SIZE" # include "CMN" ! ! !INPUT PARAMETERS: ! REAL*8, INTENT(IN) :: DTCHEM ! Time step [seconds] ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem ! 18 Nov 2009 - D. Jones - For now, set tagged stratospheric ! tracer to total O3 in the overworld ! to avoid issues with spin ups ! 08 Feb 2010 - R. Yantosca - Deleted obsolete local variables ! 22 Oct 2010 - R. Yantosca - Added OMP parallel loop !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! ! Scalars INTEGER :: IMX, JM, LM INTEGER :: I, J, L, N INTEGER :: LBOT, L_OVERWRLD INTEGER :: NTRACER, NUM_TRACER, LPOS, ITRC REAL*8 :: CLIMO3, CLIMPML, DCO3, DERO3, DERTMP REAL*8 :: DERCO3, DMASS, DTMP, SSO3 INTEGER :: NHMS INTEGER :: NYMD REAL*8 :: TAU ! Arrays REAL*8 :: DCOLO3(IIPAR,JJPAR,LLPAR) REAL*8 :: COLO3(IIPAR,JJPAR,LLPAR) REAL*8 :: OUT_DATA(IIPAR,JJPAR,LLPAR) ! Assign values for local IM and JM (dbj 6/24/03) IMX = IIPAR JM = JJPAR LM = LLPAR L_OVERWRLD = GET_MAX_TPAUSE_LEVEL() ! Stratospheric Chemistry Tables for O3: ! ====================================== ! 7 tables, each a function of month (12), latitude ! (18, -85 to 85 in 10 deg. increments) and altitude ! (25, z*=10-58 km in 2 km increments). ! 1- ozone (Logan climatology), v/v ! 2- Temperature climatology, K ! 3- Column ozone climatology, Logan ozone integrated above box, DU ! 4- ozone (P-L) for climatological ozone, v/v/s ! 5- d(P-L) / dO3, 1/s ! 6- d(P-L) / dT, v/v/s/K ! 7- d(P-L) / d(column O3), v/v/s/DU ! ! zero storage arrays ! do n=1,ntrace ! sttold(n)=0.d0 ! enddo !================================================================= ! Select the proper tracer number to store O3 into, depending on ! whether this is a full chemistry run or a tagged Ox run. ! If tagged Ox, tracer 2 should be the stratospheric tracer. (dbj) !================================================================= IF ( ITS_A_FULLCHEM_SIM() ) THEN NUM_TRACER = 1 ELSE IF ( ITS_A_TAGOX_SIM() ) THEN IF (N_TRACERS > 1) THEN NUM_TRACER = 2 ELSE NUM_TRACER = 1 ENDIF ELSE ! All other simulations don't use O3...print error message WRITE( 6, '(a)' ) 'This simulation does not use O3!!' WRITE( 6, '(a)' ) 'STOP in linoz_chem3.f!' STOP ENDIF ENDIF ! Echo info WRITE( 6, 100 ) 100 FORMAT(' - LINOZ_CHEM3: Doing LINOZ stratospheric chemistry') ! **** note dbj: check STT(I,J,20:LLPAR,NTRACER) = with trop level ! **** : check DMASS DO ITRC=1,NUM_TRACER ! dbj loop for tagged IF ( ITS_A_FULLCHEM_SIM() ) THEN NTRACER = IDTOX ELSE NTRACER = ITRC ENDIF ! Make checkpoint file ! WRITING STT and TLSTT TO BE USED IN REVERSE MODE DO L = 1,LLPAR DO J = 1,JJPAR DO I = 1,7 STT_TMP(I,J,L,1) = TLSTT(J,L,I) ENDDO ENDDO ENDDO STT_TMP(:,:,:,2) = STT(:,:,:,NTRACER) NHMS = GET_NHMS() NYMD = GET_NYMD() TAU = GET_TAU() IF ( DO_CHK_FILE() ) & CALL MAKE_UPBDFLX_CHKFILE( NYMD, NHMS, TAU ) WRITE(6,*) '-------------------------------------------------' write(6,*) ' doing linoz stratospheric chemistry' WRITE(6,*) '-------------------------------------------------' ! Start at top layer and continue to lowest layer for strat. chem OUT_DATA = 0d0 !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, LBOT, LPOS, L ) !$OMP+PRIVATE( CLIMPML, DERO3, CLIMO3, DERCO3, DCO3 ) !$OMP+PRIVATE( DERTMP, DTMP, SSO3, DMASS ) DO J = 1, JM DO I = 1, IMX LBOT = GET_TPAUSE_LEVEL(I,J)+1 LPOS = 1 ! To set LFD properly (hml, 10/12/11) !IF ( I == IFD.and.J == JFD) THEN ! print *, 'LBOT = ', LBOT !ENDIF DO WHILE (GET_PEDGE(I,J,LPOS+1) .GE. 0.3D0) LPOS = LPOS +1 ENDDO LPOS = LPOS-1 !--------------------------------------------------------- ! dbj: for now, set tagged stratospheric tracer to total ! O3 in the overworld to avoid issues with spin ups !--------------------------------------------------------- IF ( ITS_A_TAGOX_SIM() ) THEN STT(I,J,(L_OVERWRLD+1):LLPAR,NTRACER) = & STT(I,J,(L_OVERWRLD+1):LLPAR,1) ENDIF DO L = LM,LBOT,-1 IF (STT(I,J,L,NTRACER) .LE. 0.D0) CYCLE ! calculate ozone column above box (and save) ! dcolo3 = ozone column (in DU) in given layer ! colo3 = ozone column above layer + half of ! column in layer !--------------------------------------- ! GET RATES - assigning PROD and LOSS !--------------------------------------- ! bdf stt is in v/v, make conversion to DU IF (L .EQ. LM) THEN !top model layer DCOLO3(I,J,L) = (STT(I,J,L,NTRACER)*AD(I,J,L)/ & TCVV(NTRACER))/ GET_AREA_CM2(J) * & 6.022d23/(28.97/TCVV(NTRACER)*1d-3)/ 2.687d16 COLO3(I,J,L) = DCOLO3(I,J,L)*0.5 ELSE DCOLO3(I,J,L) = (STT(I,J,L,NTRACER)*AD(I,J,L)/ & TCVV(NTRACER))/ GET_AREA_CM2(J) * & 6.022d23/(28.97/TCVV(NTRACER)*1d-3)/ 2.687d16 COLO3(I,J,L) = COLO3(I,J,L+1) + & (DCOLO3(I,J,L)+DCOLO3(I,J,L+1))*0.5 ENDIF OUT_DATA(I,J,L) = COLO3(I,J,L) ! ++++++ climatological P-L: ++++++ CLIMPML = TLSTT(J,L,4) ! Climatological P-L = (P-L)^o ! ++++++ local ozone feedback: ++++++ DERO3 = TLSTT(J,L,5) ! Derivative w.r.t. O3. dero3=-1/(time constant) IF (DERO3 .EQ. 0) CYCLE ! Skip Linoz if lifetime is infinite. CLIMO3 = TLSTT(J,L,1) ! Climatological O3 = f^o DERCO3 = TLSTT(J,L,7) ! Derivative w.r.t. Column O3 DCO3 = (COLO3(I,J,L) - TLSTT(J,L,3)) ! deviation from o3 climatology. ! ++++++ temperature feedback: ++++++ DERTMP = TLSTT(J,L,6) ! Derivative w.r.t. Temperature DTMP = (T(I,J,L) - TLSTT(J,L,2)) ! Deviation in Temperature from climatology. ! ++++++ calculate steady-state ozone: ++++++ SSO3 = CLIMO3 & - (CLIMPML + DTMP*DERTMP + DCO3*DERCO3) / DERO3 ! ++++++ change in ozone mass due to chemistry: ++++++ !ssO3 = f^* DMASS = (SSO3 - STT(I,J,L,NTRACER)) & * (1.0 - exp(DERO3*DTCHEM)) ! ++++++ update ozone mass ++++++ ! LINOZ valid only up to 58 km, so do not use above 0.3 hPa ! dbj: impose exponential fall off of mixing ratio ! between 0.3 and 0.01 hPa (with fall off of a scale height) IF (GET_PEDGE(I,J,L) .LE. 0.3D0) THEN STT(I,J,L,NTRACER) = (GET_PCENTER(I,J,L) & / GET_PCENTER(I,J,LPOS-1)) & * STT(I,J,LPOS-1,NTRACER) ELSE STT(I,J,L,NTRACER) = STT(I,J,L,NTRACER) + DMASS ENDIF ENDDO ! loop over L ENDDO ! loop over I ENDDO ! loop pver J !$OMP END PARALLEL DO !write our calculated column o3 maximum !write(6,*) 'max of columns= ',maxval(out_data) ENDDO ! loop over ntracers END SUBROUTINE LINOZ_CHEM3 !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_stratl ! ! !DESCRIPTION: Subroutine LINOZ\_STRATL performs a monthly fixup of chemistry ! parameters for the Linoz stratospheric ozone chemistry. !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_STRATL ! ! !USES: ! USE GRID_MOD, ONLY : GET_YMID USE TIME_MOD, ONLY : GET_MONTH USE PRESSURE_MOD # include "CMN_SIZE" # include "CMN" ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! integer J,K,L,N,JLATMD(jjpar),JXXX,LR,JJ,i,im1,im2 !,je ! integer jdofm(nmonths_linoz+1),jdmc(nmonths_linoz) ! parameter (je=18) !number of latitudes in look-up table ! Now declare IM, JM as local variables ! since we have removed them from the common block (dbj 6/24/03) INTEGER IM, JM, MONTH real*8 STRTX(nlevels_linoz),YSTRT(nlat_linoz) real*8 P0L(llpar+1) real*8 STRT0L(llpar+1),STRT1L(llpar+1),STRT2L(llpar+1) real*8, PARAMETER :: PSF=1010D0 !Define Month names locally (dbj 6/25/03) CHARACTER(LEN=3) :: CMONTH(12) = (/'jan', 'feb', 'mar', 'apr', & 'may', 'jun', 'jul', 'aug', & 'sep', 'oct', 'nov', 'dec'/) ! data JDOFM/0,31,59,90,120,151,181,212,243,273,304,334,365/ c----------------------------------------------------------------------- ! Assign values for local IM and JM (dbj 6/24/03) IM = IIPAR JM = JJPAR ! added call to GET_MONTH (dbj 6/25/03) WRITE(6,*)'#####################################################' WRITE(6,*)'# Interpolating Linoz fields for ', & CMONTH( GET_MONTH() ), & ' #' WRITE(6,*)'#####################################################' ! ***** Linear interpolation between months is not currently used {PJC} ***** !c get weights for month interpolation ! do i=1,nmonths_linoz ! jdmc(i) = jdofm(i+1) - (jdofm(i+1)-jdofm(i))/2 ! enddo ! ! im1=0 ! do i=1,nmonths_linoz ! if (jdmc(i).lt.jday) then ! im1=i ! endif ! enddo ! if (im1.eq.0) then ! im1=nmonths_linoz ! im2=1 ! wm1=(jdmc(im2)-jday)*1.0/(jdmc(im2)-(jdmc(im1)-365.0)) ! elseif (im1.eq.nmonths_linoz) then ! im2=1 ! wm1=(jdmc(im2)+365.0-jday)/(jdmc(im2)+365.0-jdmc(im1)) ! else ! im2=im1+1 ! wm1=(jdmc(im2)-jday)*1.0/(jdmc(im2)-jdmc(im1)) ! endif ! wm2=1.0-wm1 ! !c write(6,*)iday,jday,' weights: ',wm1,wm2 !c write(6,*)'months: ',im1,im2,month !c write(6,*)'between: ',jdmc(im1),jdmc(im2) ! *************************************************************************** c latitude interpolation YSTRT(1) = -85.d0 !Latitudes = -85, -75, -65, .... +75, +85. do J = 2,NLAT_LINOZ YSTRT(J) = YSTRT(J-1) + 10.d0 enddo DO J = 1,JJPAR JXXX = int(0.1d0 * GET_YMID(J) +10.d0) ! (dbj 6/25/03) JLATMD(J) = MIN(18,MAX(1,JXXX)) !index of nearest Linoz data column ENDDO DO L = 1,LLPAR+1 P0L(L) = GET_AP(LLPAR+2-L) + (GET_BP(LLPAR+2-L)*PSF) ! dbj ENDDO c-------- TPARM(25,18,12,N) defined for -------------------------------- c 25 layers from 58 km to 10 km by 2 km intervals c 18 LATS (85S, 75S, ...85N) c 12 months c N tables = NTBLS c-------- skip interpolating, pick nearest latitude -------------------- DO N = 1,nfields_linoz ! ***** Interpolation between latitudes is not currently used {PJC} ***** !c----- interpolating along latitude, from TPAR2 to STRTXY ! do K = 1,nlevels_linoz ! do J = 1,nlat_linoz !c TPAR2(K,J) = TPARM(K,J,MONTH,N) ! TPAR2(K,J) = TPARM(K,J,im1,N) ! enddo ! enddo ! call LINOZ_INTPL(nlevels_linoz,NLAT_LINOZ,JPAR,JM,YSTRT,YDGRD, ! & TPAR2,STRTXY1) ! do K = 1,nlevels_linoz ! do J = 1,nlat_linoz ! TPAR2(K,J) = TPARM(K,J,im2,N) ! enddo ! enddo ! call LINOZ_INTPL(nlevels_linoz,NLAT_LINOZ,JPAR,JM,YSTRT,YDGRD, ! & TPAR2,STRTXY2) ! *********************************************************************** DO J = 1,JM JJ = JLATMD(J) DO K = 1,nlevels_linoz ! linearly interpolate in latitude and month ! STRTX(K) = STRTXY1(K,J)*wm1 + STRTXY2(K,J)*wm2 ! linearly interpolate in latitude, single month ! STRTX(K) = STRTXY2(K,J) ! nearest latitude, linearly interpolate in month ! STRTX(K) = TPARM(K,JJ,im1,N)*wm1 + TPARM(K,JJ,im2,N)*wm2 ! nearest latitude, single month STRTX(K) = TPARM(K,JJ,GET_MONTH(),N) ! (dbj 6/25/03) ENDDO ! loop over K ! *PJC* Interpolate and calculate moments of column distribution CALL LINOZ_STRT2M(STRTX,nlevels_linoz,STRT0L,STRT1L,STRT2L, & P0L,LLPAR) ! Store loss freq/yields & moments in TLSTT/SWT/SWW ! for exact CTM layers LM down ! Order reversed from C.McLinden version {PJC} DO LR = 1,LLPAR TLSTT(J,LR,N) = STRT0L(LLPAR+1-LR) ENDDO ENDDO ! loop over J ENDDO ! loop over N END SUBROUTINE LINOZ_STRATL !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_strt2m ! ! !DESCRIPTION: Subroutine LINOZ\_STRT2M sets up a std z* atmosphere: ! p = 1000 * 10**(-z*/16 km). !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_STRT2M(STRTX,NX,STRT0L,STRT1L,STRT2L,P0L,NSTRT) ! ! !USES: ! # include "CMN_SIZE" ! ! !DEFINED PARAMETERS: ! ! Parameter (ncbox=25) ! Now use nlevels_linoz for all routines. {PJC} INTEGER, PARAMETER :: NL = NLEVELS_LINOZ+5 ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: NX INTEGER, INTENT(IN) :: NSTRT REAL*8, INTENT(IN) :: STRTX(NLEVELS_LINOZ) REAL*8, INTENT(IN) :: P0L(LLPAR+1) ! ! !OUTPUT PARAMETERS: ! REAL*8, INTENT(OUT) :: STRT0L(LLPAR+1) REAL*8, INTENT(OUT) :: STRT1L(LLPAR+1) REAL*8, INTENT(OUT) :: STRT2L(LLPAR+1) ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! integer ncbox,l,k real*8 P1,P2,F0,F1,F2,PS(NL+1),F(NL) real*8 XPSD,XPSLM1,XPSL c----------------------------------------------------------------------- c set up std z* atmosphere: p = 1000 * 10**(-z*/16 km) c assume that stratospheric chemical parameters always start at cc 52 km (N=27) scan downward from 52 km to 14 km (NX=20) by 2 km c 58 km (N=30) scan downward from 58 km to 10 km (NX=25) by 2 km c intervals, constant >58km c-------- N.B. F(@30km) assumed to be constant from 29-31 km (by mass) c C======== Comments from Chris McLinden by Email ={PJC}================== C CALL SOMLFQ(P1,P2,F0,F1,F2,PS,F,NL) C - P1,P2 are the pressure EDGES for the CTM layer onto which the C coefficients will be mapped. [P1>P2 I believe {PJC}] C - F0,F1,F2 are the CTM layer vertical moments determined in SOMLFQ C - PS are the pressure layer edges of the original [ie Linox] grid C - F is the column of coefficients (on the original grid); note C F is flipped relative to STRTX and since the coefficients begin C at z*=10, F(1)=F(2)=...=F(5)=0 C - NL is 30; size of F() C C The box model calculations were performed at z*=10km, 12km, ... and C so these would represent the centres with the corresponding edges at C 9,11km ; 11,13km; ... C PS() represents the edges (although PS(1) is set to 1000mb). C The first few values are: C PS(1)=1000 C PS(2)=874.947105 (note PS(2) is not quite 1000 exp(-1/16) as the C PS(3)=656.117767 the average pressure is used - not the pressure C PS(4)=492.018914 at the average z*) C PS(5)=368.96213 C PS(6)=276.68257 C PS(7)=207.48266 C ... C PS(30)=0.276682568 C PS(31)=0.0 C C F(1) spans PS(1)-PS(2) C F(2) spans PS(2)-PS(3) C ... C F(30) spans PS(30)-PS(31) C======================================================================= XPSD = 10.D0 **(-0.125D0) XPSLM1 = 1000.D0 PS(1) = 1000.D0 DO L = 2,NL XPSL = XPSLM1 *XPSD PS(L) = 0.5D0 *(XPSLM1 +XPSL) XPSLM1 = XPSL ENDDO PS(NL+1) = 0.D0 DO L = 1,NL-NX F(L) = 0.D0 ENDDO c-------- K=1 is at the top of atmosphere ------------------------------ DO K = 1,NX F(NL+1-K)= STRTX(K) !STRTX has increasing preasure. {PJC} ENDDO DO K = 1,NSTRT P1 = P0L(K+1) P2 = P0L(K) CALL LINOZ_SOMLFQ(P1,P2,F0,F1,F2,PS,F,NL) STRT0L(K)= F0 STRT1L(K)= F1 STRT2L(K)= F2 ENDDO END SUBROUTINE LINOZ_STRT2M !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_somlfq ! ! !DESCRIPTION: subroutine LINOZ\_SOMLFQ calculates loss freq moments from a ! set of loss frequencies at std z*, given a CTM model interval pressure ! range: P1 > P2 (decreasing up) !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_SOMLFQ(P1,P2,F0,F1,F2,PS,F,NL) ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: NL REAL*8, INTENT(IN) :: F(NL) REAL*8, INTENT(IN) :: PS(NL+1) REAL*8, INTENT(OUT) :: P1 REAL*8, INTENT(OUT) :: P2 ! ! !OUTPUT PARAMETERS: ! REAL*8, INTENT(OUT) :: F0 REAL*8, INTENT(OUT) :: F1 REAL*8, INTENT(OUT) :: F2 ! ! REMARKS: ! The pressure levels BETWEEN z* values are: ! PS(i) > PS(i+1) bounds z*(i) ! . ! NL: z* levels, ==> PS(NL+1) = 0 (extrapolate chemical loss to top) ! Z1 = 16.D0*LOG10(1000.D0/P1) ! Z2 = 16.D0*LOG10(1000.D0/P2) ! . ! The MOMENTS for a square-wave or 'bar': F(x)=f0 b<=x<=c, =0.0 else ! S0 = f0 (x) [from x=b to x=c] ! S1 = 3 f0 (x^2 - x) [from x=b to x=c] ! S2 = 5 f0 (2x^3 - 3x^2 + x) [from x=b to x=c] ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! integer I real*8 XB,XC,PC,PB,THIRD,sgnf0 F0 = 0.D0 F1 = 0.D0 F2 = 0.D0 DO I = 1,NL PC = MIN(P1,PS(I)) PB = MAX(P2,PS(I+1)) IF (PC .GT. PB) THEN ! have condition: P1>=PC > PB>=P2, 0<=XB < XC<=1 XC = (PC-P2)/(P1-P2) XB = (PB-P2)/(P1-P2) ! assume that the loss freq, F, is constant over interval [XB,XC], ! F0: (c-b), ! F1: 6((c2-c)-(b2-b)), ! F2: 5((2c3-3c2+c)-(2b3-3b2+b)) ! calculate its contribution to the moments in the interval [0,1] F0 = F0 +F(I) *(XC -XB) F1 = F1 +F(I) *3.D0 *((XC *XC -XC) - (XB *XB -XB)) F2 = F2 +F(I) *5.D0 * & ((XC+XC-1.D0)*(XC*XC -XC) - (XB+XB-1.D0)*(XB*XB -XB)) ENDIF ENDDO ! RESTRAIN moments: force monotonicity & positive at min end pt ! cam: tables can be + or - if (f0.ne.0.0) then sgnf0=f0 / abs(f0) else sgnf0=1.0 endif f0=abs(f0) !F0 = MAX(F0, 0.D0) THIRD = 1.D0/3.D0 IF (F2 .GT. 0.D0) THEN ! do not allow reversal of curvature: F2 > 0 F2 = MIN(F2, ABS(F1)*THIRD, 5.D-1*F0) IF (F1 .LT .0.D0) THEN F1 = MAX(-(F0+F2), F1) ELSE F1 = MIN(+(F0+F2), F1) ENDIF ELSE ! F2 < 0 = curved down at ends, allow if F1 < F0 F1 = MIN(F0,MAX(-F0,F1)) F2 = MAX(F2,(ABS(F1)-F0),(-ABS(F1)*THIRD)) ENDIF ! cam: apply sign f0=sgnf0 * f0 f1=sgnf0 * f1 f2=sgnf0 * f2 END SUBROUTINE LINOZ_SOMLFQ !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_read ! ! !DESCRIPTION: Subroutine LINOZ\_READ reads the input data file for the ! Linoz stratospheric ozone chemistry. !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_READ ! ! !USES: ! USE FILE_MOD, ONLY : IU_FILE ! Logical unit # USE FILE_MOD, ONLY : IOERROR ! I/O error subroutine USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 ! Data directory path # include "CMN_SIZE" ! ! !REMARKS: ! LINOZ_READ is called from "main.f" at the start of the simulation. ! LINOZ_READ will also call INIT_LINOZ to initialize the arrays. ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem ! 16 Oct 2009 - R. Yantosca - Now use IU_FILE instead of IU_LINOZ ! 16 Oct 2009 - R. Yantosca - Read file from DATA_DIR_1x1 !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: K, J, M, NTBLS, IOS REAL*8 :: TMAX, TMIN CHARACTER(LEN=80) :: HEADING, TITL1 CHARACTER(LEN=255) :: FILENAME ! Only initialize arrays on first timestep IF ( FIRST ) THEN CALL INIT_LINOZ FIRST = .FALSE. ENDIF ! Filename FILENAME = TRIM( DATA_DIR_1x1 ) // & 'Linoz_200910/Linoz_March2007.dat' ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) 100 FORMAT( ' - LINOZ_READ: Reading ', a ) ! new std z*=2km levels from model: z*=10,12,...(25*2)+8 km OPEN( IU_FILE, FILE=TRIM( FILENAME ), STATUS='OLD', & FORM='FORMATTED', IOSTAT=IOS ) ! IF ( IOS /= 0 ) THEN CALL IOERROR( IOS, IU_FILE, 'read_linoz_coeff_file' ) ENDIF ! Reade header READ ( IU_FILE, 901 ) HEADING WRITE(6,*) TRIM( HEADING ) ! Loop thru file DO NTBLS = 1,nfields_linoz TMIN = +1.d30 TMAX = -1.d30 READ (IU_FILE,901) TITL1 do M = 1,nmonths_linoz !Month do J = 1,nlat_linoz !Latitudes READ (IU_FILE,907) & (TPARM(K,J,M,NTBLS),K=nlevels_linoz,1,-1) do K=1,nlevels_linoz TMAX = max (TMAX, TPARM(K,J,M,ntbls)) TMIN = min (TMIN, TPARM(K,J,M,ntbls)) enddo enddo enddo write (6,912) TITL1,TMIN,TMAX enddo WRITE(6,*)'$$ Finished Reading Linoz Data $$' WRITE(6,*) GOTO 999 ! If error has occurred 101 CONTINUE WRITE(6,*)'**** STOP: Error reading Linoz Coefficients {PJC} ****' write(6,*)'NTBLS =',ntbls,', M =',m,', J =',j,', K =',k write(6,*)'TPARM(K,J,M,NTBLS) =',TPARM(K,J,M,NTBLS) STOP ! Format strings 901 FORMAT(A) 907 FORMAT(20X,6E11.4/(8E11.4)) c907 FORMAT(20X,6E10.3/(8E10.3)) 912 FORMAT(' Linoz Data: ',a80,1p,2e10.3) 999 CONTINUE ! Close the files CLOSE( IU_FILE ) END SUBROUTINE LINOZ_READ !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: linoz_intpl ! ! !DESCRIPTION: Subroutine LINOZ\_INTPL does some kind of interpolation. !\\ !\\ ! !INTERFACE: ! SUBROUTINE LINOZ_INTPL(KE,IE,ND,NE,XI,XN,YI,YN) ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: KE INTEGER, INTENT(IN) :: IE INTEGER, INTENT(IN) :: ND INTEGER, INTENT(IN) :: NE REAL*8, INTENT(IN) :: XI(IE) REAL*8, INTENT(IN) :: XN(ND) REAL*8, INTENT(IN) :: YI(KE,IE) ! ! !OUTPUT PARAMETERS: ! REAL*8, INTENT(OUT) :: YN(KE,ND) ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! integer I,II,J,K real*8 CNST1,CNST2 ! k=height; i=lat J = 2 do I = 1,NE if (XN(I) .gt. XI(1 )) then if (XN(I) .lt. XI(IE)) then CNST1 = (XI(J) - XN(I)) / (XI(J) - XI(J-1)) CNST2 = (XN(I) - XI(J-1)) / (XI(J) - XI(J-1)) do K = 1,KE YN(K,I) = CNST1 * YI(K,J-1) + CNST2 * YI(K,J) enddo II = min(I+1,NE) if (XN(II) .gt. XI(J)) J = min(IE,J+1) else do K = 1 ,KE YN(K,I) = YI(K,IE) enddo endif else do K = 1,KE YN(K,I) = YI(K,1) enddo endif !write(6,*)i,(yn(k,i),k=1,ke) enddo END SUBROUTINE LINOZ_INTPL !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: strat_init ! ! !DESCRIPTION: Subroutine STRAT\_INIT copies the ozone computed by the ! Linoz stratospheric chemistry algorithm back into the GEOS-Chem ! tracer array. !\\ !\\ ! !INTERFACE: ! SUBROUTINE STRAT_INIT ! ! !USES: ! USE TRACERID_MOD USE TRACER_MOD # include "CMN_SIZE" # include "CMN" ! ! !REVISION HISTORY: ! 24 Jun 2003 - B. Field & D. Jones - Further updates for GEOS-Chem !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER I, J, L CALL LINOZ_STRATL DO J = 1,JJPAR DO I = 1,IIPAR DO L = MINVAL(LPAUSE),LLPAR IF (L .LT. LPAUSE(I,J)) CYCLE STT(I,J,L,IDTOX) = TLSTT(J,L,1) / TCVV(IDTOX) ENDDO ENDDO ENDDO ! call write_fields2(7) ! call flush(12) END SUBROUTINE STRAT_INIT !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: init_linoz ! ! !DESCRIPTION: Subroutine INIT\_LINOZ allocates and zeroes the module arrays ! used in the Linoz stratospheric ozone algorithm. !\\ !\\ ! !INTERFACE: ! SUBROUTINE INIT_LINOZ ! ! !USES: ! USE ERROR_MOD, ONLY : ALLOC_ERR # include "CMN_SIZE" ! ! !REVISION HISTORY: ! 16 Oct 2009 - R. Yantosca - Initial version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: AS ! For safety's sake, only allocate arrays on first call IF ( FIRST ) THEN ! Allocate TPARM array ALLOCATE( TPARM( NLEVELS_LINOZ, NLAT_LINOZ, & NMONTHS_LINOZ, NFIELDS_LINOZ ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'TPARM' ) TPARM = 0d0 ! Allocate TLSTT array ALLOCATE( TLSTT( JJPAR, LLPAR, NFIELDS_LINOZ ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'TPARM' ) TLSTT = 0d0 ! Reset FIRST FIRST = .FALSE. ENDIF END SUBROUTINE INIT_LINOZ !------------------------------------------------------------------- SUBROUTINE LINOZ_CHEM3_FORADJ( DTCHEM ) ! !*************************************************************** ! Subroutine LINOZ_CHEM3_FORADJ is a version that applies ! scaling factors to the strat prod / loss rates in a manner ! equivalent to how GMI rates are adjusted in strat chem. ! (dkh, 02/28/12) ! !*************************************************************** USE TIME_MOD, ONLY : GET_NHMS USE TIME_MOD, ONLY : GET_NYMD USE TIME_MOD, ONLY : GET_TAU USE DAO_MOD, ONLY : AD USE DAO_MOD, ONLY : T USE ERROR_MOD, ONLY : ERROR_STOP USE TRACER_MOD, ONLY : TCVV USE TRACER_MOD, ONLY : STT_TMP USE TRACER_MOD, ONLY : STT USE TRACER_MOD, ONLY : N_TRACERS USE TRACER_MOD, ONLY : ITS_A_TAGOX_SIM USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM USE TRACERID_MOD, ONLY : IDTOX USE GRID_MOD, ONLY : GET_AREA_CM2 USE TROPOPAUSE_MOD, ONLY : GET_TPAUSE_LEVEL USE TROPOPAUSE_MOD, ONLY : GET_MAX_TPAUSE_LEVEL USE PRESSURE_MOD, ONLY : GET_PEDGE USE PRESSURE_MOD, ONLY : GET_PCENTER USE CHECKPOINT_MOD, ONLY : MAKE_UPBDFLX_CHKFILE USE LOGICAL_ADJ_MOD, ONLY : LADJ_STRAT USE LOGICAL_ADJ_MOD, ONLY : LADJ USE ADJ_ARRAYS_MOD, ONLY : PROD_SF, LOSS_SF USE ADJ_ARRAYS_MOD, ONLY : ID_LOSS, NSTPL USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD, DO_CHK_FILE IMPLICIT NONE # include "CMN_SIZE" # include "CMN" !# include "../new/linoz.com" REAL*8, INTENT(IN) :: DTCHEM ! Time step [seconds] C============================================== C define arguments C============================================== ! hml: add for strat prod & loss sense INTEGER :: IMX, JM, LM INTEGER :: I, J, L INTEGER :: NS, NSL INTEGER :: LBOT, L_OVERWRLD INTEGER :: NTRACER, NUM_TRACER, LPOS, ITRC INTEGER :: NHMS, NYMD REAL*8 :: CLIMO3, CLIMPML, PMLTOT REAL*8 :: DCO3, DERO3, DERTMP REAL*8 :: DERCO3, DMASS, DTMP REAL*8 :: SSO3 REAL*8 :: TAU REAL*8 :: P, k, M0 REAL*8 :: PROD, LOSS REAL*8 :: PROD_0, LOSS_0 ! Arrays REAL*8 :: DCOLO3(IIPAR,JJPAR,LLPAR) REAL*8 :: COLO3(IIPAR,JJPAR,LLPAR) REAL*8 :: OUT_DATA(IIPAR,JJPAR,LLPAR) ! Assign values for local IMX and JM (dbj 6/24/03) IMX = IIPAR JM = JJPAR LM = LLPAR ! dbj L_OVERWRLD = GET_MAX_TPAUSE_LEVEL() ! ====================================== ! 7 tables, each a function of month (12), latitude ! (18, -85 to 85 in 10 deg. increments) and altitude ! (25, z*=10-58 km in 2 km increments). ! 1- ozone (Logan climatology), v/v ! 2- Temperature climatology, K ! 3- Column ozone climatology, Logan ozone integrated above box, DU ! 4- ozone (P-L) for climatological ozone, v/v/s ! 5- d(P-L) / dO3, 1/s ! 6- d(P-L) / dT, v/v/s/K ! 7- d(P-L) / d(column O3), v/v/s/DU ! ! zero storage arrays ! do n=1,ntrace ! sttold(n)=0.d0 ! enddo !================================================================= !================================================================= ! Select the proper tracer number to store O3 into, depending on ! whether this is a full chemistry run or a tagged Ox run. ! If tagged Ox, tracer 2 should be the stratospheric tracer. (dbj) !================================================================= IF ( ITS_A_FULLCHEM_SIM() ) THEN NUM_TRACER = 1 ELSE IF ( ITS_A_TAGOX_SIM() ) THEN IF (N_TRACERS > 1) THEN NUM_TRACER = 2 ELSE NUM_TRACER = 1 ENDIF ELSE ! All other simulations don't use O3...print error message WRITE( 6, '(a)' ) 'This simulation does not use O3!!' WRITE( 6, '(a)' ) 'STOP in linoz_chem3.f!' STOP ENDIF ENDIF ! Echo info WRITE( 6, 100 ) 100 FORMAT(' - LINOZ_CHEM3_FORADJ: Doing LINOZ strat chemistry') ! **** note dbj: check STT(I,J,20:LLPAR,NTRACER) = with trop level ! **** : check DMASS DO ITRC=1,NUM_TRACER ! dbj loop for tagged IF ( ITS_A_FULLCHEM_SIM() ) THEN NTRACER = IDTOX ELSE NTRACER = ITRC ENDIF ! Make checkpoint file ! WRITING STT and TLSTT TO BE USED IN REVERSE MODE IF ( LADJ ) THEN DO L = 1,LLPAR DO J = 1,JJPAR DO I = 1,7 STT_TMP(I,J,L,1) = TLSTT(J,L,I) ENDDO ENDDO ENDDO STT_TMP(:,:,:,2) = STT(:,:,:,NTRACER) NHMS = GET_NHMS() NYMD = GET_NYMD() TAU = GET_TAU() IF ( DO_CHK_FILE() ) & CALL MAKE_UPBDFLX_CHKFILE( NYMD, NHMS, TAU ) ENDIF WRITE(6,*) '-------------------------------------------------' write(6,*) ' doing linoz stratospheric chemistry' WRITE(6,*) '-------------------------------------------------' ! Start at top layer and continue to lowest layer for strat. chem OUT_DATA = 0d0 ! Initialize arrays (hml, 10/17/11) LOSS = 0d0 PROD = 0d0 DO J = 1, JM DO I = 1, IMX LBOT = GET_TPAUSE_LEVEL(I,J)+1 LPOS = 1 ! To set LFD properly (hml, 10/12/11) !IF ( I == IFD.and.J == JFD) THEN ! print *, 'LBOT = ', LBOT !ENDIF DO WHILE (GET_PEDGE(I,J,LPOS+1) .GE. 0.3D0) LPOS = LPOS +1 ENDDO LPOS = LPOS-1 !--------------------------------------------------------- ! dbj: for now, set tagged stratospheric tracer to total ! O3 in the overworld to avoid issues with spin ups !--------------------------------------------------------- IF ( ITS_A_TAGOX_SIM() ) THEN STT(I,J,(L_OVERWRLD+1):LLPAR,NTRACER) = & STT(I,J,(L_OVERWRLD+1):LLPAR,1) ENDIF ! If we just loop from LPOS, rather than LLPAR, then we only deal with ! levels for which PEDGE > 0.3d0 DO L = LM,LBOT,-1 IF (STT(I,J,L,NTRACER) .LE. 0.D0) CYCLE !--------------------------------------- ! GET RATES - assigning PROD and LOSS !--------------------------------------- !------------------------------------------------------ ! Recalculate forward model values to get rates !------------------------------------------------------ ! bdf stt is in v/v, make conversion to DU IF ( L .EQ. LM) THEN !top model layer DCOLO3(I,J,L) = (STT(I,J,L,NTRACER)*AD(I,J,L)/ & TCVV(NTRACER))/ GET_AREA_CM2(J) * & 6.022d23/(28.97/TCVV(NTRACER)*1d-3)/ 2.687d16 COLO3(I,J,L) = DCOLO3(I,J,L)*0.5 ELSE DCOLO3(I,J,L) = (STT(I,J,L,NTRACER)*AD(I,J,L)/ & TCVV(NTRACER))/ GET_AREA_CM2(J) * & 6.022d23/(28.97/TCVV(NTRACER)*1d-3)/ 2.687d16 COLO3(I,J,L) = COLO3(I,J,L+1) + & (DCOLO3(I,J,L)+DCOLO3(I,J,L+1))*0.5 ENDIF ! ++++++ climatological P-L: ++++++ CLIMPML = TLSTT(J,L,4) ! Climatological P-L = (P-L)^o ! ++++++ local ozone feedback: ++++++ DERO3 = TLSTT(J,L,5) ! Derivative w.r.t. O3. dero3=-1/(time constant) IF ( DERO3 .EQ. 0 ) CYCLE ! Skip Linoz if lifetime is infinite. CLIMO3 = TLSTT(J,L,1) ! Climatological O3 = f^o DERCO3 = TLSTT(J,L,7) ! Derivative w.r.t. Column O3 DCO3 = (COLO3(I,J,L) - TLSTT(J,L,3)) ! deviation from o3 climatology. ! ++++++ temperature feedback: ++++++ DERTMP = TLSTT(J,L,6) ! Derivative w.r.t. Temperature DTMP = (T(I,J,L) - TLSTT(J,L,2)) ! Deviation in Temperature from climatology. ! ++++++ calculate steady-state ozone: ++++++ SSO3 = CLIMO3 & - (CLIMPML + DTMP*DERTMP + DCO3*DERCO3) /DERO3 ! ++++++ change in ozone mass due to chemistry: ++++++ !ssO3 = f^* DMASS = (SSO3 - STT(I,J,L,NTRACER)) & * (1.0 - exp(DERO3*DTCHEM)) ! ++++++ update ozone mass ++++++ ! LINOZ valid only up to 58 km, so do not use above 0.3 hPa ! dbj: impose exponential fall off of mixing ratio ! between 0.3 and 0.01 hPa (with fall off of a scale height) IF (GET_PEDGE(I,J,L) .LE. 0.3D0) THEN STT(I,J,L,NTRACER) = (GET_PCENTER(I,J,L) & / GET_PCENTER(I,J,LPOS-1)) & * STT(I,J,LPOS-1,NTRACER) ! apply prod / loss rates ala GMI strat chem method ELSE ! note: there is a factor of TC / AD * AD / TC that cancels ! out in definition of PROD_0 PROD_0 = - (SSO3 * DERO3) LOSS_0 = - DERO3 DO NS = 1, NSTPL NSL = ID_LOSS(NS) ! same for ID_PROD(NS) IF ( NSL .EQ. IDTOx ) THEN !! Scaled prod & loss rate PROD = PROD_0 * PROD_SF(I,J,1,NS) LOSS = LOSS_0 * LOSS_SF(I,J,1,NS) ENDIF ENDDO k = LOSS ! loss freq [s-1] P = PROD * AD(I,J,L) / TCVV(NTRACER) ! production term [kg s-1] ! Put ozone back to kg (hml, 11/06/11) M0 = STT(I,J,L,NTRACER) & * AD(I,J,L) / TCVV(NTRACER)! initial mass [kg] ! No prod or loss at all if ( k .eq. 0d0 .and. P .eq. 0d0 ) cycle ! Simple analytic solution to dM/dt = P - kM over [0,t] ! if ( k .gt. 0d0 ) then STT(I,J,L,NTRACER) = M0 * exp(-k*DTCHEM) & + (P/k)*(1d0-exp(-k*DTCHEM)) ! else ! STT(I,J,L,NTRACER) = M0 + P*DTCHEM ! endif ! convert units back to v/v, which is was the code expects coming out ! of LINOZ STT(I,J,L,NTRACER) = STT(I,J,L,NTRACER) & * TCVV(NTRACER) / AD(I,J,L) ENDIF ENDDO ! loop over L ENDDO ! loop over I ENDDO ! loop pver J !!$OMP END PARALLEL DO !write our calculated column o3 maximum !write(6,*) 'max of columns= ',maxval(out_data) ENDDO ! loop over ntracers END SUBROUTINE LINOZ_CHEM3_FORADJ !------------------------------------------------------------------------------ !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: cleanup_linoz ! ! !DESCRIPTION: Subroutine CLEANUP\_LINOZ deallocates all module arrays. !\\ !\\ ! !INTERFACE: ! SUBROUTINE CLEANUP_LINOZ ! ! !REVISION HISTORY: ! 16 Oct 2009 - R. Yantosca - Initial version !EOP !------------------------------------------------------------------------------ !BOC ! Deallocate arrays IF ( ALLOCATED( TPARM ) ) DEALLOCATE( TPARM ) IF ( ALLOCATED( TLSTT ) ) DEALLOCATE( TLSTT ) END SUBROUTINE CLEANUP_LINOZ !EOC ! End of module END MODULE LINOZ_MOD