diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bda8c28 --- /dev/null +++ b/.gitignore @@ -0,0 +1,46 @@ +# git ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ + +### git svn show-ignore +/.project +/.cproject +/.settings + +### https://github.com/github/gitignore/blob/master/Fortran.gitignore + +# Compiled Object files +*.slo +*.lo +*.o +*.obj + +# Precompiled Headers +*.gch +*.pch + +# Compiled Dynamic libraries +*.so +*.dylib +*.dll + +# Fortran module files +*.mod +*.smod + +# Compiled Static libraries +*.lai +*.la +*.a +*.lib + +# Executables +*.exe +*.out +*.app + +### compiled EMEP/MSC-W model +Unimod diff --git a/AOD_PM_ml.f90 b/AOD_PM_ml.f90 index e8b1177..a8dcccd 100644 --- a/AOD_PM_ml.f90 +++ b/AOD_PM_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -94,7 +94,7 @@ module AOD_PM_ml ! assume rho_dry as SO4, Q and GF as SSc type :: ExtEffMap integer :: itot,cext -endtype ExtEffMap +end type ExtEffMap !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx include 'CM_AerExt.inc' @@ -223,8 +223,8 @@ module AOD_PM_ml [NUM_CEXT,NumRH,W1020-W340+1],order=[2,1,3]) real,parameter,dimension(NUM_CEXT) :: & - Qm_Dabs= & ! (dry) mass absorption efficiency [m?/g] at 550 nm - [0.0 ,0.0 ,0.0 ,0.0 ,8.5 ,11.5 ,0.0 ,0.0 ,0.0 ], & +! Qm_Dabs= & ! (dry) mass absorption efficiency [m?/g] at 550 nm +! [0.0 ,0.0 ,0.0 ,0.0 ,8.5 ,11.5 ,0.0 ,0.0 ,0.0 ], & rho_dry=[2.6 ,2.6 ,2.2 ,2.2 ,1.0 ,1.0 ,1.8 ,1.6 ,1.6 ], & rad_eff=[0.80 ,4.5 ,0.80 ,5.73 ,0.039,0.039,0.087,0.156,5.73 ] ! 1:DDf 2:DDc 3:SSf 4:SSc 5:ECn 6:ECa 7:OC 8:SO4 9:NO3c @@ -276,11 +276,11 @@ function Qm(mode,rh,wlen,debug) result(Qm_arr) ExtEff=MATMUL(Qm_ref(:,rh_n-1:rh_n,wlen),rh_w) ! Extinction efficiencies if(debug) write(*,'((a15,9f10.3))') & '## GFs =',gf(:),'## ExtEff=',ExtEff(:) - endif + end if case default call CheckStop("Unknown extinction mode: "//trim(mode)) - endselect + end select !.. mass extinction efficiency [m2/g] !beta = 3/4 * ExtEff/rho_wet/rad_eff * Mwet/Mdry @@ -311,8 +311,8 @@ function rho_wet(nc) ! rho_wet = Vfr_dry*rho_dry + (1-Vfr_dry)*RHO_H2O ! = (rho_dry-RHO_H2O)/GF**3 + RHO_H2O rho_wet = (rho_dry(nc)-RHO_H2O)/Gf(nc)**3 + RHO_H2O -endfunction rho_wet -endfunction Qm +end function rho_wet +end function Qm function Qm_grp(gtot,rh,debug) result(Qm_arr) !-----------------------------------------------------------------------! @@ -337,14 +337,14 @@ function Qm_grp(gtot,rh,debug) result(Qm_arr) Qm_aux=Qm("WET",rh ,W550,my_debug) else Qm_aux=Qm("DRY",0.0,W550,my_debug) - endif + end if Qm_arr(:)=0 do n=1,size(gtot) i=find_index(gtot(n),ExtMap(:)%itot,debug=my_debug) if(i>0)Qm_arr(n)=Qm_aux(i) - enddo -endfunction Qm_grp + end do +end function Qm_grp subroutine AOD_init(msg,wlen,out3d) character(len=*), intent(in) :: msg @@ -359,22 +359,22 @@ subroutine AOD_init(msg,wlen,out3d) call CheckStop(n<1,& trim(msg)//" Unknown AOD/EXT wavelength "//trim(wlen)) wanted_wlen(n)=.true. - endif + end if if(present(out3d))then wanted_ext3d=wanted_ext3d.or.out3d - endif + end if !-----------------------------------------------------------------------! ! Consistency checks for older model versions using AOD_GROUP !-----------------------------------------------------------------------! if(.not.associated(aod_grp))then igrp=find_index('AOD',chemgroups%name) if(igrp<1) return ! AOD group no longer used... nothing to check - aod_grp=>chemgroups(igrp)%ptr + aod_grp=>chemgroups(igrp)%specs call CheckStop(size(aod_grp),NUM_EXT,& trim(msg)//" Incompatibe AOD_GROUP size") call CheckStop(any(aod_grp/=ExtMap%itot),& trim(msg)//" Incompatibe AOD_GROUP def.") - endif + end if !-----------------------------------------------------------------------! ! Consistency checks for Qm_ref array !-----------------------------------------------------------------------! @@ -394,17 +394,17 @@ subroutine AOD_init(msg,wlen,out3d) if(any(wanted_wlen(:)).and..not.allocated(AOD))then allocate(AOD(NUM_EXT,LIMAX,LJMAX,W340:W1020)) AOD=0.0 - endif + end if if(wanted_ext3d.and..not.allocated(Extin_coeff))then allocate(Extin_coeff(NUM_EXT,LIMAX,LJMAX,KMAX_MID,W340:W1020)) Extin_coeff=0.0 - endif + end if if(ANALYSIS.and..not.associated(SpecExtCross))then !!wanted_wlen(W550)=.true. ! calculate 550nm for AOD assimilation allocate(SpecExtCross(NUM_EXT,KMAX_MID,LIMAX,LJMAX,W340:W1020)) SpecExtCross=0.0 - endif -endsubroutine AOD_init + end if +end subroutine AOD_init subroutine AOD_Ext(i,j,debug) !-----------------------------------------------------------------------! @@ -426,11 +426,11 @@ subroutine AOD_Ext(i,j,debug) call CheckStop(USE_AOD.and..not.any(wanted_wlen(:)),& "USE_AOR=T, but no AOD/EXT output. Check config_*.nml") first_call=.false. - endif + end if if(debug)then write(*,*) '#### in AOD module ###' AOD_cext(:)=0.0 - endif + end if !=========================================================================== ! Extinction coefficients: @@ -464,19 +464,19 @@ subroutine AOD_Ext(i,j,debug) !.. Extinction coefficients for diferent optical groups/types do n = 1,NUM_CEXT kext_cext(n)=sum(kext(:),MASK=(ExtMap(:)%cext==n)) - enddo + end do !.. Aerosol optical depth for individual components AOD_cext(:)=AOD_cext(:)+kext_cext(:)*(z_bnd(i,j,k)-z_bnd(i,j,k+1)) if((k==KCHEMTOP+1).or.(k==KMAX_MID))& write(*,"(a8,'(',i3,')=',es10.3,'=',9(es10.3,:,'+'))") & 'EXTINCs', k, sum(kext(:)),kext_cext(:) - endif - enddo - enddo + end if + end do + end do if(debug) write(*,"(a24,2i5,es10.3,'=',9(es10.3,:,'+'))") & '>>> AOD / AODs <<<', i_fdom(i), j_fdom(j), sum(AOD(:,i,j,W550)), AOD_cext(:) -endsubroutine AOD_Ext +end subroutine AOD_Ext endmodule AOD_PM_ml diff --git a/AOTnPOD_ml.f90 b/AOTnPOD_ml.f90 index 2a4cc9c..c995aa4 100644 --- a/AOTnPOD_ml.f90 +++ b/AOTnPOD_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -250,7 +250,7 @@ subroutine Calc_POD(iO3cl,iLC, pod, debug_flag, debug_txt ) logical, intent(in) :: debug_flag character(len=*), intent(in), optional :: debug_txt integer, intent(in) :: iO3cl,iLC - real, intent(out) :: pod + real, intent(out) :: pod character(len=*),parameter :: dtxt='CalcPOD:' character(len=10):: txt diff --git a/Advection_ml.f90 b/Advection_ml.f90 index c7227b0..33190c4 100644 --- a/Advection_ml.f90 +++ b/Advection_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -38,9 +38,9 @@ Module Advection_ml ! "Bott's fourth order scheme". The routine preadvx and preadvy take care of ! the transfer of information between processors before the advection step. ! -! The advvk routine performs the vertical advection. Bott's second order -! scheme with variable grid distance is used. -! The calculation of the coefficients used for this scheme is done in the +! The advvk routine performs the vertical advection. Bott's second order +! scheme with variable grid distance is used. +! The calculation of the coefficients used for this scheme is done in the ! routine vgrid. ! ! Notes from Peter; 7/11/01 @@ -70,35 +70,38 @@ Module Advection_ml !CRM use ChemSpecs_adv_ml , only : NSPEC_ADV use CheckStop_ml, only : CheckStop,StopAll use Convection_ml, only : convection_pstar,convection_Eta - use EmisDef_ml, only : loc_frac + use EmisDef_ml, only : NSECTORS, Nneighbors, loc_frac, loc_frac_1d use GridValues_ml, only : GRIDWIDTH_M,xm2,xmd,xm2ji,xmdji,xm_i, Pole_Singular, & - dA,dB,i_fdom,j_fdom,i_local,j_local,Eta_bnd,dEta_i + dhs1, dhs1i, dhs2i, & + dA,dB,i_fdom,j_fdom,i_local,j_local,Eta_bnd,dEta_i,& + extendarea_N use Io_ml, only : datewrite + use Io_Progs_ml, only : PrintLog use ModelConstants_ml, only : KMAX_BND,KMAX_MID,NMET, nstep, nmax, & dt_advec, dt_advec_inv, PT,Pref, KCHEMTOP, NPROCX,NPROCY,NPROC, & - FORECAST,& - USE_CONVECTION,DEBUG_ADV,USE_uEMEP,uEMEP + FORECAST,& + USE_CONVECTION,DEBUG_ADV,USE_uEMEP,uEMEP,ZERO_ORDER_ADVEC use MetFields_ml, only : ps,sdot,Etadot,SigmaKz,EtaKz,u_xmj,v_xmi,cnvuf,cnvdf& ,uw,ue,vs,vn use MassBudget_ml, only : fluxin_top,fluxout_top,fluxin,fluxout use My_Timing_ml, only : Code_timer, Add_2timing, tim_before,tim_after - use MPI_Groups_ml, only :MPI_DOUBLE_PRECISION, MPI_MAX, MPI_SUM,MPI_INTEGER, MPI_BYTE, IERROR,& - MPISTATUS, MPI_COMM_IO, MPI_COMM_CALC, ME_IO, ME_CALC, ME_MPI,MPI_IN_PLACE,& - request_n,request_s,request_xn_n,request_xn_s,& - request_e,request_w, request_xn_w, request_xn_e + !do not use "only", because MPI_IN_PLACE does not behave well on certain versions of gfortran(?) + use MPI_Groups_ml !, only :MPI_DOUBLE_PRECISION, MPI_MAX, MPI_SUM,MPI_INTEGER, MPI_BYTE, IERROR,& + ! MPISTATUS, MPI_COMM_IO, MPI_COMM_CALC, ME_IO, ME_CALC, ME_MPI,MPI_IN_PLACE,& + ! request_n,request_s,request_xn_n,request_xn_s,& + ! request_e,request_w, request_xn_w, request_xn_e use Par_ml, only : LIMAX,LJMAX,GJMAX,GIMAX,me,mex,mey,& li0,li1,lj0,lj1 ,limax,ljmax, gi0, IRUNBEG,gj0, JRUNBEG & ,neighbor,WEST,EAST,SOUTH,NORTH,NOPROC & ,MSG_NORTH2,MSG_EAST2,MSG_SOUTH2,MSG_WEST2 use PhysicalConstants_ml, only : GRAV,ATWAIR ! gravity + use uEMEP_ml, only : uEMEP_Size1, uemep_adv_x, uemep_adv_y, uemep_adv_k implicit none private integer, private, parameter :: NADVS = 3 - real, public, save, allocatable,dimension(:) :: dhs1, dhs1i, dhs2i - ! for vertical advection (nonequidistant spacing) real, private, save, allocatable, dimension(:,:,:) :: alfnew real, private, save, dimension(3) :: alfbegnew,alfendnew @@ -107,8 +110,8 @@ Module Advection_ml ! real, private,save,allocatable, dimension(:,:,:) :: vs,vn integer, public, parameter :: ADVEC_TYPE = 1 ! Divides by advected p* -! integer, public, parameter :: ADVEC_TYPE = 2 ! Divides by "meteorologically" - ! advected p* +! integer, public, parameter :: ADVEC_TYPE = 2 ! Divides by "meteorologically" + ! advected p* public :: assign_dtadvec public :: assign_nmax @@ -126,20 +129,21 @@ Module Advection_ml private :: adv_vert_zero private :: advx private :: advy - private :: preadvx - private :: preadvy + private :: preadvx3 + private :: preadvy3 ! Checks & warnings ! introduced after getting Nan when using "poor" meteo can give this too. - ! ps3d can get zero values when winds are extremely divergent (empty a - ! gridcell for air). This seems to happen only very occasionally (one - ! gridcell, once every week for instance); & does not harm results + ! ps3d can get zero values when winds are extremely divergent (empty a + ! gridcell for air). This seems to happen only very occasionally (one + ! gridcell, once every week for instance); & does not harm results ! significantly, at least much less than the poor metdata does anyway. ! Still, we need to know about it. integer, private, save :: nWarnings = 0 integer, private, parameter :: MAX_WARNINGS = 100 - logical, parameter :: hor_adv0th=.false. + logical, save :: hor_adv0th=.false. + logical, save :: vert_adv0th=.false. contains !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @@ -157,22 +161,28 @@ subroutine assign_dtadvec(GRIDWIDTH_M) implicit none real, intent(in) ::GRIDWIDTH_M - dt_advec=1800.0 - if(GRIDWIDTH_M<61000.0) dt_advec=1200.0 - if(GRIDWIDTH_M<21000.0) dt_advec= 900.0 - if(GRIDWIDTH_M<11000.0) dt_advec= 600.0 - if(GRIDWIDTH_M< 6000.0) dt_advec= 300.0 + if(dt_advec<0.0)then + dt_advec=1800.0 + if(GRIDWIDTH_M<61000.0) dt_advec=1200.0 + if(GRIDWIDTH_M<21000.0) dt_advec= 900.0 + if(GRIDWIDTH_M<11000.0) dt_advec= 600.0 + if(GRIDWIDTH_M< 6000.0) dt_advec= 300.0 ! GEMS025 domain 0.25 deg resol --> GRIDWIDTH_M~=27.8 km --> dt_advec=1200.0 ! MACC02 domain 0.20 deg resol --> GRIDWIDTH_M~=22.2 km --> dt_advec=1200.0 + if(me==0)write(*,fmt="(a,F8.1,a)")' advection time step (dt_advec) set to: ',dt_advec,' seconds' + else + !the value prescribed by the config file overrides dt_advec + if(me==0)write(*,fmt="(a,F8.1,a)")& + ' advection time step (dt_advec) set by config file to: ',dt_advec,' seconds' + endif + !check that it is allowed: call CheckStop(mod(3600,nint(dt_advec)).ne.0, "3600/dt_advec must be an integer") dt_advec_inv=1.0/dt_advec - if(me==0)write(*,fmt="(a,F8.1,a)")' advection time step (dt_advec) set to: ',dt_advec,' seconds' - call alloc_adv_arrays!should be moved elsewhere end subroutine assign_dtadvec @@ -198,7 +208,7 @@ subroutine assign_nmax(metstep) write(6,fmt="(I3,a,I2,a)")nmax,' advection steps within each metstep (',metstep,' hours)' ! write(6,*)'**********************************************' ! write(6,*) - endif + end if end subroutine assign_nmax !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @@ -224,7 +234,7 @@ subroutine advecdiff_Eta !2)Do not advect but only "mix" the concentrations near poles ("near" ! poles is determined by NITERXMAX. ! - !1/10/2012: divide by ps3d (p*) after each partial advection (x,y or z + !1/10/2012: divide by ps3d (p*) after each partial advection (x,y or z !direction) ! !Flexible timestep. Peter Wind january-2002 @@ -246,13 +256,13 @@ subroutine advecdiff_Eta ! ! March 2013: Eta coordinates ! P* = Ps-PT is replaced by (dA+dB*Ps)/(dA/Pref+dB) - ! Both are defined by dP/dEta, but in general Eta coordinates it is not height independent + ! Both are defined by dP/dEta, but in general Eta coordinates it is not height independent implicit none ! local - integer i,j,k,n,ix,iix,ip,info + integer i,j,k,n,ix,iix real dth real xntop(NSPEC_ADV,LIMAX,LJMAX) real xnw(3*NSPEC_ADV),xne(3*NSPEC_ADV) @@ -262,23 +272,21 @@ subroutine advecdiff_Eta real psn(3),pss(3) real ds3(2:KMAX_MID),ds4(2:KMAX_MID) real xcmax(KMAX_MID,GJMAX),ycmax(KMAX_MID,GIMAX),scmax,sdcmax - real dt_smax,dt_s,div + real dt_smax,dt_s real dt_x(LJMAX,KMAX_MID),dt_y(LIMAX,KMAX_MID) real dt_xmax(LJMAX,KMAX_MID),dt_ymax(LIMAX,KMAX_MID) integer niterx(LJMAX,KMAX_MID),nitery(LIMAX,KMAX_MID) integer niterxys,niters,nxy,ndiff - integer iterxys,iters,iterx,itery,nxx,nxxmin,nyy - integer ::isum,isumtot,iproc + integer iterxys,iters,iterx,itery,nxx,nxxmin,nyy,dx,dy + integer ::isum,isumtot,iproc,isec_poll1,ipoll,isec_poll real :: xn_advjktot(NSPEC_ADV),xn_advjk(NSPEC_ADV),rfac real :: dpdeta0,mindpdeta,xxdg,fac1 - real :: xnold,xn_k_old,xn_k(kmax_mid),xn,x,xx + real :: xn_k(kmax_mid,uEMEP%Nsec_poll,(uEMEP%dist*2+1)*(uEMEP%dist*2+1)),x real :: fluxx(NSPEC_ADV,-1:LIMAX+1) real :: fluxy(NSPEC_ADV,-1:LJMAX+1) real :: fluxk(NSPEC_ADV,KMAX_MID) - real :: uEMEPfac(KMAX_MID),f_in,f_out logical,save :: firstcall = .true. - !NITERXMAX=max value of iterations accepted for fourth order Bott scheme. !If the calculated number of iterations (determined from Courant number) !exceeds NITERXMAX, the advection is not done, but instead all the mixing @@ -286,17 +294,9 @@ subroutine advecdiff_Eta !This case can arises where there is a singularity close to the !poles in long-lat coordinates. integer,parameter :: NITERXMAX=10 - integer,parameter :: KMIN_uemep=2 xxdg=GRIDWIDTH_M*GRIDWIDTH_M/GRAV !constant used in loops - if(USE_uEMEP)then - ip=1 - do k = 1,KMAX_MID - uEMEPfac(k)=(dA(k)/Pref+dB(k))/ATWAIR/GRAV*1.0E6 - enddo - endif - call Code_timer(tim_before) if(firstcall)then @@ -306,14 +306,20 @@ subroutine advecdiff_Eta elseif(NPROCY>1.and.me==0.and.Pole_Singular==1)then write(*,*)& 'COMMENT: Advection routine will work faster if NDY = 1' - endif + end if !Overwrite the cooefficients for vertical advection, with Eta-adpated values - call vgrid_Eta - endif + call vgrid_Eta + if(.not.allocated(loc_frac_1d))allocate(loc_frac_1d(0,1,1,1))!to avoid error messages + if(ZERO_ORDER_ADVEC)then + hor_adv0th = .true. + vert_adv0th = .true. + if(me==0)call PrintLog("USING ZERO ORDER ADVECTION") + endif + end if if(KCHEMTOP==2)then xntop(:,:,:)=xn_adv(:,:,:,1) - endif + end if ! convert from mixing ratio to concentration before advection do k = 1,KMAX_MID @@ -326,7 +332,7 @@ subroutine advecdiff_Eta end do - call Add_2timing(25,tim_after,tim_before,"advecdiff:ps") + call Add_2timing(22,tim_after,tim_before,"advecdiff:ps") ! time-splitting is used for the physical and chemical operators. ! second-order accuracy in time is obtained by alternating the order @@ -362,13 +368,13 @@ subroutine advecdiff_Eta xcmax(k,j+gj0-1) = maxval( & max(u_xmj(1:limax ,j,k,1)*xm2(1:limax,j),1.e-30) & -min(u_xmj(0:limax-1,j,k,1)*xm2(1:limax,j),0.0 )) - enddo + end do do i=1,limax ycmax(k,i+gi0-1) = maxval( & max(v_xmi(i,1:ljmax ,k,1)*xm2(i,1:ljmax),1.e-30) & -min(v_xmi(i,0:ljmax-1,k,1)*xm2(i,1:ljmax),0.0 )) - enddo - enddo + end do + end do CALL MPI_ALLREDUCE(MPI_IN_PLACE,xcmax,KMAX_MID*gjmax,MPI_DOUBLE_PRECISION, & MPI_MAX,MPI_COMM_CALC,IERROR) @@ -379,13 +385,13 @@ subroutine advecdiff_Eta do i=1,limax do k=1,KMAX_MID dt_ymax(i,k)=GRIDWIDTH_M/ycmax(k,i+gi0-1) - enddo - enddo + end do + end do do j=1,ljmax do k=1,KMAX_MID dt_xmax(j,k)=GRIDWIDTH_M/xcmax(k,j+gj0-1) - enddo - enddo + end do + end do niterx=1 do k=1,KMAX_MID @@ -393,15 +399,15 @@ subroutine advecdiff_Eta niterx(j,k) = int(dt_advec/dt_xmax(j,k))+1 dt_x(j,k) = dt_advec/real(niterx(j,k)) !if(me==0)write(*,*)'x',me,j,k,niterx(j,k),xcmax(k,j+gj0-1) - enddo - enddo + end do + end do do k=1,KMAX_MID do i=1,limax nitery(i,k) = int(dt_advec/dt_ymax(i,k))+1 dt_y(i,k) = dt_advec/real(nitery(i,k)) - enddo - enddo + end do + end do !Courant number in vertical sigma coordinates: sigmadot*dt/deltasigma ! @@ -420,7 +426,7 @@ subroutine advecdiff_Eta sdcmax = maxval(max(Etadot(1:limax,1:ljmax,k+1,1),0.0) & -min(Etadot(1:limax,1:ljmax,k ,1),0.0)) scmax = max(sdcmax/dhs1(k+1),scmax) - enddo + end do CALL MPI_ALLREDUCE(MPI_IN_PLACE,scmax,1,MPI_DOUBLE_PRECISION, & MPI_MAX,MPI_COMM_CALC,IERROR) @@ -442,22 +448,22 @@ subroutine advecdiff_Eta nxx=nxx+niterx(j,k)-1 if(niterx(j,k)>NITERXMAX)then nxxmin=nxxmin+niterx(j,k) - endif - enddo + end if + end do do i=1,limax nxy=nxy+nitery(i,k)-1 nyy=nyy+nitery(i,k)-1 - enddo + end do - enddo + end do if(me.eq.0)then ! write(*,43)KMAX_MID*ljmax,nxx,nxxmin,KMAX_MID*limax,nyy,niters - endif + end if !43 format('total iterations x, y, k: ',I4,' +',I4,' -',I4,', ',I5,' +',I3,',',I4) ! stop - call Add_2timing(20,tim_after,tim_before,"advecdiff:synchronization") + call Add_2timing(17,tim_after,tim_before,"advecdiff:synchronization") ! Start xys advection loop: iterxys = 0 @@ -467,16 +473,17 @@ subroutine advecdiff_Eta iterxys = iterxys + 1 do k = 1,KMAX_MID fac1=(dA(k)/Pref+dB(k))*xxdg + do j = lj0,lj1 if(niterx(j,k)<=NITERXMAX)then dth = dt_x(j,k)/GRIDWIDTH_M do iterx=1,niterx(j,k) ! send/receive in x-direction - call preadvx2(110+k+KMAX_MID*j & + call preadvx3(110+k+KMAX_MID*j & ,xn_adv(1,1,j,k),dpdeta(1,j,k),u_xmj(0,j,k,1)& ,xnw,xne & - ,psw,pse) + ,psw,pse,j,k,loc_frac_1d) ! x-direction call advx( & @@ -487,36 +494,20 @@ subroutine advecdiff_Eta ,dth,fac1,fluxx) do i = li0,li1 - if(USE_uEMEP)then - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - x=x-xm2(i,j)*fluxx(ix,i)*species_adv(ix)%molwt - xx=xx+xm2(i,j)*fluxx(ix,i-1)*species_adv(ix)%molwt - enddo - xn=xn!*uEMEPfac(k) - x=x!*uEMEPfac(k) - xx=xx!*uEMEPfac(k) - xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. outgoing flux - f_in=max(0.0,x)+max(0.0,xx)!positive part. incoming flux - loc_frac(i,j,k,ip)=(loc_frac(i,j,k,ip)*xn)/(xn+f_in+1.e-20) - endif + if(USE_uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_x(fluxx,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) xn_adv(:,i,j,k) = xn_adv(:,i,j,k)*psi dpdeta(i,j,k) = dpdeta0 - enddo - enddo !iter + end do + end do !iter - endif - enddo !j - ! enddo !k horizontal (x) advection + end if + end do !j + ! end do !k horizontal (x) advection - call Add_2timing(21,tim_after,tim_before,"advecdiff:advx") + call Add_2timing(18,tim_after,tim_before,"advecdiff:advx") ! y-direction ! do k = 1,KMAX_MID @@ -525,10 +516,10 @@ subroutine advecdiff_Eta do itery=1,nitery(i,k) ! send/receive in y-direction - call preadvy2(520+k & + call preadvy3(520+k & ,xn_adv(1,1,1,k),dpdeta(1,1,k),v_xmi(1,0,k,1) & ,xns, xnn & - ,pss, psn,i) + ,pss, psn,i,k,loc_frac_1d) call advy( & v_xmi(i,0,k,1),vs(i,k,1),vn(i,k,1) & @@ -538,64 +529,35 @@ subroutine advecdiff_Eta ,dth,fac1,fluxy) do j = lj0,lj1 - if(USE_uEMEP)then - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - x=x-xm2(i,j)*fluxy(ix,j)*species_adv(ix)%molwt - xx=xx+xm2(i,j)*fluxy(ix,j-1)*species_adv(ix)%molwt - enddo - xn=xn!*uEMEPfac(k) - x=x!*uEMEPfac(k) - xx=xx!*uEMEPfac(k) - xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. outgoing flux - f_in=max(0.0,x)+max(0.0,xx)!positive part. incoming flux - loc_frac(i,j,k,ip)=(loc_frac(i,j,k,ip)*xn)/(xn+f_in+1.e-20) - endif + if(USE_uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_y(fluxy,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) xn_adv(:,i,j,k) = xn_adv(:,i,j,k)*psi dpdeta(i,j,k) = dpdeta0 - enddo - enddo !iter + end do + end do !iter - enddo !i - enddo !k horizontal (y) advection + end do !i + end do !k horizontal (y) advection - call Add_2timing(23,tim_after,tim_before,"advecdiff:advy") + call Add_2timing(20,tim_after,tim_before,"advecdiff:advy") do iters=1,niters ! perform vertical advection do j = lj0,lj1 do i = li0,li1 - ! call adv_vert_zero(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s) - ! call adv_vert_fourth(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s) - call advvk(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) - if(USE_uEMEP)then - do k=KMIN_uemep,KMAX_MID - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - if(kKMAX_MID-uEMEP%Nvert)call uemep_adv_y(fluxy,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) xn_adv(:,i,j,k) = xn_adv(:,i,j,k)*psi dpdeta(i,j,k) = dpdeta0 - enddo - enddo !iter - enddo !i - ! enddo !k horizontal (y) advection + end do + end do !iter + end do !i + ! end do !k horizontal (y) advection - call Add_2timing(23,tim_after,tim_before,"advecdiff:preadvy,advy") + call Add_2timing(20,tim_after,tim_before,"advecdiff:preadvy,advy") ! do k = 1,KMAX_MID + do j = lj0,lj1 if(niterx(j,k)<=NITERXMAX)then dth = dt_x(j,k)/GRIDWIDTH_M do iterx=1,niterx(j,k) ! send/receive in x-direction - call preadvx2(21000+k+KMAX_MID*iterx+1000*j & + call preadvx3(21000+k+KMAX_MID*iterx+1000*j & ,xn_adv(1,1,j,k),dpdeta(1,j,k),u_xmj(0,j,k,1)& ,xnw,xne & - ,psw,pse) + ,psw,pse,j,k,loc_frac_1d) ! x-direction call advx( & @@ -694,65 +642,37 @@ subroutine advecdiff_Eta ,dth,fac1,fluxx) do i = li0,li1 - if(USE_uEMEP)then - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - x=x-xm2(i,j)*fluxx(ix,i)*species_adv(ix)%molwt - xx=xx+xm2(i,j)*fluxx(ix,i-1)*species_adv(ix)%molwt - enddo - xn=xn!*uEMEPfac(k) - x=x!*uEMEPfac(k) - xx=xx!*uEMEPfac(k) - xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. outgoing flux - f_in=max(0.0,x)+max(0.0,xx)!positive part. incoming flux - loc_frac(i,j,k,ip)=(loc_frac(i,j,k,ip)*xn)/(xn+f_in+1.e-20) - endif + if(USE_uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_x(fluxx,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) xn_adv(:,i,j,k) = xn_adv(:,i,j,k)*psi dpdeta(i,j,k) = dpdeta0 - enddo - enddo !iter - endif + end do + end do !iter + end if + + end do !j - enddo !j - enddo !k horizontal (x) advection + end do !k horizontal (x) advection - call Add_2timing(21,tim_after,tim_before,"advecdiff:preadvx,advx") + call Add_2timing(18,tim_after,tim_before,"advecdiff:preadvx,advx") do iters=1,niters ! perform vertical advection do j = lj0,lj1 do i = li0,li1 - ! call adv_vert_zero(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s) + if(vert_adv0th)then + call adv_vert_zero(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) + else ! call adv_vert_fourth(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s) - call advvk(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) + call advvk(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) + endif if(USE_uEMEP)then - do k=KMIN_uemep,KMAX_MID - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - if(k0)then @@ -840,7 +759,7 @@ subroutine advecdiff_Eta iproc+mey*NPROCX,100*mey+j+1000,MPI_COMM_CALC,MPISTATUS,IERROR) xn_advjktot(:) = xn_advjktot(:)+xn_advjk(:) ! isumtot=isumtot+isum - enddo + end do rfac=1.0/GIMAX xn_advjk(:) = xn_advjktot(:)*rfac ! write(*,*)'ISUM',mey,isumtot,isum,GIMAX @@ -848,106 +767,129 @@ subroutine advecdiff_Eta do iproc=1,NPROCX-1 CALL MPI_SEND(xn_advjk,8*NSPEC_ADV,MPI_BYTE, & iproc+mey*NPROCX,100*mey+j+3000,MPI_COMM_CALC,IERROR) - enddo - endif + end do + end if do i = li0,li1 xn_adv(:,i,j,k)= xn_advjk(:) - enddo + end do - endif - enddo - enddo + end if + end do + end do - call Add_2timing(25,tim_after,tim_before,"advecdiff:ps") + call Add_2timing(22,tim_after,tim_before,"advecdiff:ps") ! vertical diffusion ndiff = 1 !number of vertical diffusion iterations (the larger the better) do k = 2,KMAX_MID ds3(k) = dt_advec*dhs1i(k)*dhs2i(k) ds4(k) = dt_advec*dhs1i(k+1)*dhs2i(k) - enddo + end do ! sum is conserved under vertical diffusion ! sum = 0. ! do k=1,KMAX_MID ! sum = sum + xn_adv(1,4,4,k)/dhs1i(k+1) - ! enddo + ! end do ! write(*,*)'sum before diffusion ',me,sum do j = lj0,lj1 do i = li0,li1 if(USE_uEMEP)then - xn_k_old=0.0 - do k = 1,KMAX_MID - xn_k(k)=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - !assumes mixing ratios units, but weight by mass - xn_k(k)=xn_k(k)+xn_adv(ix,i,j,k)*species_adv(ix)%molwt + n=0 + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + n=n+1 + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + xn_k(1:KMAX_MID,isec_poll,n)=0.0 + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + !assumes mixing ratios units, but weight by mass + xn_k(k,isec_poll,n)=xn_k(k,isec_poll,n)+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) + end do + + xn_k(k,isec_poll,n)=xn_k(k,isec_poll,n)*loc_frac(isec_poll,dx,dy,i,j,k) + + end do + call vertdiff_1d(xn_k(1,isec_poll,n),EtaKz(i,j,1,1),ds3,ds4,ndiff)!does the same as vertdiffn, but for one component + end do + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + end do enddo - if(k==kmax_mid)xn_k_old=xn_k(KMAX_MID)!save for udiff - xn_k(k)=xn_k(k)*loc_frac(i,j,k,ip) enddo - call vertdiff_1d(xn_k,EtaKz(i,j,1,1),ds3,ds4,ndiff)!does the same as vertdiffn, but for one component - endif + end if -!________ vertical diffusion ______ + !________ vertical diffusion ______ call vertdiffn(xn_adv(1,i,j,1),EtaKz(i,j,1,1),ds3,ds4,ndiff) -!________ + !________ if(USE_uEMEP)then - do k = 2,KMAX_MID - x=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - !conversion from mixing ratio to mg/m2 - x=x+xn_adv(ix,i,j,k)*species_adv(ix)%molwt - enddo - loc_frac(i,j,k,ip)=xn_k(k)/(x+1.E-30) - !if(k==KMAX_MID)udiff(i,j)=(x-xn_k_old)*(dA(kmax_mid)+dB(kmax_mid)*ps(i,j,1))/ATWAIR/GRAV*1.0E6 - enddo - endif + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + x=0.0 + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + !conversion from mixing ratio to mg/m2 + x=x+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) + end do + n=0 + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + n=n+1 + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = xn_k(k,isec_poll,n)/(x+1.E-30) + end do + end do + end do + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + end do + end do + end if - enddo - enddo + end do + end do ! sum = 0. ! do k=1,KMAX_MID ! sum = sum + xn_adv(1,4,4,k)/dhs1i(k+1) - ! enddo + ! end do ! write(*,*)'sum after diffusion ',me,sum - call Add_2timing(22,tim_after,tim_before,"advecdiff:diffusion") + call Add_2timing(19,tim_after,tim_before,"advecdiff:diffusion") if(lj0.ne.1)then do k=KCHEMTOP,KMAX_MID do i = 1,limax xn_adv(:,i,1,k) = xn_adv(:,i,1,k)/((dA(k)+dB(k)*ps(i,1,1))*dEta_i(k)) - enddo - enddo - endif + end do + end do + end if if(li0.ne.1)then do k=KCHEMTOP,KMAX_MID do j=lj0,lj1 xn_adv(:,1,j,k) = xn_adv(:,1,j,k)/((dA(k)+dB(k)*ps(1,j,1))*dEta_i(k)) - enddo - enddo - endif + end do + end do + end if if(li1.ne.limax)then do k=KCHEMTOP,KMAX_MID do j=lj0,lj1 xn_adv(:,limax,j,k) = xn_adv(:,limax,j,k)/((dA(k)+dB(k)*ps(limax,j,1))*dEta_i(k)) - enddo - enddo - endif + end do + end do + end if if(lj1.ne.ljmax)then do k=KCHEMTOP,KMAX_MID do i = 1,limax xn_adv(:,i,ljmax,k) = xn_adv(:,i,ljmax,k)/((dA(k)+dB(k)*ps(i,ljmax,1))*dEta_i(k)) - enddo - enddo - endif + end do + end do + end if if(KCHEMTOP==2)then @@ -962,11 +904,11 @@ subroutine advecdiff_Eta fluxin_top(:) = fluxin_top(:) + & (xntop(:,i,j)-xn_adv(:,i,j,1))*(dA(1)+dB(1)*ps(i,j,1))*xxdg*xmd(i,j) end where - enddo - enddo + end do + end do xn_adv(:,:,:,1) = xntop(:,:,:) - endif + end if firstcall=.false. return @@ -1001,7 +943,7 @@ subroutine vgrid do k=1,KMAX_MID hscor1(k+1) = sigma_bnd(k) hscor2(k+1) = sigma_mid(k) - enddo + end do hscor1(KMAX_BND+1) = sigma_bnd(KMAX_BND) hscor1(1) = - sigma_bnd(2) @@ -1013,7 +955,7 @@ subroutine vgrid dhs1(k) = hscor1(k+1) - hscor1(k) dhs1i(k) = 1./dhs1(k) dhs2i(k) = 1./(hscor2(k+1) - hscor2(k)) - enddo + end do do k=2,KMAX_BND @@ -1053,7 +995,7 @@ subroutine vgrid alf(3,k) = dei*(alfa1(NADVS) -alfa1(NADVS-1))/3. alf(6,k) = dei*(alfa1(NADVS-2)-alfa1(NADVS)) /3. alf(9,k) = dei*(alfa1(NADVS-1)-alfa1(NADVS-2))/3. - enddo + end do do k=2,KMAX_MID alfnew(1,k,0) = alf(1,k) + 2.*alf(2,k)*corl2(k) & @@ -1092,7 +1034,7 @@ subroutine vgrid alfnew(6,k,1) = -alf(6,k+1)*dhs1i(k+1)*dhs1i(k+1) alfnew(9,k,0) = alf(9,k) *dhs1i(k) *dhs1i(k) alfnew(9,k,1) = -alf(9,k+1)*dhs1i(k+1)*dhs1i(k+1) - enddo + end do alfbegnew(1) = alfnew(1,2,0)+alfnew(4,2,0) alfbegnew(2) = alfnew(2,2,0)+alfnew(5,2,0) @@ -1132,7 +1074,7 @@ subroutine vgrid_Eta do k=1,KMAX_MID hscor1(k+1) = Eta_bnd(k) hscor2(k+1) = Eta_mid(k) - enddo + end do hscor1(KMAX_BND+1) = Eta_bnd(KMAX_BND) hscor1(1) = - Eta_bnd(2) @@ -1144,7 +1086,7 @@ subroutine vgrid_Eta dhs1(k) = hscor1(k+1) - hscor1(k) dhs1i(k) = 1./dhs1(k) dhs2i(k) = 1./(hscor2(k+1) - hscor2(k)) - enddo + end do do k=2,KMAX_BND @@ -1184,7 +1126,7 @@ subroutine vgrid_Eta alf(3,k) = dei*(alfa1(NADVS) -alfa1(NADVS-1))/3. alf(6,k) = dei*(alfa1(NADVS-2)-alfa1(NADVS)) /3. alf(9,k) = dei*(alfa1(NADVS-1)-alfa1(NADVS-2))/3. - enddo + end do do k=2,KMAX_MID alfnew(1,k,0) = alf(1,k) + 2.*alf(2,k)*corl2(k) & @@ -1223,7 +1165,7 @@ subroutine vgrid_Eta alfnew(6,k,1) = -alf(6,k+1)*dhs1i(k+1)*dhs1i(k+1) alfnew(9,k,0) = alf(9,k) *dhs1i(k) *dhs1i(k) alfnew(9,k,1) = -alf(9,k+1)*dhs1i(k+1)*dhs1i(k+1) - enddo + end do alfbegnew(1) = alfnew(1,2,0)+alfnew(4,2,0) alfbegnew(2) = alfnew(2,2,0)+alfnew(5,2,0) @@ -1264,7 +1206,7 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) do k = 1,KMAX_MID-1 fc(k) = sdot(k*LIMAX*LJMAX)*dt_s - enddo + end do fc(KMAX_MID) = -1. !-------------- calculate the advection ---------------------------- @@ -1294,7 +1236,7 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) fluxps(2) = max(0.,ps3d(0)*zzfl2 & +ps3d(LIMAX*LJMAX)*zzfl3) - endif + end if do k = klimlow,klimhig fc1 = fc(k) @@ -1333,7 +1275,7 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) +ps3d( k1 *LIMAX*LJMAX)*zzfl2 & +ps3d((k1+1)*LIMAX*LJMAX)*zzfl3) - enddo + end do if(fc(KMAX_MID-1).lt.0.)then fc1 = fc(KMAX_MID-1) @@ -1353,7 +1295,7 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) max(0.,ps3d((KMAX_MID-2)*LIMAX*LJMAX)*zzfl1 & +ps3d((KMAX_MID-1)*LIMAX*LJMAX)*zzfl2) - endif + end if k=1 do while(k.lt.KMAX_MID) @@ -1393,7 +1335,7 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) max(0.,ps3d((k-1)*LIMAX*LJMAX) & -(fluxps(k+1) - fluxps(k))*dhs1i(k+1)) k = k+1 - endif + end if else fluxk(:,k+1) = & min(xn_adv(:,(k-1)*LIMAX*LJMAX)*dhs1(k+1),fluxk(:,k+1)) @@ -1406,8 +1348,8 @@ subroutine advvk(xn_adv,ps3d,sdot,dt_s,fluxk) max(0.,ps3d((k-1)*LIMAX*LJMAX) & -(fluxps(k+1) - fluxps(k))*dhs1i(k+1)) k = k+1 - endif - enddo + end if + end do xn_adv(:,(KMAX_MID-1)*LIMAX*LJMAX) = & max(0.,xn_adv(:,(KMAX_MID-1)*LIMAX*LJMAX) & @@ -1424,7 +1366,6 @@ subroutine vertdiff(xn_adv,SigmaKz,ds3,ds4) ! executes vertical diffusion - use ModelConstants_ml , only : KCHEMTOP, EPSIL use ChemSpecs, only : NSPEC_ADV implicit none @@ -1444,7 +1385,7 @@ subroutine vertdiff(xn_adv,SigmaKz,ds3,ds4) do k = 1,KMAX_MID-1 adif(k) = SigmaKz(k*LIMAX*LJMAX)*ds3(k) bdif(k+1) = SigmaKz(k*LIMAX*LJMAX)*ds4(k) - enddo + end do cdif(KMAX_MID) = 1./(1. + bdif(KMAX_MID)) e1(KMAX_MID) = bdif(KMAX_MID)*cdif(KMAX_MID) @@ -1457,7 +1398,7 @@ subroutine vertdiff(xn_adv,SigmaKz,ds3,ds4) xn_adv(:,(k-1)*LIMAX*LJMAX) = & (xn_adv(:,(k-1)*LIMAX*LJMAX) & +adif(k)*xn_adv(:,(k)*LIMAX*LJMAX))*cdif(k) - enddo + end do cdif(1) = 1./(1. + adif(1) - adif(1)*e1(2)) xn_adv(:,0) = (xn_adv(:,0) + adif(1)*xn_adv(:,LIMAX*LJMAX))*cdif(1) @@ -1466,7 +1407,7 @@ subroutine vertdiff(xn_adv,SigmaKz,ds3,ds4) xn_adv(:,(k-1)*LIMAX*LJMAX) = & e1(k)*xn_adv(:,(k-2)*LIMAX*LJMAX) & +xn_adv(:,(k-1)*LIMAX*LJMAX) - enddo + end do end subroutine vertdiff ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -1475,8 +1416,6 @@ subroutine vertdiff_1d(xn_adv,SigmaKz,ds3,ds4,ndiff) ! executes vertical diffusion - use ModelConstants_ml , only : KCHEMTOP, EPSIL - implicit none ! input @@ -1498,7 +1437,7 @@ subroutine vertdiff_1d(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = 1,KMAX_MID-1 adif(k) = SigmaKz(k*LIMAX*LJMAX)*ds3(k)*ndiffi bdif(k+1) = SigmaKz(k*LIMAX*LJMAX)*ds4(k)*ndiffi - enddo + end do cdif(KMAX_MID) = 1./(1. + bdif(KMAX_MID)) e1(KMAX_MID) = bdif(KMAX_MID)*cdif(KMAX_MID) @@ -1506,7 +1445,7 @@ subroutine vertdiff_1d(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = KMAX_MID-1,2,-1 cdif(k) = 1./(1. + bdif(k) + adif(k) - adif(k)*e1(k+1)) e1(k) = bdif(k)*cdif(k) - enddo + end do cdif(1) = 1./(1. + adif(1) - adif(1)*e1(2)) @@ -1519,7 +1458,7 @@ subroutine vertdiff_1d(xn_adv,SigmaKz,ds3,ds4,ndiff) xn_adv(k) = & (xn_adv(k) & +adif(k)*xn_adv(k+1))*cdif(k) - enddo + end do xn_adv(1) = (xn_adv(1) + adif(1)*xn_adv(2))*cdif(1) @@ -1527,8 +1466,8 @@ subroutine vertdiff_1d(xn_adv,SigmaKz,ds3,ds4,ndiff) xn_adv(k) = & e1(k)*xn_adv(k-1) & +xn_adv(k) - enddo - enddo + end do + end do end subroutine vertdiff_1d @@ -1548,7 +1487,6 @@ subroutine vertdiffn(xn_adv,SigmaKz,ds3,ds4,ndiff) ! SigmaKz(k)*ds4(k)= SigmaKz(k)*dt_advec*dhs1i(k+1)*dhs2i(k) ! = SigmaKz(k+1)*dt_advec/(sigma_bnd(k+1)-sigma_bnd(k))/(sigma_mid(k)-sigma_mid(k-1)) - use ModelConstants_ml , only : KCHEMTOP, EPSIL use ChemSpecs, only : NSPEC_ADV implicit none @@ -1565,7 +1503,7 @@ subroutine vertdiffn(xn_adv,SigmaKz,ds3,ds4,ndiff) integer k,n - real, dimension(0:KMAX_MID-1) :: adif,bdif,cdif,e1 + real, dimension(0:KMAX_MID-1) :: adif,bdif,cdif,e1 real ndiffi @@ -1574,7 +1512,7 @@ subroutine vertdiffn(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = 1,KMAX_MID-1 adif(k-1) = SigmaKz(k*LIMAX*LJMAX)*ds3(k)*ndiffi bdif(k) = SigmaKz(k*LIMAX*LJMAX)*ds4(k)*ndiffi - enddo + end do cdif(KMAX_MID-1) = 1./(1. + bdif(KMAX_MID-1)) e1(KMAX_MID-1) = bdif(KMAX_MID-1)*cdif(KMAX_MID-1) @@ -1582,7 +1520,7 @@ subroutine vertdiffn(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = KMAX_MID-2,1,-1 cdif(k) = 1./(1. + bdif(k) + adif(k) - adif(k)*e1(k+1)) e1(k) = bdif(k)*cdif(k) - enddo + end do cdif(0) = 1./(1. + adif(0) - adif(0)*e1(1)) @@ -1593,15 +1531,15 @@ subroutine vertdiffn(xn_adv,SigmaKz,ds3,ds4,ndiff) xn_adv(:,k*LIMAX*LJMAX) = & (xn_adv(:,k*LIMAX*LJMAX) & +adif(k)*xn_adv(:,(k+1)*LIMAX*LJMAX))*cdif(k) - enddo + end do do k = 1,KMAX_MID-1 xn_adv(:,k*LIMAX*LJMAX) = & e1(k)*xn_adv(:,(k-1)*LIMAX*LJMAX) & +xn_adv(:,k*LIMAX*LJMAX) - enddo + end do - enddo ! ndiff + end do ! ndiff end subroutine vertdiffn @@ -1611,7 +1549,6 @@ subroutine vertdiffn2(xn_adv,SigmaKz,ds3,ds4,ndiff) ! executes vertical diffusion ndiff times - use ModelConstants_ml , only : KCHEMTOP, EPSIL use ChemSpecs, only : NSPEC_ADV implicit none @@ -1628,7 +1565,7 @@ subroutine vertdiffn2(xn_adv,SigmaKz,ds3,ds4,ndiff) integer k,n - real, dimension(KMAX_MID) :: adif,bdif,cdif,e1 + real, dimension(KMAX_MID) :: adif,bdif,cdif,e1 real ndiffi @@ -1637,7 +1574,7 @@ subroutine vertdiffn2(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = 1,KMAX_MID-1 adif(k) = SigmaKz(k*LIMAX*LJMAX)*ds3(k)*ndiffi bdif(k+1) = SigmaKz(k*LIMAX*LJMAX)*ds4(k)*ndiffi - enddo + end do cdif(KMAX_MID) = 1./(1. + bdif(KMAX_MID)) e1(KMAX_MID) = bdif(KMAX_MID)*cdif(KMAX_MID) @@ -1645,7 +1582,7 @@ subroutine vertdiffn2(xn_adv,SigmaKz,ds3,ds4,ndiff) do k = KMAX_MID-1,2,-1 cdif(k) = 1./(1. + bdif(k) + adif(k) - adif(k)*e1(k+1)) e1(k) = bdif(k)*cdif(k) - enddo + end do cdif(1) = 1./(1. + adif(1) - adif(1)*e1(2)) @@ -1657,15 +1594,15 @@ subroutine vertdiffn2(xn_adv,SigmaKz,ds3,ds4,ndiff) xn_adv(:,k*LIMAX*LJMAX) = & (xn_adv(:,k*LIMAX*LJMAX) & +adif(k+1)*xn_adv(:,(k+1)*LIMAX*LJMAX))*cdif(k+1) - enddo + end do do k = 1,KMAX_MID-1 xn_adv(:,k*LIMAX*LJMAX) = & e1(k+1)*xn_adv(:,(k-1)*LIMAX*LJMAX) & +xn_adv(:,k*LIMAX*LJMAX) - enddo + end do - enddo ! ndiff + end do ! ndiff end subroutine vertdiffn2 @@ -1684,7 +1621,7 @@ subroutine advx(vel,velbeg,velend & ! in such a way that a Courant number of one corresponds exactly to "empty" a cell. ! (small effects on results: less than 1%) - use Par_ml , only : me,li0,li1,limax + use Par_ml , only : li0,li1,limax use ChemSpecs, only : NSPEC_ADV use MassBudget_ml , only : fluxin,fluxout implicit none @@ -1692,8 +1629,8 @@ subroutine advx(vel,velbeg,velend & ! parameter: ! input real,intent(in) :: vel(0:LIMAX),velbeg, velend - real,intent(in),dimension(NSPEC_ADV,3) :: xnbeg,xnend - real,intent(in),dimension(3) :: psbeg,psend + real,intent(in),dimension(NSPEC_ADV,3) :: xnbeg,xnend + real,intent(in),dimension(3) :: psbeg,psend real,intent(in),dimension(0:LIMAX+1):: xm2loc,xmdloc real,intent(in) :: dth,fac1 @@ -1733,36 +1670,36 @@ subroutine advx(vel,velbeg,velend & flux(:,ij)=C1*xn_adv(:,ij) fluxps(ij)=C1*ps3d(ij) else - flux(:,ij)=C1*xn_adv(:,ij+1) + flux(:,ij)=C1*xn_adv(:,ij+1) fluxps(ij)=C1*ps3d(ij+1) - endif - enddo + end if + end do ij=0 C1=vel(ij)*dth!*xm2(i,j) if(C1>0.0)then flux(:,ij)=C1*xnbeg(:,3) fluxps(ij)=C1*psbeg(3) else - flux(:,ij)=C1*xn_adv(:,ij+1) + flux(:,ij)=C1*xn_adv(:,ij+1) fluxps(ij)=C1*ps3d(ij+1) - endif + end if ij=limax C1=vel(ij)*dth!*xm2(i,j) if(C1>0.0)then flux(:,ij)=C1*xn_adv(:,ij) fluxps(ij)=C1*ps3d(ij) else - flux(:,ij)=C1*xnend(:,1) + flux(:,ij)=C1*xnend(:,1) fluxps(ij)=C1*psend(1) - endif + end if !apply fluxes do ij=li0,li1 xn_adv(:,ij) = max(0.0,xn_adv(:,ij) & -xm2loc(ij)*(flux(:,ij)-flux(:,ij-1))) ps3d(ij) = max(0.0,ps3d(ij) & - -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) + end do else @@ -1788,8 +1725,8 @@ subroutine advx(vel,velbeg,velend & zzfc(4,-1) = hh3+hh4 zzfc(2,-1) = hh3-hh4 - endif - endif + end if + end if do 10 ij = li0-1,li1 fc(ij) = vel(ij)*dth @@ -1838,8 +1775,8 @@ subroutine advx(vel,velbeg,velend & zzfc(4,li1+1) = hh3+hh4 zzfc(2,li1+1) = hh3-hh4 - endif - endif + end if + end if !------- boundary treatment ----------------------------------------- @@ -1901,8 +1838,8 @@ subroutine advx(vel,velbeg,velend & + ps3d(li0) *zzfc(3,li0-1) & + psbeg(3) *zzfc(2,li0-1) & + psbeg(2) *zzfc(1,li0-1)) - endif - endif + end if + end if ! integrated flux form @@ -1928,7 +1865,7 @@ subroutine advx(vel,velbeg,velend & + ps3d(li0+1)*zzfc(3,li0) & + ps3d(li0) *zzfc(2,li0) & + psbeg(3) *zzfc(1,li0)) - endif + end if if(fc(li0+1).ge.0.)then @@ -1944,7 +1881,7 @@ subroutine advx(vel,velbeg,velend & + ps3d(li0+1)*zzfc(3,li0+1) & + ps3d(li0) *zzfc(2,li0+1) & + psbeg(3) *zzfc(1,li0+1)) - endif + end if lijb = li0+2 if(fc(li0+1).lt.0.)lijb = li0+1 @@ -1969,7 +1906,7 @@ subroutine advx(vel,velbeg,velend & + ps3d(ijn-1)*zzfc(2,ij) & + ps3d(ijn-2)*zzfc(1,ij)) - enddo + end do if(fc(li1-2).lt.0)then @@ -1985,7 +1922,7 @@ subroutine advx(vel,velbeg,velend & + ps3d(li1-1)*zzfc(3,li1-2) & + ps3d(li1-2)*zzfc(2,li1-2) & + ps3d(li1-3)*zzfc(1,li1-2)) - endif + end if ! integrated flux form @@ -2011,7 +1948,7 @@ subroutine advx(vel,velbeg,velend & + ps3d(li1) *zzfc(3,li1-1) & + ps3d(li1-1)*zzfc(2,li1-1) & + ps3d(li1-2)*zzfc(1,li1-1)) - endif + end if ! integrated flux form @@ -2039,7 +1976,7 @@ subroutine advx(vel,velbeg,velend & + psend(1) *zzfc(3,li1) & + ps3d(li1) *zzfc(2,li1) & + ps3d(li1-1)*zzfc(1,li1)) - endif + end if else @@ -2066,13 +2003,13 @@ subroutine advx(vel,velbeg,velend & + ps3d(li1) *zzfc(2,li1+1) & + ps3d(li1-1)*zzfc(1,li1+1)) - endif + end if if(limtlow.eq.-1)then hel1(:) = xnbeg(:,3)*xmdloc(0) hel2(:) = flux(:,0) + flux(:,-1) - where(hel1(:).lt.hel2(:)) flux(:,0)=flux(:,0)*hel1(:)/(hel2(:)+1.0E-100) + where(hel1(:).lt.hel2(:)) flux(:,0)=flux(:,0)*hel1(:)/(hel2(:)+1d-100) hel1ps = psbeg(3)*xmdloc(0) hel2ps = fluxps(0) + fluxps(-1) if(hel1ps.lt.hel2ps) fluxps(0) = fluxps(0)*hel1ps/hel2ps @@ -2091,8 +2028,8 @@ subroutine advx(vel,velbeg,velend & hel1(:) = xn_adv(:,li0)*xmdloc(li0) hel2(:) = flux(:,li0) + flux(:,li0-1) where(hel1(:).lt.hel2(:)) - flux(:,li0-1) =-flux(:,li0-1)*hel1(:)/(hel2(:)+1.0E-100) - flux(:,li0) = flux(:,li0 )*hel1(:)/(hel2(:)+1.0E-100) + flux(:,li0-1) =-flux(:,li0-1)*hel1(:)/(hel2(:)+1d-100) + flux(:,li0) = flux(:,li0 )*hel1(:)/(hel2(:)+1d-100) xn_adv(:,li0) = 0. elsewhere flux(:,li0-1) =-flux(:,li0-1) @@ -2107,11 +2044,11 @@ subroutine advx(vel,velbeg,velend & else fluxps(li0-1) =-fluxps(li0-1) ps3d(li0) =xm2loc(li0)*(hel1ps-hel2ps) - endif + end if ij = li0+1 - endif - endif - endif + end if + end if + end if ijpasses = 0 do while(.true.) @@ -2126,8 +2063,8 @@ subroutine advx(vel,velbeg,velend & ije2(ijpasses) = -5 ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb2(ijpasses) = ij ije2(ijpasses) = -5 do while(fc(ij+1).lt.0.) @@ -2136,12 +2073,12 @@ subroutine advx(vel,velbeg,velend & if(ij.gt.li1-1)then ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb3(ijpasses) = ij ij = ij+2 if(ij.gt.li1-1)goto 257 - enddo + end do 257 continue ijdoend = .false. @@ -2155,7 +2092,7 @@ subroutine advx(vel,velbeg,velend & fluxps(ij) = min(ps3d(ij)*xmdloc(ij),fluxps(ij)) ps3d(ij) = max(0.,ps3d(ij) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do do ij = ijb2(ijll),ije2(ijll) flux(:,ij) =-min(xn_adv(:,ij+1)*xmdloc(ij+1),flux(:,ij)) xn_adv(:,ij) = max(0.,xn_adv(:,ij) & @@ -2163,7 +2100,7 @@ subroutine advx(vel,velbeg,velend & fluxps(ij) =-min(ps3d(ij+1)*xmdloc(ij+1),fluxps(ij)) ps3d(ij) = max(0.,ps3d(ij) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do ij = ijb3(ijll) if(ij.lt.-3) goto 357 hel1(:) = xn_adv(:,ij+1)*xmdloc(ij+1) @@ -2171,8 +2108,8 @@ subroutine advx(vel,velbeg,velend & where(hel1(:).lt.hel2(:)) !On IBM machine the division can give overflow if hel2 is too small - flux(:,ij) =-(flux(:,ij) *hel1(:))/(hel2(:)+1.0E-100) - flux(:,ij+1) = (flux(:,ij+1)*hel1(:))/(hel2(:)+1.0E-100) + flux(:,ij) =-(flux(:,ij) *hel1(:))/(hel2(:)+1d-100) + flux(:,ij+1) = (flux(:,ij+1)*hel1(:))/(hel2(:)+1d-100) xn_adv(:,ij+1) = 0. elsewhere flux(:,ij) = -flux(:,ij) @@ -2191,9 +2128,9 @@ subroutine advx(vel,velbeg,velend & else fluxps(ij) = -fluxps(ij) ps3d(ij+1) = xm2loc(ij+1)*(hel1ps-hel2ps) - endif + end if ps3d(ij) = max(0.,ps3d(ij)-xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do 357 continue @@ -2202,7 +2139,7 @@ subroutine advx(vel,velbeg,velend & hel1(:) = xnend(:,1)*xmdloc(li1+1) hel2(:) = flux(:,li1+1) + flux(:,li1) where(hel1(:).lt.hel2(:)) - flux(:,li1) =-flux(:,li1)*hel1(:)/(hel2(:)+1.0E-100) + flux(:,li1) =-flux(:,li1)*hel1(:)/(hel2(:)+1d-100) elsewhere flux(:,li1) =-flux(:,li1) end where @@ -2214,7 +2151,7 @@ subroutine advx(vel,velbeg,velend & fluxps(li1) = -fluxps(li1)*hel1ps/hel2ps else fluxps(li1) = -fluxps(li1) - endif + end if ps3d(li1) =max(0.,ps3d(li1) & -xm2loc(li1)*(fluxps(li1)-fluxps(li1-1))) @@ -2234,11 +2171,11 @@ subroutine advx(vel,velbeg,velend & fluxps(li1) =-min(psend(1)*xmdloc(li1+1),fluxps(li1)) ps3d(li1) = max(0.,ps3d(li1) & -xm2loc(li1)*(fluxps(li1)-fluxps(li1-1))) - endif - endif - endif + end if + end if + end if -endif +end if ! accumulation of the boundary fluxes @@ -2247,16 +2184,16 @@ subroutine advx(vel,velbeg,velend & fluxin(:) = fluxin(:) + flux(:,1)*fac1 else fluxout(:) = fluxout(:) - flux(:,1)*fac1 - endif - endif + end if + end if if (li1.eq.limax-1) then if(fc(li1).ge.0.)then fluxout(:) = fluxout(:) + flux(:,li1)*fac1 else fluxin(:) = fluxin(:) - flux(:,li1)*fac1 - endif - endif + end if + end if end subroutine advx @@ -2284,8 +2221,8 @@ subroutine advy(vel,velbeg,velend & ! parameter: ! input real,intent(in) :: vel(0:LIMAX*LJMAX),velbeg, velend - real,intent(in),dimension(NSPEC_ADV,3) :: xnbeg,xnend - real,intent(in),dimension(3) :: psbeg,psend + real,intent(in),dimension(NSPEC_ADV,3) :: xnbeg,xnend + real,intent(in),dimension(3) :: psbeg,psend real,intent(in),dimension(0:LJMAX+1):: xm2loc,xmdloc real,intent(in):: dth,fac1 @@ -2326,28 +2263,28 @@ subroutine advy(vel,velbeg,velend & flux(:,ij)=C1*xn_adv(:,ij*LIMAX) fluxps(ij)=C1*ps3d(ij*LIMAX) else - flux(:,ij)=C1*xn_adv(:,(ij+1)*LIMAX) + flux(:,ij)=C1*xn_adv(:,(ij+1)*LIMAX) fluxps(ij)=C1*ps3d((ij+1)*LIMAX) - endif - enddo + end if + end do ij=0 C1=vel(ij*LIMAX)*dth!*xm2(i,j) if(C1>0.0)then flux(:,ij)=C1*xnbeg(:,3) fluxps(ij)=C1*psbeg(3) else - flux(:,ij)=C1*xn_adv(:,(ij+1)*LIMAX) + flux(:,ij)=C1*xn_adv(:,(ij+1)*LIMAX) fluxps(ij)=C1*ps3d((ij+1)*LIMAX) - endif + end if ij=ljmax C1=vel(ij*LIMAX)*dth!*xm2(i,j) if(C1>0.0)then flux(:,ij)=C1*xn_adv(:,ij*LIMAX) fluxps(ij)=C1*ps3d(ij*LIMAX) else - flux(:,ij)=C1*xnend(:,1) + flux(:,ij)=C1*xnend(:,1) fluxps(ij)=C1*psend(1) - endif + end if !apply fluxes do ij=lj0,lj1 @@ -2358,7 +2295,7 @@ subroutine advy(vel,velbeg,velend & ps3d(ij*LIMAX) = & max(0.0,ps3d(ij*LIMAX) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do else @@ -2384,8 +2321,8 @@ subroutine advy(vel,velbeg,velend & zzfc(4,-1) = hh3+hh4 zzfc(2,-1) = hh3-hh4 - endif - endif + end if + end if do 10 ij = lj0-1,lj1 fc(ij) = vel(ij*LIMAX)*dth @@ -2433,8 +2370,8 @@ subroutine advy(vel,velbeg,velend & zzfc(4,lj1+1) = hh3+hh4 zzfc(2,lj1+1) = hh3-hh4 - endif - endif + end if + end if !------- boundary treatment ----------------------------------------- @@ -2496,8 +2433,8 @@ subroutine advy(vel,velbeg,velend & + ps3d( lj0 *LIMAX)*zzfc(3,lj0-1) & + psbeg(3) *zzfc(2,lj0-1) & + psbeg(2) *zzfc(1,lj0-1)) - endif - endif + end if + end if ! integrated flux form @@ -2523,7 +2460,7 @@ subroutine advy(vel,velbeg,velend & + ps3d((lj0+1)*LIMAX)*zzfc(3,lj0) & + ps3d( lj0 *LIMAX)*zzfc(2,lj0) & + psbeg(3) *zzfc(1,lj0)) - endif + end if if(fc(lj0+1).ge.0.)then @@ -2539,7 +2476,7 @@ subroutine advy(vel,velbeg,velend & + ps3d((lj0+1)*LIMAX)*zzfc(3,lj0+1) & + ps3d( lj0 *LIMAX)*zzfc(2,lj0+1) & + psbeg(3) *zzfc(1,lj0+1)) - endif + end if lijb = lj0+2 @@ -2566,7 +2503,7 @@ subroutine advy(vel,velbeg,velend & + ps3d((ijn-1)*LIMAX)*zzfc(2,ij) & + ps3d((ijn-2)*LIMAX)*zzfc(1,ij)) - enddo + end do if(fc(lj1-2).lt.0.)then @@ -2584,7 +2521,7 @@ subroutine advy(vel,velbeg,velend & + ps3d((lj1-2)*LIMAX)*zzfc(2,lj1-2) & + ps3d((lj1-3)*LIMAX)*zzfc(1,lj1-2)) - endif + end if ! integrated flux form @@ -2614,7 +2551,7 @@ subroutine advy(vel,velbeg,velend & + ps3d((lj1-1)*LIMAX)*zzfc(2,lj1-1) & + ps3d((lj1-2)*LIMAX)*zzfc(1,lj1-1)) - endif + end if ! integrated flux form @@ -2645,7 +2582,7 @@ subroutine advy(vel,velbeg,velend & + ps3d( lj1 *LIMAX)*zzfc(2,lj1) & + ps3d((lj1-1)*LIMAX)*zzfc(1,lj1)) - endif + end if else @@ -2672,12 +2609,12 @@ subroutine advy(vel,velbeg,velend & + ps3d( lj1 *LIMAX)*zzfc(2,lj1+1) & + ps3d((lj1-1)*LIMAX)*zzfc(1,lj1+1)) - endif + end if if(limtlow.eq.-1)then hel1(:) = xnbeg(:,3)*xmdloc(0) hel2(:) = flux(:,0) + flux(:,-1) - where(hel1(:).lt.hel2(:)) flux(:,0)=flux(:,0)*hel1(:)/(hel2(:)+1.0E-100) + where(hel1(:).lt.hel2(:)) flux(:,0)=flux(:,0)*hel1(:)/(hel2(:)+1d-100) hel1ps = psbeg(3)*xmdloc(0) hel2ps = fluxps(0) + fluxps(-1) if(hel1ps.lt.hel2ps) fluxps(0)=fluxps(0)*hel1ps/hel2ps @@ -2696,8 +2633,8 @@ subroutine advy(vel,velbeg,velend & hel1(:) = xn_adv(:,lj0*LIMAX)*xmdloc(lj0) hel2(:) = flux(:,lj0) + flux(:,lj0-1) where(hel1(:).lt.hel2(:)) - flux(:,lj0-1) =-flux(:,lj0-1)*hel1(:)/(hel2(:)+1.0E-100) - flux(:,lj0) = flux(:,lj0) *hel1(:)/(hel2(:)+1.0E-100) + flux(:,lj0-1) =-flux(:,lj0-1)*hel1(:)/(hel2(:)+1d-100) + flux(:,lj0) = flux(:,lj0) *hel1(:)/(hel2(:)+1d-100) xn_adv(:,lj0*LIMAX) = 0. elsewhere flux(:,lj0-1) =-flux(:,lj0-1) @@ -2712,11 +2649,11 @@ subroutine advy(vel,velbeg,velend & else fluxps(lj0-1) =-fluxps(lj0-1) ps3d(lj0*LIMAX) =xm2loc(lj0)*(hel1ps-hel2ps) - endif + end if ij = lj0+1 - endif - endif - endif + end if + end if + end if ijpasses = 0 do while(.true.) @@ -2732,8 +2669,8 @@ subroutine advy(vel,velbeg,velend & ije2(ijpasses) = -5 ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb2(ijpasses) = ij ije2(ijpasses) = -5 do while(fc(ij+1).lt.0.) @@ -2742,12 +2679,12 @@ subroutine advy(vel,velbeg,velend & if(ij.gt.lj1-1)then ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb3(ijpasses) = ij ij = ij+2 if(ij.gt.lj1-1)goto 257 - enddo + end do 257 continue ijdoend = .false. @@ -2764,7 +2701,7 @@ subroutine advy(vel,velbeg,velend & ps3d(ij*LIMAX) = & max(0.,ps3d(ij*LIMAX) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do do ij = ijb2(ijll),ije2(ijll) flux(:,ij)=-min(xn_adv(:,(ij+1)*LIMAX)*xmdloc(ij+1),flux(:,ij)) xn_adv(:,ij*LIMAX) = & @@ -2774,15 +2711,15 @@ subroutine advy(vel,velbeg,velend & ps3d(ij*LIMAX) = & max(0.,ps3d(ij*LIMAX) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do ij = ijb3(ijll) if(ij.lt.-3) goto 357 hel1(:) = xn_adv(:,(ij+1)*LIMAX)*xmdloc(ij+1) hel2(:) = flux(:,ij+1) + flux(:,ij) where(hel1(:).lt.hel2(:)) !On IBM machine the division can give overflow if hel2 is too small - flux(:,ij) =-flux(:,ij) *hel1(:)/(hel2(:)+1.0E-100) - flux(:,ij+1) = flux(:,ij+1)*hel1(:)/(hel2(:)+1.0E-100) + flux(:,ij) =-flux(:,ij) *hel1(:)/(hel2(:)+1d-100) + flux(:,ij+1) = flux(:,ij+1)*hel1(:)/(hel2(:)+1d-100) xn_adv(:,(ij+1)*LIMAX) = 0. elsewhere flux(:,ij) =-flux(:,ij) @@ -2800,11 +2737,11 @@ subroutine advy(vel,velbeg,velend & else fluxps(ij) = -fluxps(ij) ps3d((ij+1)*LIMAX) = xm2loc(ij+1)*(hel1ps-hel2ps) - endif + end if ps3d(ij*LIMAX) = & max(0.,ps3d(ij*LIMAX) & -xm2loc(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do 357 continue @@ -2814,7 +2751,7 @@ subroutine advy(vel,velbeg,velend & hel1(:) = xnend(:,1)*xmdloc(lj1+1) hel2(:) = flux(:,lj1+1) + flux(:,lj1) where(hel1(:).lt.hel2(:)) - flux(:,lj1) =-flux(:,lj1)*hel1(:)/(hel2(:)+1.0E-100) + flux(:,lj1) =-flux(:,lj1)*hel1(:)/(hel2(:)+1d-100) elsewhere flux(:,lj1) =-flux(:,lj1) end where @@ -2827,7 +2764,7 @@ subroutine advy(vel,velbeg,velend & fluxps(lj1) =-fluxps(lj1)*hel1ps/hel2ps else fluxps(lj1) =-fluxps(lj1) - endif + end if ps3d(lj1*LIMAX) = & max(0.,ps3d(lj1*LIMAX) & -xm2loc(lj1)*(fluxps(lj1)-fluxps(lj1-1))) @@ -2856,11 +2793,11 @@ subroutine advy(vel,velbeg,velend & ps3d(lj1*LIMAX) = & max(0.,ps3d(lj1*LIMAX) & -xm2loc(lj1)*(fluxps(lj1)-fluxps(lj1-1))) - endif - endif - endif + end if + end if + end if -endif +end if ! accumulation of the boundary fluxes @@ -2869,16 +2806,16 @@ subroutine advy(vel,velbeg,velend & fluxin(:) = fluxin(:) + flux(:,1)*fac1 else fluxout(:) = fluxout(:) - flux(:,1)*fac1 - endif - endif + end if + end if if (lj1.eq.ljmax-1) then if(fc(lj1).ge.0.)then fluxout(:) = fluxout(:) + flux(:,lj1)*fac1 else fluxin(:) = fluxin(:) - flux(:,lj1)*fac1 - endif - endif + end if + end if end subroutine advy @@ -2904,7 +2841,7 @@ subroutine preadvx(msgnr & real,intent(out),dimension(3,LJMAX) :: psend,psbeg ! local - integer i, info + integer i real,dimension(NSPEC_ADV, 3, LJMAX) :: buf_xn_w,buf_xn_e real,dimension(3, LJMAX) :: buf_ps_w,buf_ps_e @@ -2922,13 +2859,13 @@ subroutine preadvx(msgnr & buf_ps_w(1,i) = ps3d(i*LIMAX) buf_ps_w(2,i) = ps3d(i*LIMAX+1) buf_ps_w(3,i) = ps3d(i*LIMAX+2) - enddo + end do CALL MPI_ISEND( buf_xn_w, 8*3*LJMAX*NSPEC_ADV, MPI_BYTE, & neighbor(WEST), msgnr , MPI_COMM_CALC, request_xn_w, IERROR) CALL MPI_ISEND( buf_ps_w, 8*3*LJMAX ,MPI_BYTE, & neighbor(WEST), msgnr+100, MPI_COMM_CALC, request_w, IERROR) - endif + end if if (neighbor(EAST).ge.0) then do i = lj0,lj1 @@ -2939,13 +2876,13 @@ subroutine preadvx(msgnr & buf_ps_e(1,i) = ps3d(i*LIMAX+li1-3) buf_ps_e(2,i) = ps3d(i*LIMAX+li1-2) buf_ps_e(3,i) = ps3d(i*LIMAX+li1-1) - enddo + end do CALL MPI_ISEND( buf_xn_e, 8*3*LJMAX*NSPEC_ADV, MPI_BYTE, & neighbor(EAST), msgnr+200, MPI_COMM_CALC, request_xn_e, IERROR) CALL MPI_ISEND( buf_ps_e, 8*3*LJMAX , MPI_BYTE, & neighbor(EAST), msgnr+300, MPI_COMM_CALC, request_e, IERROR) - endif + end if if (neighbor(WEST).lt.0) then @@ -2966,15 +2903,15 @@ subroutine preadvx(msgnr & psbeg(1,i) = ps3d(i*LIMAX) psbeg(2,i) = ps3d(i*LIMAX) psbeg(3,i) = ps3d(i*LIMAX) - endif - enddo + end if + end do else CALL MPI_RECV( xnbeg, 8*LJMAX*3*NSPEC_ADV, MPI_BYTE, & neighbor(WEST), msgnr+200, MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psbeg, 8*LJMAX*3 , MPI_BYTE, & neighbor(WEST), msgnr+300, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if if (neighbor(EAST).lt.0) then do i = lj0,lj1 @@ -2996,25 +2933,25 @@ subroutine preadvx(msgnr & psend(1,i) = ps3d(i*LIMAX+li1) psend(2,i) = ps3d(i*LIMAX+li1) psend(3,i) = ps3d(i*LIMAX+li1) - endif - enddo + end if + end do else CALL MPI_RECV( xnend, 8*LJMAX*3*NSPEC_ADV, MPI_BYTE, & neighbor(EAST), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psend, 8*LJMAX*3 , MPI_BYTE, & neighbor(EAST), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if ! synchronizing sent buffers (must be done for all ISENDs!!!) if (neighbor(WEST) .ge. 0) then CALL MPI_WAIT(request_xn_w, MPISTATUS, IERROR) CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif + end if if (neighbor(EAST) .ge. 0) then CALL MPI_WAIT(request_xn_e, MPISTATUS, IERROR) CALL MPI_WAIT(request_e, MPISTATUS, IERROR) - endif + end if end subroutine preadvx ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -3026,7 +2963,7 @@ subroutine preadvx2(msgnr & !send only one row - use Par_ml , only : lj0,lj1,li1,neighbor,WEST,EAST + use Par_ml , only : li1,neighbor,WEST,EAST use ChemSpecs, only : NSPEC_ADV implicit none @@ -3037,14 +2974,14 @@ subroutine preadvx2(msgnr & ,vel(LIMAX+1:(LIMAX+1)*(LJMAX+1)) ! output - real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg - real,intent(out),dimension(3) :: psend,psbeg + real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg + real,intent(out),dimension(3) :: psend,psbeg ! local - integer i, info + integer i - real,dimension(NSPEC_ADV,3) :: buf_xn_w,buf_xn_e - real,dimension(3) :: buf_ps_w,buf_ps_e + real,dimension(NSPEC_ADV,3) :: buf_xn_w,buf_xn_e + real,dimension(3) :: buf_ps_w,buf_ps_e ! Initialize arrays holding boundary slices @@ -3059,13 +2996,13 @@ subroutine preadvx2(msgnr & buf_ps_w(1) = ps3d(i*LIMAX) buf_ps_w(2) = ps3d(i*LIMAX+1) buf_ps_w(3) = ps3d(i*LIMAX+2) - enddo + end do CALL MPI_ISEND( buf_xn_w, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(WEST), msgnr , MPI_COMM_CALC, request_xn_w, IERROR) CALL MPI_ISEND( buf_ps_w, 8*3 , MPI_BYTE,& neighbor(WEST), msgnr+100, MPI_COMM_CALC, request_w, IERROR) - endif + end if if (neighbor(EAST).ge.0) then do i = 1,1!lj0,lj1 @@ -3076,13 +3013,13 @@ subroutine preadvx2(msgnr & buf_ps_e(1) = ps3d(i*LIMAX+li1-3) buf_ps_e(2) = ps3d(i*LIMAX+li1-2) buf_ps_e(3) = ps3d(i*LIMAX+li1-1) - enddo + end do CALL MPI_ISEND( buf_xn_e, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(EAST), msgnr+200, MPI_COMM_CALC, request_xn_e, IERROR) CALL MPI_ISEND( buf_ps_e, 8*3 , MPI_BYTE,& neighbor(EAST), msgnr+300, MPI_COMM_CALC, request_e, IERROR) - endif + end if if (neighbor(WEST).lt.0) then @@ -3103,15 +3040,15 @@ subroutine preadvx2(msgnr & psbeg(1) = ps3d(i*LIMAX) psbeg(2) = ps3d(i*LIMAX) psbeg(3) = ps3d(i*LIMAX) - endif - enddo + end if + end do else CALL MPI_RECV( xnbeg, 8*3*NSPEC_ADV, MPI_BYTE, & neighbor(WEST), msgnr+200, MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psbeg, 8*3 , MPI_BYTE, & neighbor(WEST), msgnr+300, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if if (neighbor(EAST).lt.0) then do i = 1,1!lj0,lj1 @@ -3133,27 +3070,251 @@ subroutine preadvx2(msgnr & psend(1) = ps3d(i*LIMAX+li1) psend(2) = ps3d(i*LIMAX+li1) psend(3) = ps3d(i*LIMAX+li1) - endif - enddo + end if + end do else CALL MPI_RECV( xnend, 8*3*NSPEC_ADV, MPI_BYTE, & neighbor(EAST), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psend, 8*3 , MPI_BYTE, & neighbor(EAST), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if ! synchronizing sent buffers (must be done for all ISENDs!!!) if (neighbor(WEST) .ge. 0) then CALL MPI_WAIT(request_xn_w, MPISTATUS, IERROR) CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif + end if if (neighbor(EAST) .ge. 0) then CALL MPI_WAIT(request_xn_e, MPISTATUS, IERROR) CALL MPI_WAIT(request_e, MPISTATUS, IERROR) - endif + end if end subroutine preadvx2 +! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + subroutine preadvx3(msgnr & + ,xn_adv,ps3d,vel & + ,xnbeg, xnend & + ,psbeg, psend,j,k,loc_frac_1d) + + ! Initialize arrays holding boundary slices + + use Par_ml , only : li1,neighbor,WEST,EAST + use ChemSpecs, only : NSPEC_ADV + implicit none + +! input + integer,intent(in):: msgnr,j,k + real,intent(in):: xn_adv(NSPEC_ADV,LIMAX:LIMAX*(LJMAX+1)) + real,intent(in):: ps3d(LIMAX:LIMAX*(LJMAX+1)) & + ,vel(LIMAX+1:(LIMAX+1)*(LJMAX+1)) + +! output + real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg + real,intent(out),dimension(3) :: psend,psbeg + real,intent(inout),dimension(uEMEP_Size1,0:limax+1) :: loc_frac_1d + +! local + integer n,i,dx,dy,isec_poll, ii, uEMEP_Size1_local + + real,dimension((NSPEC_ADV+1)*3+uEMEP_Size1) :: send_buf_w, rcv_buf_w, send_buf_e, rcv_buf_e + + uEMEP_Size1_local = 0!default: do not treat this region + + if(uEMEP_Size1>0 .and. k>KMAX_MID-uEMEP%Nvert)then + uEMEP_Size1_local = uEMEP_Size1!treat this region + do i=li0,li1 + n=0 + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=1,uEMEP%Nsec_poll + n=n+1 + loc_frac_1d(n,i) = loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + enddo + endif + ! Initialize arrays holding boundary slices + ! send to WEST neighbor if any + if (neighbor(WEST).ge.0) then + n=0 + do ii=1,NSPEC_ADV + n=n+1 + send_buf_w(n) = xn_adv(ii,LIMAX) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_w(n) = xn_adv(ii,LIMAX+1) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_w(n) = xn_adv(ii,LIMAX+2) + end do + n=n+1 + send_buf_w(n) = ps3d(LIMAX) + n=n+1 + send_buf_w(n) = ps3d(LIMAX+1) + n=n+1 + send_buf_w(n) = ps3d(LIMAX+2) + do ii=1,uEMEP_Size1_local + n=n+1 + send_buf_w(n) = loc_frac_1d(ii,1) + enddo + + CALL MPI_ISEND( send_buf_w, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + neighbor(WEST), msgnr+1000 , MPI_COMM_CALC, request_w, IERROR) + end if + + if (neighbor(EAST).ge.0) then + n=0 + do ii=1,NSPEC_ADV + n=n+1 + send_buf_e(n) = xn_adv(ii,LIMAX+li1-3) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_e(n) = xn_adv(ii,LIMAX+li1-2) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_e(n) = xn_adv(ii,LIMAX+li1-1) + end do + n=n+1 + send_buf_e(n) = ps3d(LIMAX+li1-3) + n=n+1 + send_buf_e(n) = ps3d(LIMAX+li1-2) + n=n+1 + send_buf_e(n) = ps3d(LIMAX+li1-1) + do ii=1,uEMEP_Size1_local + n=n+1 + send_buf_e(n) = loc_frac_1d(ii,li1) + enddo + + CALL MPI_ISEND( send_buf_e, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + neighbor(EAST), msgnr+3000, MPI_COMM_CALC, request_e, IERROR) + end if + + if (neighbor(WEST).lt.0) then + if(vel((LIMAX+1)+1).lt.0)then + xnbeg(:,2) = 3.*xn_adv(:,LIMAX+1) & + -2.*xn_adv(:,LIMAX+2) + xnbeg(:,3) = 2.*xn_adv(:,LIMAX+1) & + -xn_adv(:,LIMAX+2) + + psbeg(2) = 3.*ps3d(LIMAX+1)-2.*ps3d(LIMAX+2) + psbeg(3) = 2.*ps3d(LIMAX+1)-ps3d(LIMAX+2) + else + xnbeg(:,1) = xn_adv(:,LIMAX) + xnbeg(:,2) = xn_adv(:,LIMAX) + xnbeg(:,3) = xn_adv(:,LIMAX) + + psbeg(1) = ps3d(LIMAX) + psbeg(2) = ps3d(LIMAX) + psbeg(3) = ps3d(LIMAX) + end if + do ii=1,uEMEP_Size1_local + loc_frac_1d(ii,li0-1)=0.0 + enddo + + else + + CALL MPI_RECV(rcv_buf_w, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE, & + neighbor(WEST), msgnr+3000, MPI_COMM_CALC, MPISTATUS, IERROR) + + n=0 + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,1) = rcv_buf_w(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,2) = rcv_buf_w(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,3) = rcv_buf_w(n) + end do + n=n+1 + psbeg(1) = rcv_buf_w(n) + n=n+1 + psbeg(2) = rcv_buf_w(n) + n=n+1 + psbeg(3) = rcv_buf_w(n) + + do ii=1,uEMEP_Size1_local + n=n+1 + loc_frac_1d(ii,li0-1) = rcv_buf_w(n) + enddo + + end if + + if (neighbor(EAST).lt.0) then + if(vel((LIMAX+1)+li1).ge.0)then + xnend(:,1) = 2.*xn_adv(:,LIMAX+li1-1) & + -xn_adv(:,LIMAX+li1-2) + xnend(:,2) = 3.*xn_adv(:,LIMAX+li1-1) & + -2.*xn_adv(:,LIMAX+li1-2) + + psend(1) = 2.*ps3d(LIMAX+li1-1) & + -ps3d(LIMAX+li1-2) + psend(2) = 3.*ps3d(LIMAX+li1-1) & + -2.*ps3d(LIMAX+li1-2) + else + xnend(:,1) = xn_adv(:,LIMAX+li1) + xnend(:,2) = xn_adv(:,LIMAX+li1) + xnend(:,3) = xn_adv(:,LIMAX+li1) + + psend(1) = ps3d(LIMAX+li1) + psend(2) = ps3d(LIMAX+li1) + psend(3) = ps3d(LIMAX+li1) + end if + do ii=1,uEMEP_Size1_local + loc_frac_1d(ii,li1+1)=0.0 + enddo + else + + CALL MPI_RECV( rcv_buf_e, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE, & + neighbor(EAST), msgnr+1000, MPI_COMM_CALC, MPISTATUS, IERROR) + + n=0 + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,1) = rcv_buf_e(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,2) = rcv_buf_e(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,3) = rcv_buf_e(n) + end do + n=n+1 + psend(1) = rcv_buf_e(n) + n=n+1 + psend(2) = rcv_buf_e(n) + n=n+1 + psend(3) = rcv_buf_e(n) + + do ii=1,uEMEP_Size1_local + n=n+1 + loc_frac_1d(ii,li1+1) = rcv_buf_e(n) + enddo + + end if + do ii=1,uEMEP_Size1_local + enddo + ! synchronizing sent buffers (must be done for all ISENDs!!!) + if (neighbor(WEST) .ge. 0) then + CALL MPI_WAIT(request_w, MPISTATUS, IERROR) + end if + if (neighbor(EAST) .ge. 0) then + CALL MPI_WAIT(request_e, MPISTATUS, IERROR) + end if + end subroutine preadvx3 + ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine preadvy(msgnr & @@ -3172,11 +3333,11 @@ subroutine preadvy(msgnr & ,vel(LIMAX*(LJMAX+1)) ! output - real,intent(out),dimension(NSPEC_ADV,3,LIMAX) :: xnend,xnbeg - real,intent(out),dimension(3,LIMAX) :: psend,psbeg + real,intent(out),dimension(NSPEC_ADV,3,LIMAX) :: xnend,xnbeg + real,intent(out),dimension(3,LIMAX) :: psend,psbeg ! local - integer i, info + integer i real,dimension(NSPEC_ADV,3,LIMAX) :: buf_xn_n,buf_xn_s real,dimension(3,LIMAX) :: buf_ps_n,buf_ps_s @@ -3194,13 +3355,13 @@ subroutine preadvy(msgnr & buf_ps_s(1,i) = ps3d(i) buf_ps_s(2,i) = ps3d(i+LIMAX) buf_ps_s(3,i) = ps3d(i+2*LIMAX) - enddo + end do CALL MPI_ISEND( buf_xn_s, 8*3*LIMAX*NSPEC_ADV, MPI_BYTE,& neighbor(SOUTH), msgnr , MPI_COMM_CALC, request_xn_s, IERROR) CALL MPI_ISEND( buf_ps_s, 8*3*LIMAX , MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, request_s, IERROR) - endif + end if if (neighbor(NORTH) .ge. 0) then do i = li0,li1 @@ -3211,13 +3372,13 @@ subroutine preadvy(msgnr & buf_ps_n(1,i) = ps3d(i+(lj1-3)*LIMAX) buf_ps_n(2,i) = ps3d(i+(lj1-2)*LIMAX) buf_ps_n(3,i) = ps3d(i+(lj1-1)*LIMAX) - enddo + end do CALL MPI_ISEND( buf_xn_n, 8*3*LIMAX*NSPEC_ADV, MPI_BYTE,& neighbor(NORTH), msgnr , MPI_COMM_CALC, request_xn_n, IERROR) CALL MPI_ISEND( buf_ps_n, 8*3*LIMAX , MPI_BYTE, & neighbor(NORTH), msgnr+100, MPI_COMM_CALC, request_n, IERROR) - endif + end if ! receive from SOUTH neighbor if any @@ -3243,15 +3404,15 @@ subroutine preadvy(msgnr & psbeg(2,i) = ps3d(i) psbeg(3,i) = ps3d(i) - endif - enddo + end if + end do else CALL MPI_RECV( xnbeg, 8*LIMAX*3*NSPEC_ADV, MPI_BYTE,& neighbor(SOUTH), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psbeg, 8*LIMAX*3 , MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if if (neighbor(NORTH).lt.0) then do i = li0,li1 @@ -3275,25 +3436,25 @@ subroutine preadvy(msgnr & psend(1,i) = ps3d(i+(ljmax-1)*LIMAX) psend(2,i) = ps3d(i+(ljmax-1)*LIMAX) psend(3,i) = ps3d(i+(ljmax-1)*LIMAX) - endif - enddo + end if + end do else CALL MPI_RECV( xnend, 8*LIMAX*3*NSPEC_ADV, MPI_BYTE,& neighbor(NORTH), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psend, 8*LIMAX*3 , MPI_BYTE,& neighbor(NORTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if ! synchronizing sent buffers (must be done for all ISENDs!!!) if (neighbor(SOUTH) .ge. 0) then CALL MPI_WAIT(request_xn_s, MPISTATUS, IERROR) CALL MPI_WAIT(request_s, MPISTATUS, IERROR) - endif + end if if (neighbor(NORTH) .ge. 0) then CALL MPI_WAIT(request_xn_n, MPISTATUS, IERROR) CALL MPI_WAIT(request_n, MPISTATUS, IERROR) - endif + end if end subroutine preadvy @@ -3304,7 +3465,7 @@ subroutine preadvy2(msgnr & ,xnbeg, xnend & ,psbeg, psend,i_send) - use Par_ml , only : li0,li1,lj0,lj1,ljmax,neighbor,NORTH,SOUTH + use Par_ml , only : lj0,lj1,ljmax,neighbor,NORTH,SOUTH use ChemSpecs, only : NSPEC_ADV implicit none @@ -3316,14 +3477,14 @@ subroutine preadvy2(msgnr & ! output - real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg - real,intent(out),dimension(3) :: psend,psbeg + real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg + real,intent(out),dimension(3) :: psend,psbeg ! local - integer i, info + integer i - real,dimension(NSPEC_ADV,3) :: buf_xn_n,buf_xn_s - real,dimension(3) :: buf_ps_n,buf_ps_s + real,dimension(NSPEC_ADV,3) :: buf_xn_n,buf_xn_s + real,dimension(3) :: buf_ps_n,buf_ps_s ! Initialize arrays holding boundary slices @@ -3338,13 +3499,13 @@ subroutine preadvy2(msgnr & buf_ps_s(1) = ps3d(i) buf_ps_s(2) = ps3d(i+LIMAX) buf_ps_s(3) = ps3d(i+2*LIMAX) - enddo + end do CALL MPI_ISEND( buf_xn_s, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(SOUTH), msgnr , MPI_COMM_CALC, request_xn_s, IERROR) CALL MPI_ISEND( buf_ps_s, 8*3 , MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, request_s, IERROR) - endif + end if if (neighbor(NORTH) .ge. 0) then do i = i_send,i_send @@ -3355,13 +3516,13 @@ subroutine preadvy2(msgnr & buf_ps_n(1) = ps3d(i+(lj1-3)*LIMAX) buf_ps_n(2) = ps3d(i+(lj1-2)*LIMAX) buf_ps_n(3) = ps3d(i+(lj1-1)*LIMAX) - enddo + end do CALL MPI_ISEND( buf_xn_n, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(NORTH), msgnr , MPI_COMM_CALC, request_xn_n, IERROR) CALL MPI_ISEND( buf_ps_n, 8*3 , MPI_BYTE,& neighbor(NORTH), msgnr+100, MPI_COMM_CALC, request_n, IERROR) - endif + end if ! receive from SOUTH neighbor if any @@ -3385,15 +3546,15 @@ subroutine preadvy2(msgnr & psbeg(1) = ps3d(i) psbeg(2) = psbeg(1) psbeg(3) = psbeg(1) - endif - enddo + end if + end do else CALL MPI_RECV( xnbeg, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(SOUTH), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psbeg, 8*3 , MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if if (neighbor(NORTH).lt.0) then do i = i_send,i_send @@ -3417,36 +3578,259 @@ subroutine preadvy2(msgnr & psend(1) = ps3d(i+(ljmax-1)*LIMAX) psend(2) = psend(1) psend(3) = psend(1) - endif - enddo + end if + end do else CALL MPI_RECV( xnend, 8*3*NSPEC_ADV, MPI_BYTE,& neighbor(NORTH), msgnr , MPI_COMM_CALC, MPISTATUS, IERROR) CALL MPI_RECV( psend, 8*3 , MPI_BYTE,& neighbor(NORTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + end if ! synchronizing sent buffers (must be done for all ISENDs!!!) if (neighbor(SOUTH) .ge. 0) then CALL MPI_WAIT(request_xn_s, MPISTATUS, IERROR) CALL MPI_WAIT(request_s, MPISTATUS, IERROR) - endif + end if if (neighbor(NORTH) .ge. 0) then CALL MPI_WAIT(request_xn_n, MPISTATUS, IERROR) CALL MPI_WAIT(request_n, MPISTATUS, IERROR) - endif + end if end subroutine preadvy2 ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + subroutine preadvy3(msgnr & + ,xn_adv,ps3d,vel & + ,xnbeg, xnend & + ,psbeg, psend,i_send,k,loc_frac_1d) + + ! Initialize arrays holding boundary slices + + use Par_ml , only : lj0,lj1,ljmax,neighbor,NORTH,SOUTH + use ChemSpecs, only : NSPEC_ADV + implicit none + +! input + integer,intent(in):: msgnr,i_send,k + real,intent(in):: xn_adv(NSPEC_ADV,LIMAX*LJMAX) + real,intent(in):: ps3d(LIMAX*LJMAX) & + ,vel(LIMAX*(LJMAX+1)) + +! output + real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg + real,intent(out),dimension(3) :: psend,psbeg + real,intent(inout),dimension(uEMEP_Size1,0:ljmax+1) :: loc_frac_1d + +! local + integer ii,j,dx,dy,isec_poll,n, uEMEP_Size1_local + real,dimension((NSPEC_ADV+1)*3+uEMEP_Size1) :: send_buf_n, rcv_buf_n, send_buf_s, rcv_buf_s + + uEMEP_Size1_local = 0!default: do not treat this region + + if(uEMEP_Size1>0 .and. k>KMAX_MID-uEMEP%Nvert)then + uEMEP_Size1_local = uEMEP_Size1!treat this region + do j=lj0,lj1 + n=0 + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=1,uEMEP%Nsec_poll + n=n+1 + loc_frac_1d(n,j) = loc_frac(isec_poll,dx,dy,i_send,j,k) + enddo + enddo + enddo + enddo + endif + +! send to SOUTH neighbor if any + + if (neighbor(SOUTH) .ge. 0) then + n=0 + do ii=1,NSPEC_ADV + n=n+1 + send_buf_s(n) = xn_adv(ii,i_send) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_s(n) = xn_adv(ii,i_send+LIMAX) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_s(n) = xn_adv(ii,i_send+2*LIMAX) + end do + n=n+1 + send_buf_s(n) = ps3d(i_send) + n=n+1 + send_buf_s(n) = ps3d(i_send+LIMAX) + n=n+1 + send_buf_s(n) = ps3d(i_send+2*LIMAX) + do ii=1,uEMEP_Size1_local + n=n+1 + send_buf_s(n) = loc_frac_1d(ii,1) + enddo + + CALL MPI_ISEND( send_buf_s, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, request_s, IERROR) + end if + + if (neighbor(NORTH) .ge. 0) then + + n=0 + do ii=1,NSPEC_ADV + n=n+1 + send_buf_n(n) = xn_adv(ii,i_send+(lj1-3)*LIMAX) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_n(n) = xn_adv(ii,i_send+(lj1-2)*LIMAX) + end do + do ii=1,NSPEC_ADV + n=n+1 + send_buf_n(n) = xn_adv(ii,i_send+(lj1-1)*LIMAX) + end do + n=n+1 + send_buf_n(n) = ps3d(i_send+(lj1-3)*LIMAX) + n=n+1 + send_buf_n(n) = ps3d(i_send+(lj1-2)*LIMAX) + n=n+1 + send_buf_n(n) = ps3d(i_send+(lj1-1)*LIMAX) + do ii=1,uEMEP_Size1_local + n=n+1 + send_buf_n(n) = loc_frac_1d(ii,lj1) + enddo + + CALL MPI_ISEND( send_buf_n, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + neighbor(NORTH), msgnr+100, MPI_COMM_CALC, request_n, IERROR) + end if + +! receive from SOUTH neighbor if any + + if (neighbor(SOUTH).lt.0) then + if(vel(i_send+LIMAX).lt.0.and.lj0==2)then + xnbeg(:,2) = 3.*xn_adv(:,i_send+LIMAX) & + -2.*xn_adv(:,i_send+2*LIMAX) + xnbeg(:,3) = 2.*xn_adv(:,i_send+LIMAX) & + -xn_adv(:,i_send+2*LIMAX) + xnbeg(:,1) = xnbeg(:,2) + + psbeg(2) = 3.*ps3d(i_send+LIMAX)-2.*ps3d(i_send+2*LIMAX) + psbeg(3) = 2.*ps3d(i_send+LIMAX)-ps3d(i_send+2*LIMAX) + psbeg(1) = psbeg(2) + else + xnbeg(:,1) = xn_adv(:,i_send) + xnbeg(:,2) = xnbeg(:,1) + xnbeg(:,3) = xnbeg(:,1) + + psbeg(1) = ps3d(i_send) + psbeg(2) = psbeg(1) + psbeg(3) = psbeg(1) + end if + do ii=1,uEMEP_Size1_local + loc_frac_1d(ii,0)=0.0 + enddo + + else + + CALL MPI_RECV( rcv_buf_s, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local) , MPI_BYTE,& + neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) + n=0 + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,1) = rcv_buf_s(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,2) = rcv_buf_s(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnbeg(ii,3) = rcv_buf_s(n) + end do + n=n+1 + psbeg(1) = rcv_buf_s(n) + n=n+1 + psbeg(2) = rcv_buf_s(n) + n=n+1 + psbeg(3) = rcv_buf_s(n) + + do ii=1,uEMEP_Size1_local + n=n+1 + loc_frac_1d(ii,0) = rcv_buf_s(n) + enddo + end if + + if (neighbor(NORTH).lt.0) then + if(vel(i_send+lj1*LIMAX).ge.0.and.ljmax/=lj1)then + xnend(:,1) = 2.*xn_adv(:,i_send+(lj1-1)*LIMAX) & + -xn_adv(:,i_send+(lj1-2)*LIMAX) + xnend(:,2) = 3.*xn_adv(:,i_send+(lj1-1)*LIMAX) & + -2.*xn_adv(:,i_send+(lj1-2)*LIMAX) + xnend(:,3) = xnend(:,2) + + psend(1) = 2.*ps3d(i_send+(lj1-1)*LIMAX) & + -ps3d(i_send+(lj1-2)*LIMAX) + psend(2) = 3.*ps3d(i_send+(lj1-1)*LIMAX) & + -2.*ps3d(i_send+(lj1-2)*LIMAX) + psend(3) = psend(2) + else + xnend(:,1) = xn_adv(:,i_send+(ljmax-1)*LIMAX) + xnend(:,2) = xnend(:,1) + xnend(:,3) = xnend(:,1) + + psend(1) = ps3d(i_send+(ljmax-1)*LIMAX) + psend(2) = psend(1) + psend(3) = psend(1) + end if + else + + CALL MPI_RECV( rcv_buf_n, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + neighbor(NORTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) + n=0 + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,1) = rcv_buf_n(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,2) = rcv_buf_n(n) + end do + do ii=1,NSPEC_ADV + n=n+1 + xnend(ii,3) = rcv_buf_n(n) + end do + n=n+1 + psend(1) = rcv_buf_n(n) + n=n+1 + psend(2) = rcv_buf_n(n) + n=n+1 + psend(3) = rcv_buf_n(n) + + do ii=1,uEMEP_Size1_local + n=n+1 + loc_frac_1d(ii,lj1+1) = rcv_buf_n(n) + enddo + end if + +! synchronizing sent buffers (must be done for all ISENDs!!!) + if (neighbor(SOUTH) .ge. 0) then + CALL MPI_WAIT(request_s, MPISTATUS, IERROR) + end if + if (neighbor(NORTH) .ge. 0) then + CALL MPI_WAIT(request_n, MPISTATUS, IERROR) + end if + + end subroutine preadvy3 + ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ! subroutine convection_pstar(ps3d,dt_conv) ! moved to Convection_ml.f90 - + subroutine alloc_adv_arrays !allocate the arrays once @@ -3459,7 +3843,7 @@ end subroutine alloc_adv_arrays - subroutine adv_vert_zero(xn_adv,ps3d,sdot,dt_s) + subroutine adv_vert_zero(xn_adv,ps3d,sdot,dt_s,fluxk) !"zero order Bott" advection for vertical implicit none @@ -3469,44 +3853,50 @@ subroutine adv_vert_zero(xn_adv,ps3d,sdot,dt_s) ! input+output real ,intent(inout):: xn_adv(NSPEC_ADV,0:LIMAX*LJMAX*KMAX_MID-1) real ,intent(inout):: ps3d(0:LIMAX*LJMAX*KMAX_MID-1) - - real :: fluxk(NSPEC_ADV,KMAX_MID),fluxps(KMAX_MID),fc(KMAX_MID) + real ,intent(inout)::fluxk(NSPEC_ADV,KMAX_MID) + + real :: fluxps(KMAX_MID),fc(KMAX_MID) integer :: k do k = 1,KMAX_MID-1 fc(k) = sdot(k*LIMAX*LJMAX)*dt_s - enddo + end do !dhs1(k+1) is thickness of layer k !concentrations and thickness from upwind cell + fluxk(:,KMAX_MID)=0.0 do k = 1,KMAX_MID-1 if(fc(k).lt.0.)then - fluxk(:,k) = xn_adv(:,k*LIMAX*LJMAX) * fc(k) - fluxps(k) = ps3d(k*LIMAX*LJMAX) * fc(k) + fluxk(:,k+1) = xn_adv(:,k*LIMAX*LJMAX) * fc(k) + fluxps(k+1) = ps3d(k*LIMAX*LJMAX) * fc(k) else - fluxk(:,k) = xn_adv(:,(k-1)*LIMAX*LJMAX) * fc(k) - fluxps(k) = ps3d((k-1)*LIMAX*LJMAX) * fc(k) - endif - enddo + fluxk(:,k+1) = xn_adv(:,(k-1)*LIMAX*LJMAX) * fc(k) + fluxps(k+1) = ps3d((k-1)*LIMAX*LJMAX) * fc(k) + end if + end do k=0 - xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(-fluxk(:,k+1))*dhs1i(k+2)) - ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(-fluxps(k+1))*dhs1i(k+2)) + xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(-fluxk(:,k+2))*dhs1i(k+2)) + ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(-fluxps(k+2))*dhs1i(k+2)) do k = 1,KMAX_MID-2 - if(xn_adv(1,k*LIMAX*LJMAX)+(fluxk(1,k)-fluxk(1,k+1))*dhs1i(k+2)<0.0)then - write(*,*)'PWPW a',me,k,xn_adv(1,k*LIMAX*LJMAX)+(fluxk(1,k)-fluxk(1,k+1))*dhs1i(k+2),xn_adv(1,k*LIMAX*LJMAX),fluxk(1,k),-fluxk(1,k+1),dhs1i(k+2) - stop - endif - xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(fluxk(:,k)-fluxk(:,k+1))*dhs1i(k+2)) - if(ps3d(k*LIMAX*LJMAX)+(fluxps(k)-fluxps(k+1))*dhs1i(k+2)<0.0001)then - write(*,*)'PWPW ',me,ps3d(k*LIMAX*LJMAX)+(fluxps(k)-fluxps(k+1))*dhs1i(k+2),ps3d(k*LIMAX*LJMAX),(fluxps(k)),-fluxps(k+1),dhs1i(k+2) - stop - endif - ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(fluxps(k)-fluxps(k+1))*dhs1i(k+2)) - enddo + if(xn_adv(1,k*LIMAX*LJMAX)+(fluxk(1,k+1)-fluxk(1,k+2))*dhs1i(k+2)<0.0)then + write(*,*)'PWPW a',me,k,& + xn_adv(1,k*LIMAX*LJMAX)+(fluxk(1,k+1)-fluxk(1,k+2))*dhs1i(k+2),& + xn_adv(1,k*LIMAX*LJMAX),fluxk(1,k+1),-fluxk(1,k+2),dhs1i(k+2) + stop + end if + xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(fluxk(:,k+1)-fluxk(:,k+2))*dhs1i(k+2)) + if(ps3d(k*LIMAX*LJMAX)+(fluxps(k+1)-fluxps(k+2))*dhs1i(k+2)<0.0001)then + write(*,*)'PWPW ',me,& + ps3d(k*LIMAX*LJMAX)+(fluxps(k+1)-fluxps(k+2))*dhs1i(k+2),& + ps3d(k*LIMAX*LJMAX),(fluxps(k+1)),-fluxps(k+2),dhs1i(k+2) + stop + end if + ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(fluxps(k+1)-fluxps(k+2))*dhs1i(k+2)) + end do k=KMAX_MID-1 - xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(fluxk(:,k))*dhs1i(k+2)) - ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(fluxps(k))*dhs1i(k+2)) + xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(fluxk(:,k+1))*dhs1i(k+2)) + ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(fluxps(k+1))*dhs1i(k+2)) end subroutine adv_vert_zero @@ -3523,7 +3913,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) ! input+output real ,intent(inout):: xn_adv(NSPEC_ADV,LIMAX*LJMAX:LIMAX*LJMAX*KMAX_MID) real ,intent(inout):: ps3d(LIMAX*LJMAX:LIMAX*LJMAX*KMAX_MID) - + integer :: k integer ij, ijn,ijll @@ -3543,8 +3933,8 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) integer ijb2(KMAX_MID),ije2(KMAX_MID),ijb3(KMAX_MID) logical ijdoend integer kstart,kend - real,dimension(NSPEC_ADV,3) :: xnbeg,xnend - real,dimension(3) :: psbeg,psend + real,dimension(NSPEC_ADV,3) :: xnbeg,xnend + real,dimension(3) :: psbeg,psend real ::xm(0:KMAX_MID),xmi(0:KMAX_MID) !----------------------------------------------------------------------- @@ -3568,7 +3958,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) do k=0,KMAX_MID xm(k)=dhs1i(k+1)/KMAX_MID xmi(k)=1.0/xm(k) - enddo + end do ! xm=1.0 ! xmi=1.0 @@ -3642,7 +4032,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d((kstart+1)*STRIDE)*zzfc(3,kstart) & + ps3d( kstart *STRIDE)*zzfc(2,kstart) & + psbeg(3) *zzfc(1,kstart)) - endif + end if if(fc(kstart+1).ge.0.)then @@ -3658,7 +4048,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d((kstart+1)*STRIDE)*zzfc(3,kstart+1) & + ps3d( kstart *STRIDE)*zzfc(2,kstart+1) & + psbeg(3) *zzfc(1,kstart+1)) - endif + end if lijb = kstart+2 @@ -3685,7 +4075,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d((ijn-1)*STRIDE)*zzfc(2,ij) & + ps3d((ijn-2)*STRIDE)*zzfc(1,ij)) - enddo + end do if(fc(kend-2).lt.0.)then @@ -3703,7 +4093,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d((kend-2)*STRIDE)*zzfc(2,kend-2) & + ps3d((kend-3)*STRIDE)*zzfc(1,kend-2)) - endif + end if ! integrated flux form @@ -3733,7 +4123,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d((kend-1)*STRIDE)*zzfc(2,kend-1) & + ps3d((kend-2)*STRIDE)*zzfc(1,kend-1)) - endif + end if ! integrated flux form @@ -3764,10 +4154,10 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) + ps3d( kend *STRIDE)*zzfc(2,kend) & + ps3d((kend-1)*STRIDE)*zzfc(1,kend)) - endif + end if - endif + end if if(limtlow.eq.-1)then else @@ -3784,8 +4174,8 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) hel1(:) = xn_adv(:,kstart*STRIDE)*xmi(kstart) hel2(:) = flux(:,kstart) + flux(:,kstart-1) where(hel1(:).lt.hel2(:)) - flux(:,kstart-1) =-flux(:,kstart-1)*hel1(:)/(hel2(:)+1.0E-100) - flux(:,kstart) = flux(:,kstart) *hel1(:)/(hel2(:)+1.0E-100) + flux(:,kstart-1) =-flux(:,kstart-1)*hel1(:)/(hel2(:)+1d-100) + flux(:,kstart) = flux(:,kstart) *hel1(:)/(hel2(:)+1d-100) xn_adv(:,kstart*STRIDE) = 0. elsewhere flux(:,kstart-1) =-flux(:,kstart-1) @@ -3800,11 +4190,11 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) else fluxps(kstart-1) =-fluxps(kstart-1) ps3d(kstart*STRIDE) =xm(kstart)*(hel1ps-hel2ps) - endif + end if ij = kstart+1 - endif - endif - endif + end if + end if + end if ijpasses = 0 do while(.true.) @@ -3820,8 +4210,8 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) ije2(ijpasses) = -5 ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb2(ijpasses) = ij ije2(ijpasses) = -5 do while(fc(ij+1).lt.0.) @@ -3830,12 +4220,12 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) if(ij.gt.kend-1)then ijb3(ijpasses) = -5 goto 257 - endif - enddo + end if + end do ijb3(ijpasses) = ij ij = ij+2 if(ij.gt.kend-1)goto 257 - enddo + end do 257 continue ijdoend = .false. @@ -3852,7 +4242,7 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) ps3d(ij*STRIDE) = & max(0.,ps3d(ij*STRIDE) & -xm(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do do ij = ijb2(ijll),ije2(ijll) flux(:,ij)=-min(xn_adv(:,(ij+1)*STRIDE)*xmi(ij+1),flux(:,ij)) xn_adv(:,ij*STRIDE) = & @@ -3862,15 +4252,15 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) ps3d(ij*STRIDE) = & max(0.,ps3d(ij*STRIDE) & -xm(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do ij = ijb3(ijll) if(ij.lt.-3) goto 357 hel1(:) = xn_adv(:,(ij+1)*STRIDE)*xmi(ij+1) hel2(:) = flux(:,ij+1) + flux(:,ij) where(hel1(:).lt.hel2(:)) !On IBM machine the division can give overflow if hel2 is too small - flux(:,ij) =-flux(:,ij) *hel1(:)/(hel2(:)+1.0E-100) - flux(:,ij+1) = flux(:,ij+1)*hel1(:)/(hel2(:)+1.0E-100) + flux(:,ij) =-flux(:,ij) *hel1(:)/(hel2(:)+1d-100) + flux(:,ij+1) = flux(:,ij+1)*hel1(:)/(hel2(:)+1d-100) xn_adv(:,(ij+1)*STRIDE) = 0. elsewhere flux(:,ij) =-flux(:,ij) @@ -3888,11 +4278,11 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) else fluxps(ij) = -fluxps(ij) ps3d((ij+1)*STRIDE) = xm(ij+1)*(hel1ps-hel2ps) - endif + end if ps3d(ij*STRIDE) = & max(0.,ps3d(ij*STRIDE) & -xm(ij)*(fluxps(ij)-fluxps(ij-1))) - enddo + end do 357 continue @@ -3920,9 +4310,8 @@ subroutine adv_vert_fourth(xn_adv,ps3d,sdot,dt_s) ps3d(kend*STRIDE) = & max(0.,ps3d(kend*STRIDE) & -xm(kend)*(fluxps(kend)-fluxps(kend-1))) - endif - endif + end if + end if end subroutine adv_vert_fourth - end module Advection_ml diff --git a/AeroFunctions.f90 b/AeroFunctions.f90 index 321075e..e8cd163 100644 --- a/AeroFunctions.f90 +++ b/AeroFunctions.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -161,9 +161,9 @@ elemental function WetRad(rdry,fRH,pmtype) result (rwet) , 0.3926,3.101,4.190e-11,-1.404 & ! urban , 0.4809,3.082,3.110e-11,-1.428 /)& ! (NH4)2SO4 ,(/4,4/) ) - real, parameter :: THIRD = 1.0/3.0, um2m = 1.0e-6, cm2m = 1.0e-2 + real, parameter :: THIRD = 1.0/3.0, cm2m = 1.0e-2 real :: rd, mrh - integer :: ind + integer :: ind ind = 1 ! default = rural if ( present(pmtype) ) ind = pmtype @@ -384,11 +384,11 @@ elemental function pmSurfArea(dry_ug,Dp,Dpw,sigma,sigmaFac,rho_kgm3) result(S) ,rho_kgm3 !< density, kg/m3 real :: S !< Surface area, m2 per m3 air - real :: dryvol, rho, rdry, rwet, sigFac, totvol, sig + real :: rho, rdry, rwet, sigFac, dryvol, totvol real :: rhod, fwetvol rho = 1600.0 !< kg/m3 default - rdry= 0.034*1.0e-6 !< 0.0341 um default, in m + rdry= 0.034e-6 !< 0.0341 um default, in m ! RDRY AND MASS AND RHO Should be self-consistent. No! Number! @@ -397,9 +397,11 @@ elemental function pmSurfArea(dry_ug,Dp,Dpw,sigma,sigmaFac,rho_kgm3) result(S) if ( present(SigmaFac) ) then sigFac = sigmaFac else - sig = 1.8 !< default - if ( present(sigma) ) sig = sigma - sigFac = exp( -2.5*log(sig)**2 ) + if ( present(sigma) )then + sigFac = exp( -2.5*log(sigma)**2 ) + else + sigFac = 0.421585401578311!=exp( -2.5*log(1.8)**2 ) + endif end if rhod =rho ! for print @@ -611,7 +613,6 @@ elemental function UptakeRate(molSpeed,gam,S,rad) result (k) real, intent(in) :: S !< Aerosol surface area, m2 per m3 air real, intent(in), optional :: rad !< aerosol radius, m real, parameter :: Dg = 0.1 * 1.0e-4 ! 0.1 cm2/s -> m2/s - real, parameter :: toum2cm3 = 1.0e12*1.0e-6 real :: k if( present(rad) ) then k = S / ( rad/Dg + 4/(molSpeed * gam) ) diff --git a/Aero_Vds_ml.f90 b/Aero_Vds_ml.f90 index 35a391b..3f716bc 100644 --- a/Aero_Vds_ml.f90 +++ b/Aero_Vds_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -29,9 +29,9 @@ module Aero_Vds_ml !============================================================================== use PhysicalConstants_ml, only : FREEPATH, VISCO, BOLTZMANN, PI, GRAV, ROWATER use ModelConstants_ml, only : DEBUG_VDS, MasterProc - + ! DESCRIPTION - ! Calculates laminar sub-layer resistance (rb) and gravitational settling + ! Calculates laminar sub-layer resistance (rb) and gravitational settling ! velocity (vs) for particles ! In DryDep_ml: Vd= Vs/(1.0 - exp ( -(Ra + Rb)*Vs ), where ! Vs - gravitational settling velocity, @@ -46,9 +46,9 @@ module Aero_Vds_ml ! A variety of equations are presented. Two types of ! stability corrections are used in the literature, ! those based upon 1/L only, and those based upon - ! zi/L, where zi is the PBL height. + ! zi/L, where zi is the PBL height. ! - ! Using zi form gives max stab-fac of ca. 10 + ! Using zi form gives max stab-fac of ca. 10 ! (range max 2.8 to 10.7 for zi = 200 - 2500) ! Using 300 form gives max stab-fac of ca. 6 @@ -84,7 +84,6 @@ elemental function SettlingVelocity(tsK,roa,sigma,diam,PMdens) result(Vs) real :: Vs ! (NSIZE) - real, parameter :: one2three = 1.0/3.0 real :: lnsig2, dg, & knut, Di, & ! Knudsen number, Diffusion coefficient Di_help, vs_help @@ -93,7 +92,7 @@ elemental function SettlingVelocity(tsK,roa,sigma,diam,PMdens) result(Vs) lnsig2 = log(sigma)**2 - !... mass median diameter -> geometric diameter + !... mass median diameter -> geometric diameter dg = exp (log(diam) - 3.* lnsig2 ) @@ -102,9 +101,9 @@ elemental function SettlingVelocity(tsK,roa,sigma,diam,PMdens) result(Vs) Di_help =BOLTZMANN*tsK/(3*PI*dg *VISCO *roa) ! A30, dpg vs_help= dg*dg * PMdens * GRAV / (18.0* VISCO*roa) ! A32 - !... Diffusion coefficient for poly-disperse - Di = Di_help*(exp(-2.5*lnsig2)+1.246*knut*exp(-4.*lnsig2)) ! A29, dpk - !... Settling velocity for poly-disperse + !... Diffusion coefficient for poly-disperse + Di = Di_help*(exp(-2.5*lnsig2)+1.246*knut*exp(-4.*lnsig2)) ! A29, dpk + !... Settling velocity for poly-disperse Vs = vs_help*(exp(8.0*lnsig2)+1.246*knut*exp(3.5*lnsig2)) ! A31, k=3 ! Can't have output from elemental @@ -132,7 +131,7 @@ function PetroffFit(ustar,invL,SAI) result(Vds) real, intent(in) :: ustar, invL,SAI real :: Vds - Vds = 0.007 * ustar * 0.1*max(SAI, 3.0) + Vds = 0.007 * ustar * 0.1*max(SAI, 3.0) if ( invL < 0.0 ) then Vds = Vds * (1.0+(-300.0 * max(-0.04,invL))**0.6667) @@ -141,9 +140,9 @@ end function PetroffFit !------------------------------------------------------------------------ ! GallagherPetrof fits ! Two functions here, for different stability methods - ! "Simple" fitting of Gallagher et al. (1997) and Petroff et al., which + ! "Simple" fitting of Gallagher et al. (1997) and Petroff et al., which ! roughly captures the differences between Speulderbos-type and typical - ! forests, because of LAI. + ! forests, because of LAI. ! Gallagher et al. had Vds/u* = 0.0135 * Dp * stab function ! which gives 0.3 cm/s for neutral conditions, Dp=0.5 ! @@ -153,7 +152,7 @@ end function PetroffFit ! We use SAI to keep some winter dep in decid forests ! As Petroff started with a total LAI of 22, which is ca. ! 1-sided LAI=10, SAI=11, so we scale with SAI/11 = 0.09 - ! + ! ! We also limit the lowest Vds/u* to be 0.002, consistent with ! Wesely. @@ -242,18 +241,18 @@ function Nemitz2004(dp,ustar,invL) result(Vds) real, intent(in) :: dp, ustar, invL real :: Vds - Vds = 0.001*ustar + Vds = 0.001*ustar if ( invL < 0.0 ) then Vds = Vds *( 1+( -(960*dp-88.0)*invL )**0.6667) end if - end function Nemitz2004 + end function Nemitz2004 !------------------------------------------------------------------------ function Gallagher1997(dp,ustar,invL) result(Vds) real, intent(in) :: dp, ustar, invL real :: Vds - Vds = 0.0135 * ustar * dp + Vds = 0.0135 * ustar * dp if ( invL < 0.0 ) then Vds = Vds * (1.0+(-300*invL)**0.6667 ) @@ -267,7 +266,7 @@ function Gallagher2002(ustar,invL,z0) result(Vds) !if( log(z0) > 0.0 ) then ! z0 > ~0.04 m !if( log10(z0) > 0.0 ) then ! z0 > ~0.04 m - !k1 = 0.001222 * log(z0) + 0.003906 + !k1 = 0.001222 * log(z0) + 0.003906 k1 = 0.001222 * log10(z0) + 0.003906 ! Eqn (13) ! This equation has negative solutions. We set @@ -293,7 +292,7 @@ function GallagherWT(dp,ustar,invL, zi) result(Vds) real, intent(in) :: dp, ustar, invL, zi real :: Vds - Vds = 0.0135 * ustar * dp + Vds = 0.0135 * ustar * dp if ( invL < 0.0 ) then Vds = Vds * (1.0+(-0.3*zi*max(-0.04,invL))**0.6667) diff --git a/Aero_water_ml.f90 b/Aero_water_ml.f90 index c4a26e5..eebfffe 100644 --- a/Aero_water_ml.f90 +++ b/Aero_water_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -63,8 +63,8 @@ module Aero_water_ml real, private,parameter, dimension(4) :: & !(for x = 0, 1, 1.5 and 2) C0 = (/ 0.798079, -1.574367, 2.536686, -1.735297 /),& C1 = (/ 0.9995178, -0.7952896, 0.99683673, -1.143874 /),& - C15= (/ 1.697092, -4.045936, 5.833688, -3.463783 /),& - C2 = (/ 2.085067, -6.024139, 8.967967, -5.002934 /) + C15= (/ 1.697092, -4.045936, 5.833688, -3.463783 /)!,& + !C2 = (/ 2.085067, -6.024139, 8.967967, -5.002934 /) real, private,parameter, dimension(6) :: & KNO3 = (/ 0.2906, 6.83665, -26.9093, 46.6983, -38.803, 11.8837/),& @@ -178,7 +178,7 @@ subroutine Awater(relh,mso4,mnh4,mno3,wh2o) !-- local real :: tso4, tnh4, tno3 real :: x, awc, aw, u & - , mfs0, mfs1, mfs15, mfs2 & + , mfs0, mfs1, mfs15 & , mfsso4, mfsno3 & , y, y0, y1, y15, y2, y3 & , y40, y140, y1540, yc diff --git a/AerosolCalls.f90 b/AerosolCalls.f90 index adc2e64..1dc441a 100644 --- a/AerosolCalls.f90 +++ b/AerosolCalls.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,9 +39,6 @@ module AerosolCalls use CheckStop_ml, only : StopAll, CheckStop use ChemGroups_ml, only : SS_GROUP, RDN_GROUP use ChemSpecs -! use ChemSpecs, only : SO4, NH3, HNO3, NO3_f, NH4_f, & -! SEASALT_F, & ! ISORROPIA -! NSPEC_SHL, species use Chemfields_ml, only : PM25_water, PM25_water_rh50, & !PMwater cfac use EQSAM_v03d_ml, only : eqsam_v03d @@ -56,7 +53,6 @@ module AerosolCalls public :: AerosolEquilib public :: emep2MARS, emep2EQSAM, Aero_Water, Aero_Water_MARS - private :: emep2isorropia ! logical, public, parameter :: AERO_DYNAMICS = .false. & ! , EQUILIB_EMEP = .false. & !old Ammonium stuff @@ -86,7 +82,8 @@ subroutine AerosolEquilib(debug_flag) case ( 'EQSAM' ) call emep2EQSAM(debug_flag) case ( 'ISORROPIA' ) - call emep2Isorropia(debug_flag) + call StopAll('Isorropia problems found. Removed for now') + !call emep2Isorropia(debug_flag) case default if( my_first_call .and. MasterProc ) then write(*,*) 'WARNING: AerosolEquilib: nothing chosen:' @@ -100,67 +97,6 @@ end subroutine AerosolEquilib ! Adapted from List 10, p130, Isoropia manual - subroutine emep2isorropia(debug_flag) - logical, intent(in) :: debug_flag - - real, dimension(8) :: wi = 0.0, wt - real, dimension(3) :: gas - real, dimension(15) :: aerliq - real, dimension(19) :: aersld - real, parameter, dimension(2) :: CNTRL = (/ 0, 0 /) - real, dimension(9) :: other - !real :: rhi, tempi - character(len=15) :: scase - - ! DS added - real, parameter :: Ncm3_to_molesm3 = 1.0e6/AVOG ! #/cm3 to moles/m3 - real, parameter :: molesm3_to_Ncm3 = 1.0/Ncm3_to_molesm3 - real :: FLOOR = 1.0e-30 ! - integer :: i, ispec, k - real :: atwNa = 22.989770, atwCl = 35.453 ! g/mole !DOCS had 36.5? - real :: tmpno3, tmpnh4 - - ! WI(1) = max(FLOOR2, xn_2d(Na,k)) / species(Na)%molwt * Ncm3_to_molesm3 - ! 5=Cl, 6=Ca, 7=K, 8=Mg - - do k = KMAX_MID, KMAX_MID ! TESTING KCHEMTOP, KMAX_MID - - WI(1) = 0.0 !FINE sum( xn_2d(SS_GROUP,k) ) * Ncm3_to_molesm3 - WI(2) = xn_2d(SO4,k) * Ncm3_to_molesm3 - WI(3) = sum( xn_2d(RDN_GROUP,k) ) * Ncm3_to_molesm3 !NH3, NH4 - !FINE WI(4) = ( xn_2d(NO3_F,k) + xn_2d(NO3_C,k) + xn_2d(HNO3,k) )& - WI(4) = ( xn_2d(NO3_F,k) + xn_2d(HNO3,k) )& - * Ncm3_to_molesm3 - WI(5) =0.0 !FINE WI(1) ! Cl only from sea-salt. Needs consideration! - - call isoropia ( wi, rh(k), temp(k), CNTRL,& - wt, gas, aerliq, aersld, scase, other) - - ! gas outputs are in moles/m3(air) - - xn_2d(NH3,k) = gas(1) * molesm3_to_Ncm3 - xn_2d(HNO3,k) = gas(2) * molesm3_to_Ncm3 - !xn_2d(HCl,k) = gas(3) * molesm3_to_Ncm3 - - ! aerosol outputs are in moles/m3(air) - ! 1=H+, 2=Na+, 3=NH4+, 4=Cl-, 5=SO42-, 6=HSO4-, 7=NO3-, 8=Ca2+ - ! 9=K+, 10=Mg2+ - !xn_2d(NH4_F,k) = MOLAL(3) - - ! Just use those needed: - ! QUERY: Is NaNO3 always solid? Ans = No! - - !xn_2d(NO3_c,k ) = aeroHCl * molesm3_to_Ncm3 ! assume all HCl from NaNO3 formation? - !FINE xn_2d(NO3_f,k ) = tmpno3 - xn_2d(NO3_c,k ) - xn_2d(HNO3,k) - xn_2d(NO3_f,k ) = tmpno3 - xn_2d(HNO3,k) - - if( debug_flag ) then - write(*, "(a,2f8.3,99g12.3)") "ISORROPIA ", rh(k), temp(k), gas - end if - !call StopAll("ISOR") - - end do - end subroutine emep2isorropia !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> subroutine emep2MARS(debug_flag) @@ -179,7 +115,6 @@ subroutine emep2MARS(debug_flag) aSO4out, aNO3out, aH2Oout, aNH4out, gNH3out, gNO3out, & coef integer :: k, errmark - logical,save :: firstcall=.true. !----------------------------------- coef = 1.e12 / AVOG @@ -188,7 +123,7 @@ subroutine emep2MARS(debug_flag) !//.... molec/cm3 -> ug/m3 -!DEC2014. Use FLOOR2 = 1.0e-8 molec/cm3 for input. Too many problems +! Use FLOOR2 = 1.0e-8 molec/cm3 for input. Too many problems so4in = max(FLOOR2, xn_2d(SO4,k)) * species(SO4)%molwt *coef hno3in = max(FLOOR2, xn_2d(HNO3,k))* species(HNO3)%molwt *coef nh3in = max(FLOOR2, xn_2d(NH3,k)) * species(NH3)%molwt *coef @@ -208,7 +143,7 @@ subroutine emep2MARS(debug_flag) call DO_RPMARES_new (so4in, hno3in,no3in ,nh3in, nh4in , rh(k), temp(k), & aSO4out, aNO3out, aH2Oout, aNH4out, gNH3out, gNO3out, & ERRMARK,debug_flag) - endif + end if !-------------------------------------------------------------------------- @@ -224,7 +159,7 @@ subroutine emep2MARS(debug_flag) xn_2d(NO3_f,k) = max (FLOOR, aNO3out / (species(NO3_f)%molwt *coef) ) xn_2d(NH4_f,k) = max (FLOOR, aNH4out / (species(NH4_f)%molwt *coef) ) - enddo ! K-levels + end do ! K-levels end subroutine emep2MARS @@ -274,7 +209,7 @@ subroutine emep2EQSAM(debug_flag) if ( debug_flag ) then ! Selected debug cell write(*,*)'Before EQSAM',xn_2d(SO4,20),xn_2d(HNO3,20),& xn_2d(NH3,20),xn_2d(NO3_f,20),xn_2d(NH4_f,20) - endif + end if !//.... molec/cm3 -> micromoles/m**3 so4in(KCHEMTOP:KMAX_MID) = xn_2d(SO4,KCHEMTOP:KMAX_MID)*1.e12/AVOG @@ -306,7 +241,7 @@ subroutine emep2EQSAM(debug_flag) if ( debug_flag ) then ! Selected debug cell write(*,*)'After EQSAM',xn_2d(SO4,20),xn_2d(HNO3,20),& xn_2d(NH3,20),xn_2d(NO3_f,20),xn_2d(NH4_f,20) - endif + end if end subroutine emep2EQSAM @@ -354,14 +289,13 @@ subroutine Aero_water(i,j, ambient, debug_flag) gSO4out(KCHEMTOP:KMAX_MID), & rlhum(KCHEMTOP:KMAX_MID),tmpr(KCHEMTOP:KMAX_MID) - real, parameter :: FLOOR = 1.0E-30 ! minimum concentration !----------------------------------- if ( debug_flag ) then ! Selected debug cell write(*,*)'Before EQSAM',xn_2d(SO4,20),xn_2d(HNO3,20),& xn_2d(NH3,20),xn_2d(NO3_f,20),xn_2d(NH4_f,20) - endif + end if !//.... molec/cm3 -> micromoles/m**3 so4in(KCHEMTOP:KMAX_MID) = xn_2d(SO4,KCHEMTOP:KMAX_MID)*1.e12/AVOG @@ -382,7 +316,7 @@ subroutine Aero_water(i,j, ambient, debug_flag) else ! for gravimetric mass rlhum(:) = 0.5 tmpr(:) = 293.15 - endif + end if !-------------------------------------------------------------------------- @@ -397,12 +331,12 @@ subroutine Aero_water(i,j, ambient, debug_flag) PM25_water(i,j,KCHEMTOP:KMAX_MID) = max(0., aH2Oout(KCHEMTOP:KMAX_MID) ) else ! In gravimetric PM (Rh=50% and t=20C) PM25_water_rh50 (i,j) = max(0., aH2Oout(KMAX_MID) ) - endif + end if if ( debug_flag ) then ! Selected debug cell write(*,*)'After EQSAM',xn_2d(SO4,20),xn_2d(HNO3,20),& xn_2d(NH3,20),xn_2d(NO3_f,20),xn_2d(NH4_f,20) - endif + end if end subroutine Aero_water !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -418,7 +352,6 @@ subroutine Aero_water_MARS(i,j, debug_flag) integer, intent(in) :: i, j logical, intent(in) :: debug_flag - real, parameter :: FLOOR = 1.0E-30 ! minimum concentration !.. local real :: rlhum(KCHEMTOP:KMAX_MID), tmpr(KCHEMTOP:KMAX_MID) @@ -457,13 +390,13 @@ subroutine Aero_water_MARS(i,j, debug_flag) call DO_RPMARES_new (so4in, hno3in,no3in ,nh3in, nh4in , rlhum(k), tmpr(k), & aSO4out, aNO3out, aH2Oout, aNH4out, gNH3out, gNO3out, & ERRMARK,debug_flag) - endif + end if !-------------------------------------------------------------------------- !//....aerosol water (ug/m**3) PM25_water(i,j,k) = max (0., aH2Oout ) - enddo ! k-loop + end do ! k-loop !.. PM2.5 water at equilibration conditions for gravimetric PM (Rh=50% and t=20C) @@ -489,7 +422,7 @@ subroutine Aero_water_MARS(i,j, debug_flag) call DO_RPMARES_new (so4in, hno3in,no3in ,nh3in, nh4in , rlhum(k), tmpr(k), & aSO4out, aNO3out, aH2Oout, aNH4out, gNH3out, gNO3out, & ERRMARK,debug_flag) - endif + end if !-------------------------------------------------------------------------- PM25_water_rh50 (i,j) = max (0., aH2Oout ) @@ -499,5 +432,3 @@ end subroutine Aero_water_MARS !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> end module AerosolCalls - - diff --git a/AirEmis_ml.f90 b/AirEmis_ml.f90 index 9fd7c5d..fd68b46 100644 --- a/AirEmis_ml.f90 +++ b/AirEmis_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -116,7 +116,7 @@ subroutine lightning() if(.not.allocated(airlig))then allocate(airlig(KCHEMTOP:KMAX_MID,LIMAX,LJMAX)) airlig=0.0 - endif + end if ! --- Read Emission data received from DLR @@ -150,7 +150,7 @@ subroutine lightning() write(6,*) 'Sum of NOx emissions from lightning: ',sumnox - endif + end if call air_inter(ILON ,IGL ,GGL ,1 , & flux ,airlig , & @@ -167,7 +167,6 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & rlon ,area ,secmonth ) - integer, parameter :: KMAX_BND_AIR = 21 integer, intent(in) :: ILON,IGL,GGL,iktop real, intent(in) :: area(IGL), ygrdum(IGL),DLON,RLON0,secmonth @@ -179,7 +178,6 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & real, intent(out) :: rlon(ILON+1) ! local - integer info integer lon,lat,i,j,ig,jg,kg,k, i_sh integer la_tst1, la_tst2, lo_tst1, lo_tst2 ! test area for sums real height, & ! height of the emission levels @@ -220,7 +218,7 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & else ! -- area not defined for Southern Hemisphere volcm = area(GGL-lat+1)*1.e4*height - endif + end if do lon=1,ILON sumnox = sumnox + flux(lon,lat,k) @@ -231,7 +229,7 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & end do !k if(MY_DEBUG)write(6,*) 'SUMNOX, ANCAT:',sumnox - endif !me=0 + end if !me=0 CALL MPI_BCAST(flux(1,1,iktop), 8*GGL*ILON*(ILEV+1-iktop), MPI_BYTE, 0,& @@ -245,7 +243,7 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & i_sh = GGL + 1 - i ygrida(i) = (ygrdum(i-1)+ygrdum(i))*0.5 ygrida(i_sh) = - ygrida(i) - enddo + end do ! - E/W rlon(1) = RLON0 @@ -268,11 +266,11 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & do while(glat(i,j)=ygrida(jg)) jg = jg-1 - enddo + end do jxn(i,j) = jg glij = glon(i,j) @@ -327,7 +325,7 @@ subroutine air_inter(ILON ,IGL ,GGL ,iktop , & else !zero emissions airem(k,i,j) = 0.0 - endif + end if end do ! surface emissions diff --git a/AllocInit.f90 b/AllocInit.f90 index c4b5064..6347929 100644 --- a/AllocInit.f90 +++ b/AllocInit.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/Ammonium_ml.f90 b/Ammonium_ml.f90 index d74599a..85d875d 100644 --- a/Ammonium_ml.f90 +++ b/Ammonium_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -84,7 +84,7 @@ subroutine ammonium() if ( my_first_call ) then call tabulate() my_first_call = .false. - endif + end if call setup_ammonium(rcnh4) call calc_ammonium(rcnh4) diff --git a/Aqueous_n_WetDep_ml.f90 b/Aqueous_n_WetDep_ml.f90 index dd03b56..100e9df 100644 --- a/Aqueous_n_WetDep_ml.f90 +++ b/Aqueous_n_WetDep_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -137,7 +137,6 @@ module Aqueous_ml ! Aqueous fractions: real, save,allocatable, public, dimension(:,:) :: frac_aq real, private, dimension(NHENRY,CHEMTMIN:CHEMTMAX), save :: H -real, private, dimension(NK1,CHEMTMIN:CHEMTMAX), save :: K1fac !hf NEW real, private, dimension(CHEMTMIN:CHEMTMAX), save :: & K1, & ! K for SO2->HSO3- @@ -153,7 +152,6 @@ module Aqueous_ml real, public, save,allocatable, dimension(:,:) :: aqrck real, private, dimension(NAQRC), save :: aqrc ! constant rates for ! so2 oxidn. -real, private, dimension(2), save :: vw ! constant rates for logical, public,save :: prclouds_present ! true if precipitating clouds integer, public, parameter :: & @@ -201,9 +199,9 @@ module Aqueous_ml type, public :: WScav real :: W_sca ! Scavenging ratio/z_Sca/rho = W_sca/1.0e6 real :: W_sub ! same for subcloud -endtype WScav +end type WScav -integer, public, parameter :: NWETDEP_CALC = 14 ! No. of solublity classes +integer, public, parameter :: NWETDEP_CALC = 22 ! No. of solublity classes ! Note - these are for "master" or model species - they do not ! need to be present in the chemical scheme. However, the chemical ! scheme needs to define wet scavenging after these. If you would @@ -213,7 +211,9 @@ module Aqueous_ml CWDEP_H2O2 = 5, CWDEP_HCHO = 6, CWDEP_PMf = 7, CWDEP_PMc = 8, & CWDEP_ECfn = 9, CWDEP_SSf = 10, CWDEP_SSc = 11, CWDEP_SSg = 12, & CWDEP_POLLw= 13, & - CWDEP_ROOH = 14 ! TEST!! + CWDEP_ROOH = 14, & ! TEST!! + CWDEP_0p2 = 15, CWDEP_0p3 = 16, CWDEP_0p4 = 17, CWDEP_0p5 = 18, & + CWDEP_0p6 = 19, CWDEP_0p7 = 20, CWDEP_0p8 = 21, CWDEP_1p3 = 22 integer, parameter, public :: & CWDEP_ASH1=CWDEP_PMf,CWDEP_ASH2=CWDEP_PMf,CWDEP_ASH3=CWDEP_PMf,& CWDEP_ASH4=CWDEP_PMf,CWDEP_ASH5=CWDEP_PMc,CWDEP_ASH6=CWDEP_PMc,& @@ -281,7 +281,17 @@ subroutine Init_WetDep() WetDep(CWDEP_PMf) = WScav( 1.0, EFF25) !! WetDep(CWDEP_PMc) = WScav( 1.0, EFFCO) !! WetDep(CWDEP_POLLw) = WScav( 1.0, SUBCLFAC) ! pollen - WetDep(CWDEP_ROOH) = WScav( 0.05, 0.015) ! assumed half of HCHO +!RB extras: +!perhaps too high for MeOOH? About an order of magnitude lower H* than HCHO: + WetDep(CWDEP_ROOH) = WScav( 0.05, 0.015) ! assumed half of HCHO - + WetDep(CWDEP_0p2) = WScav( 0.2, 0.06) ! + WetDep(CWDEP_0p3) = WScav( 0.3, 0.09) ! + WetDep(CWDEP_0p4) = WScav( 0.4, 0.12) ! + WetDep(CWDEP_0p5) = WScav( 0.5, 0.15) ! + WetDep(CWDEP_0p6) = WScav( 0.6, 0.18) ! + WetDep(CWDEP_0p7) = WScav( 0.7, 0.21) ! + WetDep(CWDEP_0p8) = WScav( 0.8, 0.24) ! + WetDep(CWDEP_1p3) = WScav( 1.3, 0.39) ! ! Other PM compounds treated with SO4-LIKE array defined above @@ -308,7 +318,7 @@ subroutine Init_WetDep() elseif(DEBUG%AQUEOUS.and.MasterProc)then call CheckStop(WDEP_PREC,find_index(dname,f_2d(:)%name),& "Inconsistent WDEP_WANTED/f_2d definition for "//trim(dname)) - endif + end if case("SPEC") iadv=f_2d(f2d)%index if(iadv>0) then @@ -317,7 +327,7 @@ subroutine Init_WetDep() elseif(DEBUG%AQUEOUS.and.MasterProc)then call CheckStop(iadv,find_index(dname,species_adv(:)%name),& "Inconsistent WDEP_WANTED/f_2d definition for "//trim(dname)) - endif + end if case("GROUP") igrp=f_2d(f2d)%index if(igrp>0) then @@ -328,15 +338,15 @@ subroutine Init_WetDep() elseif(DEBUG%AQUEOUS.and.MasterProc)then call CheckStop(igrp,find_index(dname,chemgroups(:)%name),& "Inconsistent WDEP_WANTED/f_2d definition for "//trim(dname)) - endif - endselect + end if + end select if(DEBUG%AQUEOUS.and.MasterProc) then write(*,"(2a,3i5)") "WETPPP ", trim(f_2d(f2d)%name), f2d, iadv, igrp if(igrp>0) write(*,*) "WETFGROUP ", nwgrp, wetGroupUnits(nwgrp)%iadv if(iadv>0) write(*,*) "WETFSPEC ", nwspec, iadv - endif - enddo + end if + end do !####################### END indices here ########## @@ -350,14 +360,14 @@ subroutine Init_WetDep() "CHECKING WetDep Calc2adv ", n,icalc,iadv,nc Calc2adv(icalc,0 ) = nc Calc2adv(icalc,nc) = iadv - enddo + end do if(MasterProc.and.DEBUG%AQUEOUS) then write(*,*) "FINAL WetDep Calc2adv " write(*,"(i3,i4,15(1x,a))") (icalc, Calc2adv(icalc,0), & (trim(species_adv(Calc2adv(icalc,nc))%name),nc=1,Calc2adv(icalc,0)),& icalc=1,NWETDEP_CALC) - endif + end if end subroutine Init_WetDep !----------------------------------------------------------------------- subroutine Setup_Clouds(i,j,debug_flag) @@ -387,12 +397,12 @@ subroutine Setup_Clouds(i,j,debug_flag) ! do k= KUPPER+1, KMAX_MID ! pr_acc(k) = pr_acc(k-1) + pr(i,j,k) ! pr_acc(k) = max( pr_acc(k), 0.0 ) -! enddo +! end do !now pr is already defined correctly (>=0) do k= KUPPER, KMAX_MID pr_acc(k) = pr(i,j,k) - enddo + end do prclouds_present=(pr_acc(KMAX_MID)>PR_LIMIT) ! --> precipitation at the surface @@ -435,15 +445,15 @@ subroutine Setup_Clouds(i,j,debug_flag) !hf pres(k)=ps(i,j,1) if(kcloudtop<0) kcloudtop = k - endif - enddo + end if + end do if(kcloudtop == -1) then if(prclouds_present.and.DEBUG%AQUEOUS) & write(*,"(a20,2i5,3es12.4)") "ERROR prclouds sum_cw", & i,j, maxval(lwc(i,j,KUPPER:KMAX_MID),1), maxval(pr(i,j,:)), pr_acc(KMAX_MID) kcloudtop = KUPPER ! for safety - endif + end if ! sets up the aqueous phase reaction rates (SO2 oxidation) and the ! fractional solubility @@ -465,7 +475,7 @@ subroutine Setup_Clouds(i,j,debug_flag) +2.*so32_aq(ksubcloud-1)+no3_aq(ksubcloud-1)-nh4_aq(ksubcloud-1)-nh3_aq(ksubcloud-1) write(*,*) "CLW(l_vann/l_luft) ",cloudwater(ksubcloud-1) write(*,*) "xn_2d(SO4) ugS/m3 ",(xn_2d(SO4,k)*10.e12*32./AVOG,k=kcloudtop,KMAX_MID) - endif + end if end subroutine Setup_Clouds !----------------------------------------------------------------------- @@ -664,9 +674,9 @@ subroutine setup_aqurates(b ,cloudwater,incloud,pres) /(pHin(iter-1)-pHin(iter)-pHout(iter-1)+pHout(iter)) pH(k)=max(1.0,min(pH(k),7.0))! between 1 and 7 h_plus(k)=exp(-pH(k)*log(10.)) - endif + end if - enddo + end do !after pH determined, final numbers of frac_aq(IH_SO2) @@ -692,7 +702,7 @@ subroutine setup_aqurates(b ,cloudwater,incloud,pres) ! aqrck(ICLRC2,k) = caqo3(k) * INV_Hplus0p4 * fso2grid(k) aqrck(ICLRC2,k) = caqo3(k) * invhplus04 * fso2grid(k) aqrck(ICLRC3,k) = caqsx(k) * fso2grid(k) - enddo + end do end subroutine setup_aqurates !----------------------------------------------------------------------- subroutine get_frac(cloudwater,incloud) @@ -722,8 +732,8 @@ subroutine get_frac(cloudwater,incloud) ! Get aqueous fractions: do ih = 1, NHENRY frac_aq(ih,k) = 1.0 / ( 1.0+1.0/( H(ih,itemp(k))*VfRT ) ) - enddo - enddo + end do + end do end subroutine get_frac !----------------------------------------------------------------------- subroutine WetDeposition(i,j,debug_flag) @@ -746,13 +756,14 @@ subroutine WetDeposition(i,j,debug_flag) real :: loss ! conc. loss due to scavenging real, dimension(KUPPER:KMAX_MID) :: vw ! Svavenging rates (tmp. array) real, dimension(KUPPER:KMAX_MID) :: lossfac ! EGU + real, dimension(KUPPER:KMAX_MID) :: lossfacPMf ! for particle fraction of semi-volatile (VBS) species invgridarea = xm2(i,j)/( gridwidth_m*gridwidth_m ) f_rho = 1.0/(invgridarea*GRAV*ATWAIR) ! Loop starting from above: do k=kcloudtop, KMAX_MID ! No need to go above cloudtop rho(k) = f_rho*(dA(k) + dB(k)*ps(i,j,1))/ amk(k) - enddo + end do wdeploss(:) = 0.0 @@ -762,6 +773,13 @@ subroutine WetDeposition(i,j,debug_flag) if(DEBUG%AQUEOUS.and.debug_flag) write(*,*) "(a15,2i4,es14.4)", & "DEBUG_WDEP2", kcloudtop, ksubcloud, pr_acc(KMAX_MID) +! need particle fraction wet deposition for semi-volatile species - here hard coded to use scavenging parameters for PMf + vw(kcloudtop:ksubcloud-1) = WetDep(CWDEP_PMf)%W_sca ! Scav. for incloud + vw(ksubcloud:KMAX_MID ) = WetDep(CWDEP_PMf)%W_sub ! Scav. for subcloud + do k = kcloudtop, KMAX_MID + lossfacPMf(k) = exp( -vw(k)*pr_acc(k)*dt ) + enddo + do icalc = 1, NWETDEP_CALC ! Here we loop over "model" species ! Put both in- and sub-cloud scavenging ratios in the array vw: @@ -779,8 +797,10 @@ subroutine WetDeposition(i,j,debug_flag) itot = iadv+NSPEC_SHL ! For semivolatile species only the particle fraction is deposited +!RB: This assumption needs to be revised. The semi-volatile organics are likely highly soluble and should wet deposit also in the gas phase if(itot>=FIRST_SEMIVOL .and. itot<=LAST_SEMIVOL) then - loss = xn_2d(itot,k) * Fpart(itot,k)*( 1.0 - lossfac(k) ) +! loss = xn_2d(itot,k) * Fpart(itot,k)*( 1.0 - lossfac(k) ) + loss = xn_2d(itot,k) * ( Fpart(itot,k)*( 1.0 - lossfacPMf(k) ) + (1.0-Fpart(itot,k))*( 1.0 - lossfac(k) ) ) else loss = xn_2d(itot,k) * ( 1.0 - lossfac(k) ) endif @@ -793,10 +813,10 @@ subroutine WetDeposition(i,j,debug_flag) do k = kcloudtop, KMAX_MID write(*,"(a,2i4,a,9es12.2)") "DEBUG_WDEP, k, icalc, spec", k, & icalc, trim(species_adv(iadv)%name), vw(k), pr_acc(k), lossfac(k) - enddo ! k loop - endif ! DEBUG%AQUEOUS + end do ! k loop + end if ! DEBUG%AQUEOUS - enddo ! icalc loop + end do ! icalc loop if(WDEP_PREC>0)d_2d(WDEP_PREC,i,j,IOU_INST) = pr(i,j,KMAX_MID) * dt ! Same for all models @@ -809,7 +829,6 @@ subroutine WetDep_Budget(i,j,invgridarea, debug_flag) real, intent(in) :: invgridarea logical, intent(in) :: debug_flag - logical :: inside integer :: f2d, igrp ,iadv, n, g real :: wdep type(group_umap), pointer :: gmap=>null() ! group unit mapping @@ -827,7 +846,7 @@ subroutine WetDep_Budget(i,j,invgridarea, debug_flag) if(DEBUG%MY_WETDEP.and.debug_flag) & call datewrite("WET-PPPSPEC: "//species_adv(iadv)%name,& iadv,(/wdeploss(iadv)/)) - enddo + end do ! Deriv.Output: groups of species (SOX, OXN, etc.) as needed do n = 1, nwgrp @@ -843,9 +862,9 @@ subroutine WetDep_Budget(i,j,invgridarea, debug_flag) iadv=gmap%iadv(g) call datewrite("WET-PPPGROUP: "//species_adv(iadv)%name ,& iadv,(/wdeploss(iadv)/)) - enddo - endif - enddo + end do + end if + end do end subroutine WetDep_Budget !----------------------------------------------------------------------- end module Aqueous_ml diff --git a/BLPhysics_ml.f90 b/BLPhysics_ml.f90 index 91818d7..f2125ce 100644 --- a/BLPhysics_ml.f90 +++ b/BLPhysics_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -30,6 +30,7 @@ module BLPhysics_ml ! here in future. Try to keep 1-D or elemental to allow use in offline codes ! (*No* routines in use, except for testing) + use emep_Config_mod, only : PBL use Landuse_ml, only : Landcover, water_fraction use ModelConstants_ml, only : KMAX_MID, KMAX_BND, KWINDTOP, PT use PhysicalConstants_ml, only : KARMAN, GRAV @@ -38,8 +39,8 @@ module BLPhysics_ml ! minimum value now generally calculated as z_mid(19), but we ! keep a fixed value for smoothing. - real, parameter, public :: PBL_ZiMIN=100. ! EMEP/TI and smooth(zi) - real, parameter, public :: PBL_ZiMAX=3000. ! EMEP/TI +! real, parameter, public :: PBL_ZiMIN=100. ! EMEP/TI and smooth(zi) +! real, parameter, public :: PBL_ZiMAX=3000. ! EMEP/TI ! Choose one Hmix method here (not needed for NWP?) character(len=4), parameter, public :: HmixMethod = & @@ -218,8 +219,8 @@ subroutine SeibertRiB_Hmix (u,v, zm, theta, pzpbl) if(Rib >= Ric) then pzpbl = zm(k) exit - endif - enddo + end if + end do end subroutine SeibertRiB_Hmix @@ -249,26 +250,24 @@ subroutine JericevicRiB_Hmix (u,v, zm, theta, zi) if(Rib >= Ric) then zi = zm(k) exit - endif - enddo + end if + end do end subroutine JericevicRiB_Hmix !---------------------------------------------------------------------------- -subroutine JericevicRiB_Hmix0 (u,v, zm, theta, zi, theta0, coastal) +subroutine JericevicRiB_Hmix0 (u,v, zm, theta, zi) !- as above, but allow test for surface SBL real, dimension(KMAX_MID), intent(in) :: u,v ! winds real, dimension(KMAX_MID), intent(in) :: zm ! mid-cell height real, dimension(KMAX_MID), intent(in) :: theta !pot. temp real, intent(out) :: zi - real, intent(in) :: theta0 ! pot temp at ground (2m) - logical, intent(in) :: coastal ! or likely coastal, be careful integer :: k real, parameter :: Ric = 0.25 ! critical Ric real :: Rib ! bulk Richardson number real :: Theta1, z1 ! pot temp and height of lowest cell -! Jericevic et al., ACP, 2009, pp1001-, eqn (17): +! Jericevic et al., ACP, 2009, pp1001-, eqn (17): Theta1 = theta(KMAX_MID) z1 = zm(KMAX_MID) @@ -282,8 +281,8 @@ subroutine JericevicRiB_Hmix0 (u,v, zm, theta, zi, theta0, coastal) if(Rib >= Ric) then zi = zm(k) exit - endif - enddo + end if + end do end subroutine JericevicRiB_Hmix0 @@ -322,8 +321,8 @@ subroutine VogelezangHoltslag_Hmix (u,v, zm, theta, q, ustar, pzpbl) if(Rig >= Ric) then pzpbl = zm(k) exit - endif - enddo + end if + end do end subroutine VogelezangHoltslag_Hmix !---------------------------------------------------------------------------- @@ -422,7 +421,7 @@ subroutine PielkeBlackadarKz (u,v, zm, zb, th, Kz, Pielke_flag, debug_flag) Kz(k)=xl2*dvdz*(1.-Ris(k)/Ric) else Kz(k)=KZ_MINIMUM - endif + end if end if ! Pielke or Blackadar end do ! k @@ -584,7 +583,7 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) !..The height of the stable BL is the lowest level for which: !..xksm .le. 1 m2/s (this limit may be changed): - zis = PBL_ZiMIN + zis = PBL%ZiMIN nh1 = KMAX_MID nh2 = 1 @@ -594,11 +593,11 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) nh1=k ! Still unstable else nh2=0 ! Now stable - endif + end if end do k=nh1 - if(zb(nh1) >= PBL_ZiMIN) then + if(zb(nh1) >= PBL%ZiMIN) then if( abs(xksm(k)-xksm(k-1)) > eps) then @@ -606,10 +605,10 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) + (KZ_SBL_LIMIT -xksm(k-1))*zb(k))& /(xksm(k)-xksm(k-1)) else - zis= PBL_ZiMIN - endif + zis= PBL%ZiMIN + end if - endif + end if zi = zis @@ -634,7 +633,7 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) ! if ( debug_flag ) write(6,"(a,i3,3es10.3)") "DEBUG THC ", ! k, th(k), dthc, thc(k) - enddo + end do !..estimated as the height to which an hour's input !..of heat from the ground is vertically distributed, @@ -681,7 +680,7 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) ! if ( debug_flag ) write(6,"(a,i3,2es10.3,i4)") "DEBUG PICTH ",& ! kabl, delq, pidth, trc - endif + end if if ( debug_flag ) write(6,"(a,i3,es10.3,i5)") "DEBUG mid ", & @@ -696,15 +695,15 @@ subroutine TI_Hmix (Kz, zm, zb, fh, th, exnm, pb, zi, debug_flag) !end if - ziu=PBL_ZiMAX + ziu=PBL%ZiMAX trc=0 - endif + end if end do ! while zi = max( ziu, zis) - zi = min( PBL_ZiMAX, zi) + zi = min( PBL%ZiMAX, zi) end subroutine TI_Hmix @@ -792,9 +791,9 @@ subroutine O_BrienKz( zi, zs_bnd, ustar, invL , Kz, debug_flag ) ! + 2.*(Kzhs-Kzzi)/zimhs)) if ( debug_flag ) & write(*,"(a,i3,es12.3)") "OBRIEN Kz(k) ", k, Kz(k) - endif + end if - endif + end if end do diff --git a/Biogenics_ml.f90 b/Biogenics_ml.f90 index 44b4f6e..6bcb62b 100644 --- a/Biogenics_ml.f90 +++ b/Biogenics_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -55,10 +55,12 @@ module Biogenics_ml ! conserving these very imperfect numbers accurately ;-) ! ! Dave Simpson, 2010-2012 + ! Updated for CLM-GLC merge, 2017 !--------------------------------------------------------------------------- - use CheckStop_ml, only: CheckStop, StopAll !BIO + use CheckStop_ml, only: CheckStop, StopAll use ChemSpecs, only : species + use emep_Config_mod, only: EmBio use GridValues_ml , only : i_fdom,j_fdom, debug_proc,debug_li,debug_lj use Io_ml , only : IO_FORES, open_file, ios, PrintLog, datewrite use KeyValueTypes, only : KeyVal,KeyValue @@ -68,7 +70,7 @@ module Biogenics_ml use LocalVariables_ml, only : Grid ! -> izen, DeltaZ use MetFields_ml, only : t2_nwp use ModelConstants_ml, only : NPROC, MasterProc, TINY, & - USES, NLANDUSEMAX, IOU_INST, & + NLANDUSEMAX, IOU_INST, & KT => KCHEMTOP, KG => KMAX_MID, & EURO_SOILNOX_DEPSCALE, & DEBUG, BVOC_USED, MasterProc, & @@ -104,9 +106,8 @@ module Biogenics_ml !e.g. ! integer, parameter, public :: NEMIS_BioNat = 3 ! character(len=7), save, dimension(NEMIS_BioNat), public:: & - ! EMIS_BioNat = (/ "C5H8 " , "APINENE" , "NO " /) + ! EMIS_BioNat = (/ "C5H8 " , "BIOTERP" , "NO " /) - INTEGER STATUS(MPI_STATUS_SIZE),INFO integer, public, parameter :: N_ECF=2, ECF_ISOP=1, ECF_TERP=2 integer, public, parameter :: BIO_ISOP=1, BIO_MTP=2, & BIO_MTL=3 ! , BIO_SOILNO=4, BIO_SOILNH3=5 @@ -123,8 +124,6 @@ module Biogenics_ml ! (Currently for 1st four LCC, CF, DF, BF, NF) logical, private, dimension(NLANDUSEMAX), save :: HaveLocalEF -! real, public, save, dimension(LIMAX,LJMAX,size(BVOC_USED)+NSOIL_EMIS) :: & - ! EmisNat is used for BVOC; soil-NO, also in futur for sea-salt etc. ! Main criteria is not provided in gridded data-bases, often land-use ! dependent. @@ -152,8 +151,8 @@ module Biogenics_ml real, public, save, dimension(N_ECF,40) :: canopy_ecf ! Canopy env. factors ! Indices for the species defined in this routine. Only set if found - integer, private, save :: ispec_C5H8, ispec_APIN, ispec_NO , ispec_NH3 - integer, private, save :: itot_C5H8, itot_APIN, itot_NO , itot_NH3 + integer, private, save :: ispec_C5H8, ispec_TERP, ispec_NO , ispec_NH3 + integer, private, save :: itot_C5H8, itot_TERP, itot_NO , itot_NH3 contains !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -189,19 +188,19 @@ subroutine Init_BVOC() !==================================== ! get indices. NH3 not yet used. ispec_C5H8 = find_index( "C5H8", EMIS_BioNat(:) ) - ispec_APIN = find_index( "APINENE", EMIS_BioNat(:) ) + ispec_TERP = find_index( "BIOTERP", EMIS_BioNat(:) ) ispec_NO = find_index( "NO", EMIS_BioNat(:) ) ispec_NH3 = find_index( "NH3", EMIS_BioNat(:) ) call CheckStop( ispec_C5H8 < 1 , "BiogencERROR C5H8") - !call CheckStop( ispec_APIN < 1 , "BiogencERROR APIN") - if( ispec_APIN < 0 ) call PrintLog("WARNING: No APINENE Emissions") + !call CheckStop( ispec_TERP < 1 , "BiogencERROR TERP") + if( ispec_TERP < 0 ) call PrintLog("WARNING: No TERPENE Emissions") call CheckStop( USE_EURO_SOILNOX .and. ispec_NO < 1 , "BiogencERROR NO") call CheckStop( USE_GLOBAL_SOILNOX .and. ispec_NO < 1 , "BiogencERROR NO") if( MasterProc ) write(*,*) "SOILNOX ispec ", ispec_NO itot_C5H8 = find_index( "C5H8", species(:)%name ) - itot_APIN = find_index( "APINENE", species(:)%name ) + itot_TERP = find_index( "BIOTERP", species(:)%name ) itot_NO = find_index( "NO", species(:)%name ) itot_NH3 = find_index( "NH3", species(:)%name ) @@ -290,17 +289,19 @@ subroutine GetEuroBVOC() ibvoc = find_index( VegName(iveg), LandDefs(:)%code ) HaveLocalEF(ibvoc) = .true. do iEmis = 1, size(BVOC_USED) - varname = trim(BVOC_USED(iEmis)) // "_" // trim(VegName(iVeg)) + varname = trim(BVOC_USED(iEmis)) // "_" // trim(VegName(iVeg)) - call ReadField_CDF('EMEP_EuroBVOC.nc',varname,& - bvocEF(:,:,ibvoc,iEmis),1,interpol='zero_order',needed=.true.,debug_flag=.false.,UnDef=-999.0) + call ReadField_CDF('EMEP_EuroBVOC.nc',varname,& + bvocEF(:,:,ibvoc,iEmis),1,interpol='zero_order',needed=.true.,& + debug_flag=.false.,UnDef=-999.0) if( debug_proc ) then - write(*, "(2a,f12.3,3i2)") "EURO-BVOC:E ", & - trim(varname), bvocEF(debug_li, debug_lj,ibvoc,iEmis), iVeg, ibvoc, iEmis - write(*, "(2a,2es12.3)") "EURO-BVOC:minmax ", & - trim(varname), minval(bvocEF(:,:,ibvoc,iEmis)), maxval(bvocEF(:,:,ibvoc,iEmis)) + write(*, "(2a,f12.3,3i2)") "EURO-BVOC:E ", & + trim(varname), bvocEF(debug_li, debug_lj,ibvoc,iEmis), & + iVeg, ibvoc, iEmis + write(*, "(2a,2es12.3)") "EURO-BVOC:minmax ", trim(varname), & + minval(bvocEF(:,:,ibvoc,iEmis)), maxval(bvocEF(:,:,ibvoc,iEmis)) end if end do @@ -331,15 +332,24 @@ end subroutine GetEuroBVOC !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine MergedBVOC() - integer :: i, j, nlu, iL, iiL + integer :: i, j, nlu, iL, iiL, gLC1 integer :: pft + character(len=15) :: merge_case real :: biso, bmt ! Just for printout logical :: use_local, debug_flag + character(len=*),parameter :: dtxt='MergedBvoc:' + - if( MasterProc .and. DEBUG%BIO ) write(*,*) "Into MergedBVOC" + if ( debug_proc ) then + write(*,*) dtxt//" Start" + i= debug_li; j= debug_lj + nlu= LandCover(i,j)%ncodes + write(*,*) 'MEGAN DBG stuff:', me, debug_proc, debug_li, debug_lj + write(*,*) 'MEGAN DBG codes:', nlu, LandCover(i,j)%codes(1:nlu) + end if - do i = 1, limax !PPP LIMAX - do j = 1, ljmax !PPP LJMAX + do i = 1, limax + do j = 1, ljmax nlu = LandCover(i,j)%ncodes @@ -351,26 +361,33 @@ subroutine MergedBVOC() iL = LandCover(i,j)%codes(iiL) pft = LandType(iL)%pft - if( debug_flag ) then - write(*,"(a,2i7,2L2,i3)") & - "TryMergeBVOC" //trim(LandDefs(iL)%name), iL, pft, & - use_local, HaveLocalEF(iL), last_bvoc_LC - end if + gLC1 = -1 + !.. some MEGAN pre-code removed here if( use_local .and. HaveLocalEF(iL) ) then ! Keep EFs from EuroBVOC - if( debug_flag ) write(*,*) "MergeBVOC: Inside local" + if( debug_flag ) merge_case = 'Local' + + !.. some MEGAN pre-code removed here else if ( iL <= last_bvoc_LC ) then ! otherwise use defaults - bvocEF(i,j,iL,BIO_ISOP) = LandDefs(iL)%Eiso * LandDefs(iL)%BiomassD - bvocEF(i,j,iL,BIO_MTP) = LandDefs(iL)%Emtp * LandDefs(iL)%BiomassD - bvocEF(i,j,iL,BIO_MTL) = LandDefs(iL)%Emtl * LandDefs(iL)%BiomassD - if( debug_flag ) write(*,"(a,i3,8f8.2)") & + + ! CLF canopy light factor, 1/1.7=0.59, based on Lamb 1993 (cf MEGAN 0.57) + bvocEF(i,j,iL,BIO_ISOP) = LandDefs(iL)%Eiso * & + LandDefs(iL)%BiomassD *EmBio%CLF + bvocEF(i,j,iL,BIO_MTL) = LandDefs(iL)%Emtl * & + LandDefs(iL)%BiomassD *EmBio%CLF + bvocEF(i,j,iL,BIO_MTP) = LandDefs(iL)%Emtp * & + LandDefs(iL)%BiomassD + if( debug_flag ) then + merge_case = 'defaultBVOC' + write(*,"(a,i3,8f8.2)") & "MergeBVOC: Outside local", iL, LandDefs(iL)%BiomassD,& LandDefs(iL)%Eiso, LandDefs(iL)%Emtp, LandDefs(iL)%Emtl + end if else - if( debug_flag ) write(*,*) "MergeBVOC: Outside LCC", iL + if( debug_flag ) merge_case = 'OutsideLCC' end if @@ -380,16 +397,17 @@ subroutine MergedBVOC() bmt = 0.0 if ( iL <= last_bvoc_LC ) then biso = bvocEF(i, j,iL, BIO_ISOP) - bmt = bvocEF(i, j,iL, BIO_TERP) + bmt = bvocEF(i,j,iL,BIO_MTL)+bvocEF(i,j,iL,BIO_MTL) end if - write(*,"(a,2i4,2L2,f9.4,9f10.3)") "MergeBVOC", & - iL, pft, use_local, HaveLocalEF(iL), & - LandCover(i,j)%fraction(iiL), biso, bmt, LandDefs(iL)%Eiso, & - LandDefs(iL)%Emtp, LandDefs(iL)%Emtl + write(*,"(a24,2i4,2L2,f9.4,9f10.3)") & + "MergeBVOC:" // trim(merge_case), & + iL, pft, use_local, HaveLocalEF(iL), & + LandCover(i,j)%fraction(iiL), biso, bmt,& + LandDefs(iL)%Eiso, LandDefs(iL)%Emtp, LandDefs(iL)%Emtl end if end do LULOOP - end do - end do + end do !j + end do !i end subroutine MergedBVOC !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -404,22 +422,23 @@ subroutine SetDailyBVOC() real :: b ! Just for printout logical :: mydebug logical, save :: my_first_call = .true. - real, allocatable, dimension(:,:) :: workarray + real, allocatable, dimension(:,:,:) :: workarray + character(len=*), parameter :: dtxt='SetDailyBVOC:' - if( MasterProc .and. DEBUG%BIO ) write(*,"(a,3i5)") "Into SetDailyBVOC", & + if( MasterProc .and. DEBUG%BIO ) write(*,"(a,3i5)") dtxt//"start ", & daynumber, last_daynumber, last_bvoc_LC if ( daynumber == last_daynumber ) return last_daynumber = daynumber if ( DEBUG%BIO .and. my_first_call ) then - allocate( workarray(LIMAX,LJMAX), stat=alloc_err ) - call CheckStop( alloc_err , "workarray alloc failed" ) + allocate( workarray(last_bvoc_LC,LIMAX,LJMAX), stat=alloc_err ) + call CheckStop( alloc_err , dtxt//"workarray alloc failed" ) workarray = 0.0 end if - do i = 1, limax !PPP LIMAX - do j = 1, ljmax !PPP LJMAX + do i = 1, limax + do j = 1, ljmax nlu = LandCover(i,j)%ncodes @@ -436,9 +455,8 @@ subroutine SetDailyBVOC() !for tundra and wetlands we have zero LAI, so omit !LAI scaling. Not an ideal system.... rewrite one day. - if( LandCover(i,j)%LAI(iiL)< 1.0e-5 ) then ! likely wetlands, tundra - LAIfac = 1.0 - if( mydebug ) write(*,*)"BVOC TUNDRA/WETLANDS",iL,LandCover(i,j)%LAI(iiL) + if( LandCover(i,j)%LAI(iiL)< 1.0e-5 ) then + LAIfac = 1.0 ! likely wetlands, tundra else LAIfac = LandCover(i,j)%LAI(iiL)/LandDefs(IL)%LAImax LAIfac= min(LAIfac, 1.0) @@ -449,40 +467,36 @@ subroutine SetDailyBVOC() do ibvoc = 1, size(BVOC_USED) day_embvoc(i,j,ibvoc) = day_embvoc(i,j,ibvoc) + & LAIfac * max(1.0e-10,bvocEF(i,j,iL,ibvoc)) - !done above LandCover(i,j)%fraction(iiL) * & end do if ( mydebug ) then b = 0.0 if ( iL <= last_bvoc_LC ) b = bvocEF(i, j,iL, BIO_ISOP) - write(*,"(a,a10,2i5,f9.5,2f7.3,8f10.3)") "SetBVOC", & + write(*,"(a,a10,2i5,f9.5,2f7.3,9f10.3)") dtxt//"Set ", & trim(LandDefs(iL)%name), daynumber, iL, & LandCover(i,j)%fraction(iiL), & - LandCover(i,j)%LAI(iiL), LandDefs(iL)%LAImax, b,& + LandCover(i,j)%LAI(iiL), LandDefs(iL)%LAImax, b, LAIfac, & ( day_embvoc(i, j, ibvoc), ibvoc = 1, size(BVOC_USED) ) - !PALEO write(*,'(a,i3,3g12.3)') "NPALEObvoc ", me, & - ! PALEO_mlai(i,j), PALEO_miso(i,j),PALEO_mmon(i,j) - + end if ! When debugging it helps with an LAI map if( DEBUG%BIO .and. my_first_call ) & - workarray(i,j) = workarray(i,j) + & - LandCover(i,j)%LAI(iiL)*LandCover(i,j)%fraction(iiL) + workarray(iL,i,j) = workarray(iL,i,j) + & + bvocEF(i, j,iL, BIO_ISOP) * & + LandDEfs(iL)%LAImax*LandCover(i,j)%fraction(iiL) end do LULOOP - end do + end do ! ij end do - if ( DEBUG%BIO ) then -! if ( my_first_call ) then ! print out 1st day -! call printCDF("BIO-LAI", workarray, "m2/m2" ) -! workarray(:,:) = day_embvoc(:,:,1) -! call printCDF("BIO-Eiso", workarray, "ug/m2/h" ) -! workarray(:,:) = day_embvoc(:,:,2) + day_embvoc(:,:,3) -! call printCDF("BIO-Emt", workarray, "ug/m2/h" ) -! deallocate( workarray ) -! end if - end if - my_first_call = .false. + if ( my_first_call ) then ! print out 1st day + if ( DEBUG%BIO ) then + do iL = 1, 12 + call printCDF(dtxt//"BIO-OUT"//trim(LandDefs(iL)%code), & + workarray(iL,:,:), "ug/m2/h" ) + end do + end if + end if + my_first_call = .false. end subroutine SetDailyBVOC !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -496,9 +510,9 @@ subroutine TabulateECF() agts = 303. agr = 8.314 - agtm = 314. - agct1 = 95000. - agct2 = 230000. + agtm = 314. ! G93/G95 + agct1 = 95000. ! G93/G95 + agct2 = 230000. ! G93/G95 do it = 1,40 itk = it + 273.15 @@ -509,6 +523,7 @@ subroutine TabulateECF() ! Terpenes agct = exp( 0.09*(itk-agts) ) + !agct = exp( 0.1*(itk-agts) ) canopy_ecf(ECF_TERP,it) = agct !?? for terpene fac = 0.5*fac(iso): as mass terpene = 2xmass isoprene @@ -538,24 +553,28 @@ subroutine setup_bio(i,j) real :: E_ISOP, E_MTP, E_MTL ! To get from ug/m2/h to molec/cm3/s -! ug -> g 1.0e-9; g -> mole / MW; x AVOG -! will need /Grid%DeltaZ +! ug -> g 1.0e-6; m2-> cm2 1e-4, g -> mole / MW; x AVOG +! will use /Grid%DeltaZ, which is in m, so anoter 1e-2 tp et cm-3 real, parameter :: & biofac_ISOP = 1.0e-12*AVOG/68.0 /3600.0 & ,biofac_TERP = 1.0e-12*AVOG/136.0/3600.0 & ,biofac_SOILNO = 1.0e-12*AVOG/14.0 /3600.0 & ,biofac_SOILNH3= 1.0e-12*AVOG/14.0 /3600.0 + logical :: dbg ! Light effects added for isoprene emissions real :: par ! Photosynthetically active radiation real :: cL ! Factor for light effects real, parameter :: & - CL1 = 1.066 , & ! Guenther et al's params - ALPHA = 0.0027 ! Guenther et al's params + CL1 = 1.066 , & ! Guenther et al's G93/G95 params + ALPHA = 0.0027!,& ! Guenther et al's G93/G95 params +! AG99 = 0.001 * 1.42 ! " Warneke update, but not same as G99? if ( size(BVOC_USED) == 0 ) return ! e.g. for ACID only + dbg = ( DEBUG%BIO .and. debug_proc .and. & + i==debug_li .and. j==debug_lj .and. current_date%seconds == 0 ) it2m = nint( Grid%t2C - TINY ) it2m = max(it2m,1) @@ -572,11 +591,12 @@ subroutine setup_bio(i,j) ! E in ug/m2/h - E_ISOP = day_embvoc(i,j,BIO_ISOP)*canopy_ecf(BIO_ISOP,it2m) * cL + E_ISOP = day_embvoc(i,j,BIO_ISOP)*canopy_ecf(BIO_ISOP,it2m) * cL & + * EmBio%IsopFac ! Add light-dependent terpenes to pool-only if(BIO_TERP > 0) E_MTL = & - day_embvoc(i,j,BIO_MTL)*canopy_ecf(ECF_TERP,it2m)*cL + day_embvoc(i,j,BIO_MTL)*canopy_ecf(ECF_TERP,it2m)*cL * EmBio%TerpFac ! molecules/cm3/s ! And we scale EmisNat to get units kg/m2 consistent with @@ -592,15 +612,15 @@ subroutine setup_bio(i,j) E_ISOP = 0.0 par = 0.0 ! just for printout cL = 0.0 ! just for printout - endif ! daytime + end if ! daytime - if ( ispec_APIN > 0 ) then + if ( ispec_TERP > 0 ) then ! add pool-only terpenes rate; - E_MTP = day_embvoc(i,j,BIO_MTP)*canopy_ecf(ECF_TERP,it2m) - rcemis(itot_APIN,KG) = rcemis(itot_APIN,KG) + & + E_MTP = day_embvoc(i,j,BIO_MTP)*canopy_ecf(ECF_TERP,it2m) * EmBio%TerpFac + rcemis(itot_TERP,KG) = rcemis(itot_TERP,KG) + & (E_MTL+E_MTP) * biofac_TERP/Grid%DeltaZ - EmisNat(ispec_APIN,i,j) = (E_MTL+E_MTP) * 1.0e-9/3600.0 + EmisNat(ispec_TERP,i,j) = (E_MTL+E_MTP) * 1.0e-9/3600.0 end if if ( USE_EURO_SOILNOX ) then @@ -619,13 +639,14 @@ subroutine setup_bio(i,j) end if - if ( DEBUG%BIO .and. debug_proc .and. i==debug_li .and. j==debug_lj .and. & - current_date%seconds == 0 ) then + if ( dbg ) then call datewrite("DBIO env ", it2m, (/ max(par,0.0), max(cL,0.0), & canopy_ecf(BIO_ISOP,it2m),canopy_ecf(BIO_TERP,it2m) /) ) call datewrite("DBIO EISOP EMTP EMTL ESOIL ", (/ E_ISOP, & E_MTP, E_MTL, SoilNOx(i,j) /) ) + call datewrite("DBIO rcemisL ", (/ & + rcemis(itot_C5H8,KG), rcemis(itot_TERP,KG) /)) call datewrite("DBIO EmisNat ", EmisNat(:,i,j) ) end if @@ -644,15 +665,15 @@ subroutine Set_SoilNOx() real :: beta, bmin, bmax, bx, by ! for beta function real :: hfac + + if ( .not. USE_EURO_SOILNOX ) return ! and fSW has been set to 1. at start + if( DEBUG_SOILNOX .and. debug_proc ) then write(*,*)"Biogenic_ml DEBUG_SOILNOX EURO: ",& current_date%day, current_date%hour, current_date%seconds,& USE_EURO_SOILNOX, EURO_SOILNOX_DEPSCALE end if - if ( .not. USE_EURO_SOILNOX ) return ! and fSW has been set to 1. at start - - ! We reset once per hour if ( current_date%seconds /= 0 .and. .not. my_first_call ) return diff --git a/BoundaryConditions_ml.f90 b/BoundaryConditions_ml.f90 index e32a4ba..1cbbb5c 100644 --- a/BoundaryConditions_ml.f90 +++ b/BoundaryConditions_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -204,16 +204,13 @@ subroutine BoundaryConditions(year,month) ! --------------------------------------------------------------------------- integer, intent(in) :: year ! "meteorology" year integer, intent(in) :: month - integer :: ibc, iem, k, iem1, i, j ,n, nadv,ntot ! loop variables + integer :: ibc, iem, k, i, j ,n, ntot ! loop variables integer :: info ! used in rsend - integer :: alloc_err real :: bc_fac ! Set to 1.0, except sea-salt over land = 0.01 logical :: bc_seaspec ! if sea-salt species - integer :: errcode, Nlevel_logan + integer :: errcode integer, save :: idebug=0, itest=1, i_test=0, j_test=0 - character(len = 100) ::fileName,varname - logical :: NewLogan=.true.! under testing real :: bc_data(LIMAX,LJMAX,KMAX_MID) if (first_call) then @@ -231,7 +228,7 @@ subroutine BoundaryConditions(year,month) bc_data=0.0 - endif ! first call + end if ! first call if (DEBUG%BCS) write(*, "((A,I0,1X))") & "CALL TO BOUNDARY CONDITIONS, me:", me, & "month ", month, "TREND2 YR ", iyr_trend, "me ", me @@ -239,7 +236,7 @@ subroutine BoundaryConditions(year,month) if (num_changed==0) then write(*,*) "BCs: No species requested" return - endif + end if errcode = 0 if (DEBUG%BCS.and.debug_proc) then @@ -248,10 +245,10 @@ subroutine BoundaryConditions(year,month) if (i_fdom(i)==DEBUG%IJ(1).and.j_fdom(j)==DEBUG%IJ(2)) then i_test = i j_test = j - endif - enddo - enddo - endif + end if + end do + end do + end if if (first_call) then idebug = 1 @@ -261,9 +258,9 @@ subroutine BoundaryConditions(year,month) do i = 1, limax xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo - enddo - enddo + end do + end do + end do else if (DEBUG%BCS.and.MasterProc) write(*,*) "RESET LATERAL BOUNDARIES" do k = 2, KMAX_MID @@ -272,38 +269,38 @@ subroutine BoundaryConditions(year,month) do i = 1, li0-1 xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo + end do !right do i = li1+1, limax xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo - enddo + end do + end do !lower do j = 1, lj0-1 do i = 1, limax xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo - enddo + end do + end do !upper do j = lj1+1, ljmax do i = 1, limax xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo - enddo - enddo + end do + end do + end do !top do k = 1, 1 do j = 1, ljmax do i = 1, limax xn_adv(:,i,j,k)=0.0 xn_bgn(:,i,j,k)=0.0 - enddo - enddo - enddo - endif + end do + end do + end do + end if !== BEGIN READ_IN OF GLOBAL DATA do ibc = 1, NGLOB_BC @@ -365,7 +362,7 @@ subroutine BoundaryConditions(year,month) end do ! i end do ! j end do ! k - enddo + end do else ! Set LATERAL (edge and top) arrays of new BCs @@ -394,7 +391,7 @@ subroutine BoundaryConditions(year,month) bc_fac * & ! used for sea-salt species ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_adv(ibc,iem) bc_data(i,j,k)*bc2xn_adv(ibc,iem) - enddo + end do !right do i = li1+1, limax bc_fac = 1.0 @@ -409,8 +406,8 @@ subroutine BoundaryConditions(year,month) ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_adv(ibc,iem) bc_data(i,j,k)*bc2xn_adv(ibc,iem) - enddo - enddo + end do + end do !lower do j = 1, lj0-1 do i = 1, limax @@ -426,8 +423,8 @@ subroutine BoundaryConditions(year,month) ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_adv(ibc,iem) bc_data(i,j,k)*bc2xn_adv(ibc,iem) - enddo - enddo + end do + end do !upper do j = lj1+1, ljmax do i = 1, limax @@ -443,9 +440,9 @@ subroutine BoundaryConditions(year,month) ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_adv(ibc,iem) bc_data(i,j,k)*bc2xn_adv(ibc,iem) - enddo - enddo - enddo + end do + end do + end do !top do k = 1, 1 do j = 1, ljmax @@ -462,9 +459,9 @@ subroutine BoundaryConditions(year,month) ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_adv(ibc,iem) bc_data(i,j,k)*bc2xn_adv(ibc,iem) - enddo - enddo - enddo + end do + end do + end do end do !n @@ -479,31 +476,31 @@ subroutine BoundaryConditions(year,month) xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) & ! + bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_bgn(ibc,iem) + bc_data(i,j,k)*bc2xn_bgn(ibc,iem) - enddo + end do !right do i = li1+1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) & ! + bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_bgn(ibc,iem) + bc_data(i,j,k)*bc2xn_bgn(ibc,iem) - enddo - enddo + end do + end do !lower do j = 1, lj0-1 do i = 1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) & ! + bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_bgn(ibc,iem) + bc_data(i,j,k)*bc2xn_bgn(ibc,iem) - enddo - enddo + end do + end do !upper do j = lj1+1, ljmax do i = 1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) & ! + bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_bgn(ibc,iem) + bc_data(i,j,k)*bc2xn_bgn(ibc,iem) - enddo - enddo - enddo + end do + end do + end do !top do k = 1, 1 do j = 1, ljmax @@ -511,12 +508,12 @@ subroutine BoundaryConditions(year,month) xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) & ! + bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)*bc2xn_bgn(ibc,iem) + bc_data(i,j,k)*bc2xn_bgn(ibc,iem) - enddo - enddo - enddo - enddo - endif - enddo ! ibc + end do + end do + end do + end do + end if + end do ! ibc if (first_call) then !3D misc do ibc = NGLOB_BC+1, NTOT_BC @@ -530,7 +527,7 @@ subroutine BoundaryConditions(year,month) end do ! i end do ! j end do ! k - enddo + end do do n = 1,bc_used_adv(ibc) iem = spc_used_adv(ibc,n) @@ -543,8 +540,8 @@ subroutine BoundaryConditions(year,month) end do ! i end do ! j end do ! k - enddo!n - enddo!ibc + end do!n + end do!ibc else !LATERAL misc do ibc = NGLOB_BC+1, NTOT_BC @@ -556,34 +553,34 @@ subroutine BoundaryConditions(year,month) !left do i = 1, li0-1 xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) +misc_bc(ibc,k) - enddo + end do !right do i = li1+1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) +misc_bc(ibc,k) - enddo - enddo + end do + end do !lower do j = 1, lj0-1 do i = 1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) +misc_bc(ibc,k) - enddo - enddo + end do + end do !upper do j = lj1+1, ljmax do i = 1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) +misc_bc(ibc,k) - enddo - enddo - enddo + end do + end do + end do !top do k = 1, 1 do j = 1, ljmax do i = 1, limax xn_bgn(iem,i,j,k) = xn_bgn(iem,i,j,k) +misc_bc(ibc,k) - enddo - enddo - enddo - enddo + end do + end do + end do + end do !/- Advected misc species do n = 1,bc_used_adv(ibc) iem = spc_used_adv(ibc,n) @@ -592,36 +589,36 @@ subroutine BoundaryConditions(year,month) !left do i = 1, li0-1 xn_adv(iem,i,j,k) = xn_adv(iem,i,j,k) + misc_bc(ibc,k)! - enddo + end do !right do i = li1+1, limax xn_adv(iem,i,j,k) = xn_adv(iem,i,j,k) + misc_bc(ibc,k)! - enddo - enddo + end do + end do !lower do j = 1, lj0-1 do i = 1, limax xn_adv(iem,i,j,k) = xn_adv(iem,i,j,k) + misc_bc(ibc,k)! - enddo - enddo + end do + end do !upper do j = lj1+1, ljmax do i = 1, limax xn_adv(iem,i,j,k) = xn_adv(iem,i,j,k) + misc_bc(ibc,k)! - enddo - enddo - enddo + end do + end do + end do !top do k = 1, 1 do j = 1, ljmax do i = 1, limax xn_adv(iem,i,j,k) = xn_adv(iem,i,j,k) + misc_bc(ibc,k)! - enddo - enddo - enddo - enddo!n - enddo!ibc - endif + end do + end do + end do + end do!n + end do!ibc + end if if (DEBUG%BCS.and.debug_proc.and.i_test>0) then @@ -632,8 +629,8 @@ subroutine BoundaryConditions(year,month) do k = 1, KMAX_MID print "(a20,i4,f8.2)","DEBUG O3 Debug-site ", k, & xn_adv(IXADV_O3,i_test,j_test,k)/PPB - enddo - endif ! DEBUG + end do + end if ! DEBUG if (DEBUG%BCS.and.debug_proc) then itest = 1 @@ -652,11 +649,11 @@ subroutine BoundaryConditions(year,month) if (NSPEC_BGN>0) then do k = KMAX_MID, 1, -1 print "(a23,i3,e14.4)","BCs NO :",k,xn_bgn(itest,i_test,j_test,k)/PPB - enddo + end do else print "(a)","No SET BACKGROUND BCs" - endif - endif ! DEBUG + end if + end if ! DEBUG if (first_call) first_call = .false. @@ -705,7 +702,7 @@ subroutine My_bcmap(iyr_trend) else top_misc_bc(IBC_CH4) = 1780.0 * exp(-0.01*0.91*(1990-iyr_trend)) ! Zander,1975-1990 !exp(-0.01*0.6633*(1975-iyr_trend)) ! Zander,1951-1975 - endif + end if ! Reset with namelist values if set @@ -738,8 +735,8 @@ subroutine My_bcmap(iyr_trend) misc_bc(ii,k) = top_misc_bc(ii)*(1.0-decrease_factor(ii)*B_mid(k)) if (MasterProc.and.DEBUG_MYBC) print "(a20,2es12.4,i4)",& "height,misc_vert,k",B_mid(k),misc_bc(ii,k),k - enddo - enddo + end do + end do bc2xn_adv(IBC_H2, IXADV_H2) = 1.0 bc2xn_adv(IBC_CH4, IXADV_CH4) = 1.0 @@ -750,13 +747,13 @@ subroutine My_bcmap(iyr_trend) do i = NGLOB_BC+1 , NTOT_BC print *, "In My_bcmap, sum-adv", i, " is", sum(bc2xn_adv(i,:)) print *, "In My_bcmap, sum-bgn", i, " is", sum(bc2xn_bgn(i,:)) - enddo - endif ! DEBUG + end do + end if ! DEBUG do i = NGLOB_BC+1 , NTOT_BC call CheckStop(sum(bc2xn_adv(i,:))+sum(bc2xn_bgn(i,:))/=1.0,& "BCproblem - My_bcmap") - enddo + end do !/- mappings for species from Logan + obs model given with IBC index. include 'CM_BoundaryConditions.inc' @@ -788,10 +785,10 @@ subroutine Set_bcmap() any(bc2xn_bgn(ibc,:)>0)) bc_used(ibc) = 1 do iem = 1, NSPEC_ADV if(bc2xn_adv(ibc,iem)>0) bc_used_adv(ibc) = bc_used_adv(ibc)+1 - enddo + end do do iem = 1, NSPEC_BGN if(bc2xn_bgn(ibc,iem)>0) bc_used_bgn(ibc) = bc_used_bgn(ibc)+1 - enddo + end do end do ! ibc num_used_adv = maxval(bc_used_adv) num_used_bgn = maxval(bc_used_bgn) @@ -806,15 +803,15 @@ subroutine Set_bcmap() if (any(bc2xn_adv(:,iem)>0)) then xn_adv_changed(iem) = .true. num_adv_changed = num_adv_changed + 1 - endif - enddo ! iem + end if + end do ! iem do iem = 1, NSPEC_BGN if (any(bc2xn_bgn(:,iem)>0)) then xn_bgn_changed(iem) = .true. num_bgn_changed = num_bgn_changed + 1 - endif - enddo ! iem + end if + end do ! iem if (DEBUG%BCS) write(*,*) "TEST SET_BCMAP bc_used: ",& (bc_used(ibc),ibc=1, NTOT_BC) @@ -829,8 +826,8 @@ subroutine Set_bcmap() i = i+1 spc_changed2adv(i) = iem spc_adv2changed(iem) = i - endif - enddo + end if + end do i = 0 spc_bgn2changed = 0 do iem = 1, NSPEC_BGN @@ -838,8 +835,8 @@ subroutine Set_bcmap() i = i+1 spc_changed2bgn(i) = iem spc_bgn2changed(iem) = i - endif - enddo + end if + end do allocate(spc_used_adv(NTOT_BC,num_used_adv)) allocate(spc_used_bgn(NTOT_BC,num_used_bgn)) @@ -853,8 +850,8 @@ subroutine Set_bcmap() if (bc2xn_adv(ibc,iem)>0.0) then i = i+1 spc_used_adv(ibc,i) = iem - endif - enddo + end if + end do ! - set bc_bgn: background (prescribed) species i = 0 @@ -862,9 +859,9 @@ subroutine Set_bcmap() if ( bc2xn_bgn(ibc,iem) > 0.0 ) then i = i+1 spc_used_bgn(ibc,i) = iem - endif - enddo - endif ! bc_used + end if + end do + end if ! bc_used end do ! ibc end subroutine Set_bcmap @@ -888,7 +885,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) integer :: year real:: so2,nox,nh4 end type SIAfac -integer,parameter ::KMAX20=20 + !temporary used by BoundaryConditions real :: O3fix=0.0 real :: trend_o3=1.0, trend_co, trend_voc @@ -914,7 +911,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) !--------------------------------------------------------------------------- ! Mace Head ozone concentrations for backgroudn sectors ! from Fig 5., Derwent et al., 1998, AE Vol. 32, No. 2, pp 145-157 - integer, parameter :: MH_YEAR1 = 1990, MH_YEAR2 = 2014 + integer, parameter :: MH_YEAR1 = 1990, MH_YEAR2 = 2015 real, dimension(12,MH_YEAR1:MH_YEAR2), parameter :: macehead_year=reshape(& [35.3,36.3,38.4,43.0,41.2,33.4,35.1,27.8,33.7,36.2,28.4,37.7,& !1990 36.1,38.7,37.7,45.8,38.8,36.3,29.6,33.1,33.4,35.7,37.3,36.7,& !1991 @@ -952,26 +949,25 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) 36.5,42.4,43.3,44.5,40.2,34.6,30.1,30.8,32.0,34.7,37.7,38.1,& !2011 35.0,40.2,41.0,46.8,43.1,34.0,29.6,33.8,34.9,33.3,37.9,38.7,& !2012 38.8,42.8,45.1,46.7,43.3,31.8,31.0,33.3,32.8,39.0,39.5,42.7,& !2013 - 41.4,42.9,43.5,46.4,42.4,35.1,28.6,32.6,33.8,37.1,38.1,41.1]& !2014 + 41.4,42.9,43.5,46.4,42.4,35.1,28.6,32.6,33.8,37.1,38.1,41.1,& !2014 + 41.0,43.3,43.8,42.5,39.4,33.6,31.5,35.3,35.8,42.1,40.4,41.0]& !2015 ,[12,MH_YEAR2-MH_YEAR1+1]) real, dimension(12), parameter :: macehead_default=& ! Defaults from 1998-2010 average (/39.8,41.9,45.4,46.5,43.2,36.2,30.5,30.1,34.1,37.0,39.0,38.5/) real, dimension(12):: macehead_O3=macehead_default !--------------------------------------------------------------------------- - integer :: i, j, k, i0, i1, j1, icount, Nlevel_logan, Nlevel_Dust, ierror + integer :: i, j, k, i0, i1, Nlevel_logan, Nlevel_Dust, ierror real :: f0, f1 ! interpolation factors character(len=30) :: fname ! input filename character(len=99) :: txtmsg ! error messages - character(len=30) :: BCpoll ! pollutant name real,allocatable,save, dimension(:) :: p_kPa, h_km !Use of standard atmosphere - real :: scale_old, scale_new,iMH,jMH - logical :: notfound !set true if NetCDF BIC are not found + real :: scale_old, scale_new real, parameter :: macehead_lat = 53.3 !latitude of Macehead station real, parameter :: macehead_lon = -9.9 !longitude of Macehead station character(len = 100) ::fileName,varname - real count,count_loc,O3fix_loc, mpi_rcv(2),mpi_snd(2) + real :: count_loc,O3fix_loc, mpi_rcv(2),mpi_snd(2) real :: conv_fac !---------------------------------------------------------- @@ -1075,7 +1071,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) trend_co = 1.0 trend_voc= 1.0 case(1990:1999) - if( USES%MACEHEADFIX ) then + if( USES%MACEHEADFIX ) then trend_o3 = 1.0 else trend_o3 = exp(-0.01*1.0 *(2000-iyr_trend)) @@ -1086,12 +1082,12 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) trend_o3 = exp(-0.01*1.0 *(2000-iyr_trend)) trend_co = exp(-0.01*0.85*(1990-iyr_trend)) ! Zander:CO trend_voc= exp(-0.01*0.85*(1990-iyr_trend)) ! Zander,1975-1990 - endselect + end select if (MasterProc.and.first_call) then write(unit=txtmsg,fmt="(a,i5,3f8.3,13f9.4)") "BC:trends O3,CO,VOC,SOx,NOx,NH3: ", & iyr_trend, trend_o3, trend_co, trend_voc, SIAtrend%so2, SIAtrend%nox, SIAtrend%nh4 call PrintLog(txtmsg) - endif + end if !=========== BCs Generated from Mace Head Data ==================== ! @@ -1105,10 +1101,10 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) else macehead_O3=macehead_default write(unit=txtmsg,fmt="(a)") "BC: O3 default Mace Head correction" - endif + end if if (MasterProc.and.first_call) then call PrintLog(txtmsg) - endif + end if !=========== Generated from Mace Head Data ======================= errcode = 0 @@ -1186,8 +1182,8 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) if( SpecBC(i)%hmin*SpecBC(i)%conv_fac < 1.0e-17) then write(unit=txtmsg,fmt="(A,I0)") "PECBC: Error: No SpecBC set for species ", i call CheckStop(txtmsg) - endif - enddo + end if + end do ! Latitude functions taken from Lagrangian model, see Simpson (1992) latfunc(:,6:14) = 1.0 ! default @@ -1213,7 +1209,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) h_km = StandardAtmos_kPa_2_km(p_kPa) first_call = .false. - endif ! first_call + end if ! first_call ! ========= end of first call =================================== !+ ! Specifies concentrations for a fake set of Logan data. @@ -1239,9 +1235,9 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) ! bc_data(i_fdom(i)-IRUNBEG+1,j_fdom(j)-JRUNBEG+1,k)=O3_logan_emep(i,j,k) bc_data(i,j,k)=O3_logan_emep(i,j,k) - enddo - enddo - enddo + end do + end do + end do ! Mace Head adjustment: get mean ozone from Eastern sector O3fix_loc=0.0 count_loc=0 @@ -1254,9 +1250,9 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) glon(i,j)>macehead_lon-40.0)then O3fix_loc=O3fix_loc+bc_data(i,j,KMAX_MID) count_loc=count_loc+1 - endif - enddo - enddo + end if + end do + end do mpi_snd(1)=O3fix_loc mpi_snd(2)=count_loc call MPI_ALLREDUCE(mpi_snd, mpi_rcv, 2, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) @@ -1265,7 +1261,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) if (me==0)write(*,"(a,4f8.3)")'Mace Head correction for O3, trend and Mace Head value',& -O3fix/PPB,trend_o3,macehead_O3(month) bc_data = max(15.0*PPB,bc_data-O3fix) - endif + end if case ( IBC_H2O2 ) bc_data=1.0E-25 @@ -1290,14 +1286,14 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) write(*,"(a8,2i3,2f8.3,i4,f8.2,f8.3,2f8.3)") & "SCALE-HZ ", month, ibc, SpecBC(ibc)%surf, SpecBC(ibc)%hz, k,& h_km(k), p_kPa(k), scale_old, scale_new - endif ! DEBUG_HZ - enddo + end if ! DEBUG_HZ + end do else do k = 1, KMAX_MID-1 bc_data(:,:,k) = bc_data(:,:,KMAX_MID) - enddo - endif + end do + end if !/ - min value after vertical factors, before latitude factor bc_data = max( bc_data, SpecBC(ibc)%vmin ) @@ -1327,7 +1323,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) if(me==0)write(*,*)'fine DUST BIC read from climatological file' else call CheckStop('IBC dust case error') - endif + end if call ReadField_CDF(fileName,varname,Dust_3D,nstart=month,kstart=1,kend=Nlevel_Dust,& interpol='zero_order', needed=.true.,debug_flag=.false.) @@ -1340,12 +1336,12 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) do j = 1, ljmax do i = 1, limax bc_data(i,j,k)=Dust_3D_emep(i,j,k)*conv_fac/roa(i,j,k,1) - enddo - enddo - enddo + end do + end do + end do else bc_data=0.0 - endif + end if case default print *,"Error with specified BCs:", ibc @@ -1360,8 +1356,8 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) " MIN ", minval ( bc_data ) do k = KMAX_MID, 1, -1 ! print out a random column print "(i4,f12.3)", k, bc_data(5,5,k) - enddo - endif ! DEBUG + end do + end if ! DEBUG !/ - min value after latitude factors , but before trends diff --git a/CITATION.txt b/CITATION.txt new file mode 100644 index 0000000..06d71f0 --- /dev/null +++ b/CITATION.txt @@ -0,0 +1,63 @@ +To Reference the EMEP MSC-W model, the usual reference for 2017 code would be +Simpson et al., (2012, 2017, and refs therein). + +(The main documentation paper of the EMEP MSC-W model is Simpson et al., +2012. Many updates have been made since then, recorded in the annual +EMEP status reports, from 2013-2017, which are listed below and +are available at www.emep.int.) + + Simpson, D., Benedictow, A., Berge, H., Bergström, R., Emberson, + L. D., Fagerli, H., Flechard, C. R., Hayman, G. D., Gauss, M., + Jonson, J. E., Jenkin, M. E., Nyiri, A., Richter, C., Semeena, V. S., + Tsyro, S., Tuovinen, J.-P., Valdebenito, Á. & Wind, P. The EMEP MSC-W + chemical transport model -- technical description Atmos. Chem. Physics, + 2012, 12, 7825-7865 + + Simpson, D.; Bergström, R.; Imhof, H. & Wind, P. Updates to the + EMEP/MSC-W model, 2016--2017 Transboundary particulate matter, + photo-oxidants, acidifying and eutrophying components. Status + Report 1/2017, The Norwegian Meteorological Institute, Oslo, Norway, + www.emep.int, 2017, 115-122 + + +The performance of the model is also assessed annually in the EMEP reports, e.g. + + + Gauss, M.; Tsyro, S.; Benedictow, A.; Fagerli, H.; Hjellbrekke, A.-G.; + Aas, W. & Solberg, S. EMEP MSC-W model performance for acidifying and + eutrophying components, photo-oxidants and particulate matter in 2015, + Supplementary material to EMEP Status Report 1/2017, + The Norwegian Meteorological Institute, Oslo, Norway, The Norwegian + Meteorological Institute, Oslo, Norway, 2017, 116pp + +(and similar for 2016, 2015, etc.) + +------------------------------------------------------------ +A extensive list of EMEP reports and papers can be found at: + + http://emep.int/emep_publications.html + + +Earlier model update chapters can be found here: + +Simpson, D.; Bergström, R.; Imhof, H. & Wind, P. Updates to the + EMEP/MSC-W model, 2016--2017 Transboundary particulate matter, + photo-oxidants, acidifying and eutrophying components. Status + Report 1/2017, The Norwegian Meteorological Institute, Oslo, Norway, + www.emep.int, 2017, 115-122 + +Simpson, D.; Tsyro, S. & Wind, P. Updates to the EMEP/MSC-W model + Transboundary particulate matter, photo-oxidants, acidifying and + eutrophying components. Status Report 1/2015, The Norwegian Meteorological + Institute, Oslo, Norway, 2015, 129-138 + +Tsyro, S.; Karl, M.; Simpson, D.; Valdebenito, A. & Wind, P. Updates to + the EMEP/MSC-W model Transboundary particulate matter, photo-oxidants, + acidifying and eutrophying components. Status Report 1/2014, The Norwegian + Meteorological Institute, Oslo, Norway, 2014, 143-146 + +Simpson, D.; Schulz, M.; Shamsudheen, V.; Tsyro, S.; Valdebenito, A.; + Wind, P. & Steensen, B. M. EMEP model development and performance changes + Transboundary acidification, eutrophication and ground level ozone in + Europe in 2011. EMEP Status Report 1/2013, The Norwegian Meteorological + Institute, Oslo, Norway, 2013, 45-59 diff --git a/CM_BoundaryConditions.inc b/CM_BoundaryConditions.inc index 5ada991..526b7dd 100644 --- a/CM_BoundaryConditions.inc +++ b/CM_BoundaryConditions.inc @@ -121,3 +121,4 @@ bc2xn_adv(IBC_DUST_f ,IXADV_DUST_SAH_F ) = 1.0 !Dust bc2xn_adv(IBC_DUST_c ,IXADV_DUST_SAH_C ) = 1.0 !Dust + diff --git a/CM_ChemGroups_ml.f90 b/CM_ChemGroups_ml.f90 index c0d897e..03e8aa8 100644 --- a/CM_ChemGroups_ml.f90 +++ b/CM_ChemGroups_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,8 +39,8 @@ module ChemGroups_ml integer, public, target, save, dimension(2) :: & DDEP_SS_GROUP = (/ SEASALT_F,SEASALT_C /) -integer, public, target, save, dimension(4) :: & - WDEP_OXN_GROUP = (/ HNO3,HONO,NO3_F,NO3_C /) +integer, public, target, save, dimension(5) :: & + WDEP_OXN_GROUP = (/ HO2NO2,HNO3,HONO,NO3_F,NO3_C /) integer, public, target, save, dimension(11) :: & WDEP_PPM10_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,REMPPM25,REMPPM_C /) @@ -48,8 +48,8 @@ module ChemGroups_ml integer, public, target, save, dimension(6) :: & DUST_GROUP = (/ DUST_ROAD_F,DUST_ROAD_C,DUST_WB_F,DUST_WB_C,DUST_SAH_F,DUST_SAH_C /) -integer, public, target, save, dimension(10) :: & - WDEP_BSOA_GROUP = (/ BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) +integer, public, target, save, dimension(11) :: & + WDEP_BSOA_GROUP = (/ SQT_SOA_NV,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) integer, public, target, save, dimension(2) :: & DDEP_NOX_GROUP = (/ NO2,SHIPNOX /) @@ -57,8 +57,8 @@ module ChemGroups_ml integer, public, target, save, dimension(4) :: & PPM_C_GROUP = (/ POM_C_FFUEL,EC_C_WOOD,EC_C_FFUEL,REMPPM_C /) -integer, public, target, save, dimension(27) :: & - OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,OM25_BGND,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) +integer, public, target, save, dimension(28) :: & + OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,OM25_BGND,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) integer, public, target, save, dimension(2) :: & DDEP_DUST_NAT_C_GROUP = (/ DUST_WB_C,DUST_SAH_C /) @@ -72,17 +72,20 @@ module ChemGroups_ml integer, public, target, save, dimension(15) :: & DDEP_PMFINE_GROUP = (/ SO4,NO3_F,NH4_F,ASH_F,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,REMPPM25,FFIRE_BC,FFIRE_REMPPM25,SEASALT_F,DUST_ROAD_F,DUST_WB_F,DUST_SAH_F /) -integer, public, target, save, dimension(57) :: & - NMVOC_GROUP = (/ PAN,MPAN,CH3COO2,MACR,GLYOX,MGLYOX,MAL,MEK,MVK,HCHO,CH3CHO,C2H6,NC4H10,C2H4,C3H6,OXYL,C5H8,APINENE,CH3O2H,C2H5OOH,BURO2H,ETRO2H,PRRO2H,MEKO2H,MALO2H,MACROOH,MACO3H,MACO2H,CH3COO2H,CH3OH,C2H5OH,ACETOL,POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,OM25_BGND,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) +integer, public, target, save, dimension(68) :: & + NMVOC_GROUP = (/ PAN,CH3COO2,GLYOX,MGLYOX,MAL,MEK,HCHO,CH3CHO,C2H6,NC4H10,C2H4,C3H6,OXYL,C5H8,APINENE,BPINENE,XTERP,BIOTERP,CH3O2H,C2H5OOH,BURO2H,ETRO2H,PRRO2H,MEKO2H,MALO2H,CH3COO2H,CH3OH,C2H5OH,ACETOL,ISO2,MACRO2,MACR,MACROOH,HACET,ISOOH,ISON,HCOOH,MPAN,NALD,HPALD,PACALD,MVK,POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,OM25_BGND,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) integer, public, target, save, dimension(7) :: & WDEP_PPM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,REMPPM25 /) +integer, public, target, save, dimension(3) :: & + DDEP_RCHO_GROUP = (/ NALD,HPALD,PACALD /) + integer, public, target, save, dimension(25) :: & WDEP_PM10_GROUP = (/ SO4,NO3_F,NO3_C,NH4_F,ASH_F,ASH_C,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,REMPPM25,REMPPM_C,FFIRE_BC,FFIRE_REMPPM25,SEASALT_F,SEASALT_C,DUST_ROAD_F,DUST_ROAD_C,DUST_WB_F,DUST_WB_C,DUST_SAH_F,DUST_SAH_C /) -integer, public, target, save, dimension(3) :: & - DDEP_OX_GROUP = (/ O3,NO2,SHIPNOX /) +integer, public, target, save, dimension(2) :: & + DDEP_OX_GROUP = (/ O3,NO2 /) integer, public, target, save, dimension(2) :: & DDEP_ECCOARSE_GROUP = (/ EC_C_WOOD,EC_C_FFUEL /) @@ -90,6 +93,9 @@ module ChemGroups_ml integer, public, target, save, dimension(1) :: & NVWOODOC25_GROUP = (/ POM_F_WOOD /) +integer, public, target, save, dimension(1) :: & + WDEP_TMPOX_GROUP = (/ HO2NO2 /) + integer, public, target, save, dimension(2) :: & ASH_GROUP = (/ ASH_F,ASH_C /) @@ -99,8 +105,8 @@ module ChemGroups_ml integer, public, target, save, dimension(26) :: & PM10_GROUP = (/ SO4,NO3_F,NO3_C,NH4_F,ASH_F,ASH_C,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,REMPPM25,REMPPM_C,FFIRE_BC,FFIRE_REMPPM25,OM25_P,SEASALT_F,SEASALT_C,DUST_ROAD_F,DUST_ROAD_C,DUST_WB_F,DUST_WB_C,DUST_SAH_F,DUST_SAH_C /) -integer, public, target, save, dimension(23) :: & - DDEP_OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) +integer, public, target, save, dimension(24) :: & + DDEP_OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) integer, public, target, save, dimension(1) :: & WDEP_PWOODOA25_GROUP = (/ WOODOA_NG10 /) @@ -108,11 +114,14 @@ module ChemGroups_ml integer, public, target, save, dimension(10) :: & DDEP_ASOA_GROUP = (/ ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3 /) -integer, public, target, save, dimension(3) :: & - OX_GROUP = (/ O3,NO2,SHIPNOX /) +integer, public, target, save, dimension(4) :: & + TMPOX_GROUP = (/ O3,NO2,HO2NO2,SHIPNOX /) + +integer, public, target, save, dimension(2) :: & + OX_GROUP = (/ O3,NO2 /) -integer, public, target, save, dimension(8) :: & - DDEP_OXN_GROUP = (/ NO2,SHIPNOX,PAN,MPAN,HNO3,HONO,NO3_F,NO3_C /) +integer, public, target, save, dimension(9) :: & + DDEP_OXN_GROUP = (/ NO2,HO2NO2,SHIPNOX,PAN,HNO3,HONO,MPAN,NO3_F,NO3_C /) integer, public, target, save, dimension(1) :: & WDEP_PFFUELOA25_GROUP = (/ FFFUEL_NG10 /) @@ -136,7 +145,7 @@ module ChemGroups_ml WDEP_SIA_GROUP = (/ SO4,NO3_F,NO3_C,NH4_F /) integer, public, target, save, dimension(2) :: & - BVOC_GROUP = (/ C5H8,APINENE /) + BVOC_GROUP = (/ C5H8,BIOTERP /) integer, public, target, save, dimension(1) :: & PWOODOA25_GROUP = (/ WOODOA_NG10 /) @@ -144,8 +153,11 @@ module ChemGroups_ml integer, public, target, save, dimension(5) :: & EC_F_GROUP = (/ EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_BC /) -integer, public, target, save, dimension(11) :: & - DDEP_NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC /) +integer, public, target, save, dimension(12) :: & + DDEP_NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,SQT_SOA_NV /) + +integer, public, target, save, dimension(3) :: & + RCHO_GROUP = (/ NALD,HPALD,PACALD /) integer, public, target, save, dimension(1) :: & WDEP_NVFFIREOC25_GROUP = (/ FFIRE_OM /) @@ -159,17 +171,20 @@ module ChemGroups_ml integer, public, target, save, dimension(16) :: & PMFINE_GROUP = (/ SO4,NO3_F,NH4_F,ASH_F,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,REMPPM25,FFIRE_BC,FFIRE_REMPPM25,OM25_P,SEASALT_F,DUST_ROAD_F,DUST_WB_F,DUST_SAH_F /) -integer, public, target, save, dimension(3) :: & - DDEP_NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM /) +integer, public, target, save, dimension(4) :: & + DDEP_NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,SQT_SOA_NV /) integer, public, target, save, dimension(1) :: & WDEP_SVFFIREOA25_GROUP = (/ FFIREOA_NG10 /) -integer, public, target, save, dimension(12) :: & - NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,OM25_BGND /) +integer, public, target, save, dimension(13) :: & + NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,OM25_BGND,SQT_SOA_NV /) -integer, public, target, save, dimension(1) :: & - WDEP_DAOBS_GROUP = (/ SO2 /) +integer, public, target, save, dimension(2) :: & + WDEP_DAOBS_GROUP = (/ HO2NO2,SO2 /) + +integer, public, target, save, dimension(4) :: & + DDEP_TMPOX_GROUP = (/ O3,NO2,HO2NO2,SHIPNOX /) integer, public, target, save, dimension(2) :: & WDEP_DUST_NAT_C_GROUP = (/ DUST_WB_C,DUST_SAH_C /) @@ -204,8 +219,8 @@ module ChemGroups_ml integer, public, target, save, dimension(2) :: & WDEP_ECCOARSE_GROUP = (/ EC_C_WOOD,EC_C_FFUEL /) -integer, public, target, save, dimension(14) :: & - OXN_GROUP = (/ NO,NO2,SHIPNOX,PAN,MPAN,NO3,N2O5,ISONO3,HNO3,HONO,ISNI,ISNIR,NO3_F,NO3_C /) +integer, public, target, save, dimension(12) :: & + OXN_GROUP = (/ NO,NO2,HO2NO2,SHIPNOX,PAN,NO3,N2O5,HNO3,HONO,MPAN,NO3_F,NO3_C /) integer, public, target, save, dimension(1) :: & WDEP_DUST_ANT_F_GROUP = (/ DUST_ROAD_F /) @@ -228,11 +243,11 @@ module ChemGroups_ml integer, public, target, save, dimension(10) :: & DDEP_PMCO_GROUP = (/ NO3_C,ASH_C,POM_C_FFUEL,EC_C_WOOD,EC_C_FFUEL,REMPPM_C,SEASALT_C,DUST_ROAD_C,DUST_WB_C,DUST_SAH_C /) -integer, public, target, save, dimension(10) :: & - DDEP_BSOA_GROUP = (/ BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) +integer, public, target, save, dimension(11) :: & + DDEP_BSOA_GROUP = (/ SQT_SOA_NV,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) -integer, public, target, save, dimension(28) :: & - DDEP_PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) +integer, public, target, save, dimension(29) :: & + DDEP_PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) integer, public, target, save, dimension(1) :: & DDEP_NVFFUELOC_COARSE_GROUP = (/ POM_C_FFUEL /) @@ -288,14 +303,14 @@ module ChemGroups_ml integer, public, target, save, dimension(6) :: & DDEP_DUST_GROUP = (/ DUST_ROAD_F,DUST_ROAD_C,DUST_WB_F,DUST_WB_C,DUST_SAH_F,DUST_SAH_C /) -integer, public, target, save, dimension(14) :: & - RO2_GROUP = (/ HO2,CH3O2,C2H5O2,SECC4H9O2,ISRO2,ETRO2,PRRO2,OXYO2,MEKO2,MALO2,MVKO2,MACRO2,MACO3,TERPPEROXY /) +integer, public, target, save, dimension(15) :: & + RO2_GROUP = (/ HO2,CH3O2,C2H5O2,SECC4H9O2,ISRO2,ETRO2,PRRO2,OXYO2,MEKO2,MALO2,MVKO2,TERPO2,XMTO3_RO2,ISO2,MACRO2 /) integer, public, target, save, dimension(5) :: & DDEP_EC_F_GROUP = (/ EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_BC /) -integer, public, target, save, dimension(16) :: & - ROOH_GROUP = (/ CH3O2H,C2H5OOH,BURO2H,ETRO2H,PRRO2H,OXYO2H,MEKO2H,MALO2H,MVKO2H,MACROOH,MACO3H,ISRO2H,H2O2,CH3COO2H,ISONO3H,ISNIRH /) +integer, public, target, save, dimension(14) :: & + ROOH_GROUP = (/ CH3O2H,C2H5OOH,BURO2H,ETRO2H,PRRO2H,OXYO2H,MEKO2H,MALO2H,H2O2,CH3COO2H,MACROOH,ISOOH,HCOOH,TERPOOH /) integer, public, target, save, dimension(1) :: & DUST_ANT_C_GROUP = (/ DUST_ROAD_C /) @@ -306,8 +321,8 @@ module ChemGroups_ml integer, public, target, save, dimension(4) :: & DDEP_PPM_C_GROUP = (/ POM_C_FFUEL,EC_C_WOOD,EC_C_FFUEL,REMPPM_C /) -integer, public, target, save, dimension(3) :: & - WDEP_NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM /) +integer, public, target, save, dimension(4) :: & + WDEP_NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,SQT_SOA_NV /) integer, public, target, save, dimension(1) :: & SVFFUELOA25_GROUP = (/ FFFUEL_NG10 /) @@ -345,8 +360,8 @@ module ChemGroups_ml integer, public, target, save, dimension(3) :: & WDEP_WOODEC_GROUP = (/ EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD /) -integer, public, target, save, dimension(31) :: & - WDEP_PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) +integer, public, target, save, dimension(32) :: & + WDEP_PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) integer, public, target, save, dimension(2) :: & WDEP_SS_GROUP = (/ SEASALT_F,SEASALT_C /) @@ -354,8 +369,11 @@ module ChemGroups_ml integer, public, target, save, dimension(2) :: & DUST_NAT_C_GROUP = (/ DUST_WB_C,DUST_SAH_C /) -integer, public, target, save, dimension(11) :: & - WDEP_NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC /) +integer, public, target, save, dimension(3) :: & + MONOTERP_GROUP = (/ APINENE,BPINENE,XTERP /) + +integer, public, target, save, dimension(12) :: & + WDEP_NONVOLPCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,FFIRE_OM,FFIRE_BC,SQT_SOA_NV /) integer, public, target, save, dimension(7) :: & PPM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,REMPPM25 /) @@ -363,14 +381,17 @@ module ChemGroups_ml integer, public, target, save, dimension(10) :: & ASOA_GROUP = (/ ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3 /) -integer, public, target, save, dimension(4) :: & - NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,OM25_BGND /) - integer, public, target, save, dimension(11) :: & PPM10_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,POM_C_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_C_WOOD,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL,REMPPM25,REMPPM_C /) -integer, public, target, save, dimension(10) :: & - BSOA_GROUP = (/ BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) +integer, public, target, save, dimension(5) :: & + NVABSOM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,OM25_BGND,SQT_SOA_NV /) + +integer, public, target, save, dimension(11) :: & + BSOA_GROUP = (/ SQT_SOA_NV,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3 /) + +integer, public, target, save, dimension(2) :: & + CHET2_GROUP = (/ IEPOX,HACET /) integer, public, target, save, dimension(4) :: & ECFINE_GROUP = (/ EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE /) @@ -393,8 +414,8 @@ module ChemGroups_ml integer, public, target, save, dimension(1) :: & WDEP_ROOH_GROUP = (/ H2O2 /) -integer, public, target, save, dimension(31) :: & - PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) +integer, public, target, save, dimension(32) :: & + PCM_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,FFIRE_OM,FFIRE_BC,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) integer, public, target, save, dimension(1) :: & SVWOODOA25_GROUP = (/ WOODOA_NG10 /) @@ -414,8 +435,8 @@ module ChemGroups_ml integer, public, target, save, dimension(1) :: & SVFFIREOA25_GROUP = (/ FFIREOA_NG10 /) -integer, public, target, save, dimension(3) :: & - DDEP_DAOBS_GROUP = (/ O3,NO2,SO2 /) +integer, public, target, save, dimension(4) :: & + DDEP_DAOBS_GROUP = (/ O3,NO2,HO2NO2,SO2 /) integer, public, target, save, dimension(1) :: & NVFFUELOC25_GROUP = (/ POM_F_FFUEL /) @@ -423,8 +444,8 @@ module ChemGroups_ml integer, public, target, save, dimension(1) :: & OMCOARSE_GROUP = (/ POM_C_FFUEL /) -integer, public, target, save, dimension(3) :: & - DDEP_ROOH_GROUP = (/ CH3O2H,C2H5OOH,H2O2 /) +integer, public, target, save, dimension(4) :: & + DDEP_ROOH_GROUP = (/ CH3O2H,C2H5OOH,H2O2,TERPOOH /) integer, public, target, save, dimension(15) :: & WDEP_PMFINE_GROUP = (/ SO4,NO3_F,NH4_F,ASH_F,EC_F_WOOD_NEW,EC_F_WOOD_AGE,EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,REMPPM25,FFIRE_BC,FFIRE_REMPPM25,SEASALT_F,DUST_ROAD_F,DUST_WB_F,DUST_SAH_F /) @@ -441,21 +462,21 @@ module ChemGroups_ml integer, public, target, save, dimension(2) :: & WDEP_ASH_GROUP = (/ ASH_F,ASH_C /) -integer, public, target, save, dimension(3) :: & - DAOBS_GROUP = (/ O3,NO2,SO2 /) +integer, public, target, save, dimension(4) :: & + DAOBS_GROUP = (/ O3,NO2,HO2NO2,SO2 /) integer, public, target, save, dimension(3) :: & WDEP_FFUELEC_GROUP = (/ EC_F_FFUEL_NEW,EC_F_FFUEL_AGE,EC_C_FFUEL /) -integer, public, target, save, dimension(26) :: & - WDEP_OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) +integer, public, target, save, dimension(27) :: & + WDEP_OM25_GROUP = (/ POM_F_WOOD,POM_F_FFUEL,FFIRE_OM,SQT_SOA_NV,ASOC_NG100,ASOC_UG1,ASOC_UG10,ASOC_UG1E2,ASOC_UG1E3,NON_C_ASOA_NG100,NON_C_ASOA_UG1,NON_C_ASOA_UG10,NON_C_ASOA_UG1E2,NON_C_ASOA_UG1E3,BSOC_NG100,BSOC_UG1,BSOC_UG10,BSOC_UG1E2,BSOC_UG1E3,NON_C_BSOA_NG100,NON_C_BSOA_UG1,NON_C_BSOA_UG10,NON_C_BSOA_UG1E2,NON_C_BSOA_UG1E3,FFFUEL_NG10,WOODOA_NG10,FFIREOA_NG10 /) ! ------- RO2 Pool species ------------------ integer, public, parameter :: SIZE_RO2_POOL = 1 integer, public, parameter, dimension(1) :: & RO2_POOL = (/ -99 /) -type(typ_sp), dimension(138), public, save :: chemgroups +type(typ_sp), dimension(145), public, save :: chemgroups !----------------------------------------------------------- @@ -463,418 +484,439 @@ module ChemGroups_ml subroutine Init_ChemGroups() chemgroups(1)%name="DDEP_SS" - chemgroups(1)%ptr=>DDEP_SS_GROUP + chemgroups(1)%specs=>DDEP_SS_GROUP chemgroups(2)%name="WDEP_OXN" - chemgroups(2)%ptr=>WDEP_OXN_GROUP + chemgroups(2)%specs=>WDEP_OXN_GROUP chemgroups(3)%name="WDEP_PPM10" - chemgroups(3)%ptr=>WDEP_PPM10_GROUP + chemgroups(3)%specs=>WDEP_PPM10_GROUP chemgroups(4)%name="DUST" - chemgroups(4)%ptr=>DUST_GROUP + chemgroups(4)%specs=>DUST_GROUP chemgroups(5)%name="WDEP_BSOA" - chemgroups(5)%ptr=>WDEP_BSOA_GROUP + chemgroups(5)%specs=>WDEP_BSOA_GROUP chemgroups(6)%name="DDEP_NOX" - chemgroups(6)%ptr=>DDEP_NOX_GROUP + chemgroups(6)%specs=>DDEP_NOX_GROUP chemgroups(7)%name="PPM_C" - chemgroups(7)%ptr=>PPM_C_GROUP + chemgroups(7)%specs=>PPM_C_GROUP chemgroups(8)%name="OM25" - chemgroups(8)%ptr=>OM25_GROUP + chemgroups(8)%specs=>OM25_GROUP chemgroups(9)%name="DDEP_DUST_NAT_C" - chemgroups(9)%ptr=>DDEP_DUST_NAT_C_GROUP + chemgroups(9)%specs=>DDEP_DUST_NAT_C_GROUP chemgroups(10)%name="PPM25_FIRE" - chemgroups(10)%ptr=>PPM25_FIRE_GROUP + chemgroups(10)%specs=>PPM25_FIRE_GROUP chemgroups(11)%name="WDEP_SVWOODOA25" - chemgroups(11)%ptr=>WDEP_SVWOODOA25_GROUP + chemgroups(11)%specs=>WDEP_SVWOODOA25_GROUP chemgroups(12)%name="DDEP_PMFINE" - chemgroups(12)%ptr=>DDEP_PMFINE_GROUP + chemgroups(12)%specs=>DDEP_PMFINE_GROUP chemgroups(13)%name="NMVOC" - chemgroups(13)%ptr=>NMVOC_GROUP + chemgroups(13)%specs=>NMVOC_GROUP chemgroups(14)%name="WDEP_PPM25" - chemgroups(14)%ptr=>WDEP_PPM25_GROUP + chemgroups(14)%specs=>WDEP_PPM25_GROUP + + chemgroups(15)%name="DDEP_RCHO" + chemgroups(15)%specs=>DDEP_RCHO_GROUP + + chemgroups(16)%name="WDEP_PM10" + chemgroups(16)%specs=>WDEP_PM10_GROUP + + chemgroups(17)%name="DDEP_OX" + chemgroups(17)%specs=>DDEP_OX_GROUP + + chemgroups(18)%name="DDEP_ECCOARSE" + chemgroups(18)%specs=>DDEP_ECCOARSE_GROUP + + chemgroups(19)%name="NVWOODOC25" + chemgroups(19)%specs=>NVWOODOC25_GROUP + + chemgroups(20)%name="WDEP_TMPOX" + chemgroups(20)%specs=>WDEP_TMPOX_GROUP + + chemgroups(21)%name="ASH" + chemgroups(21)%specs=>ASH_GROUP - chemgroups(15)%name="WDEP_PM10" - chemgroups(15)%ptr=>WDEP_PM10_GROUP + chemgroups(22)%name="WDEP_NVFFUELOC_COARSE" + chemgroups(22)%specs=>WDEP_NVFFUELOC_COARSE_GROUP - chemgroups(16)%name="DDEP_OX" - chemgroups(16)%ptr=>DDEP_OX_GROUP + chemgroups(23)%name="PM10" + chemgroups(23)%specs=>PM10_GROUP - chemgroups(17)%name="DDEP_ECCOARSE" - chemgroups(17)%ptr=>DDEP_ECCOARSE_GROUP + chemgroups(24)%name="DDEP_OM25" + chemgroups(24)%specs=>DDEP_OM25_GROUP - chemgroups(18)%name="NVWOODOC25" - chemgroups(18)%ptr=>NVWOODOC25_GROUP + chemgroups(25)%name="WDEP_PWOODOA25" + chemgroups(25)%specs=>WDEP_PWOODOA25_GROUP - chemgroups(19)%name="ASH" - chemgroups(19)%ptr=>ASH_GROUP + chemgroups(26)%name="DDEP_ASOA" + chemgroups(26)%specs=>DDEP_ASOA_GROUP - chemgroups(20)%name="WDEP_NVFFUELOC_COARSE" - chemgroups(20)%ptr=>WDEP_NVFFUELOC_COARSE_GROUP + chemgroups(27)%name="TMPOX" + chemgroups(27)%specs=>TMPOX_GROUP - chemgroups(21)%name="PM10" - chemgroups(21)%ptr=>PM10_GROUP + chemgroups(28)%name="OX" + chemgroups(28)%specs=>OX_GROUP - chemgroups(22)%name="DDEP_OM25" - chemgroups(22)%ptr=>DDEP_OM25_GROUP + chemgroups(29)%name="DDEP_OXN" + chemgroups(29)%specs=>DDEP_OXN_GROUP - chemgroups(23)%name="WDEP_PWOODOA25" - chemgroups(23)%ptr=>WDEP_PWOODOA25_GROUP + chemgroups(30)%name="WDEP_PFFUELOA25" + chemgroups(30)%specs=>WDEP_PFFUELOA25_GROUP - chemgroups(24)%name="DDEP_ASOA" - chemgroups(24)%ptr=>DDEP_ASOA_GROUP + chemgroups(31)%name="DDEP_PPM10" + chemgroups(31)%specs=>DDEP_PPM10_GROUP - chemgroups(25)%name="OX" - chemgroups(25)%ptr=>OX_GROUP + chemgroups(32)%name="WDEP_PPM_C" + chemgroups(32)%specs=>WDEP_PPM_C_GROUP - chemgroups(26)%name="DDEP_OXN" - chemgroups(26)%ptr=>DDEP_OXN_GROUP + chemgroups(33)%name="DDEP_PPM25_FIRE" + chemgroups(33)%specs=>DDEP_PPM25_FIRE_GROUP - chemgroups(27)%name="WDEP_PFFUELOA25" - chemgroups(27)%ptr=>WDEP_PFFUELOA25_GROUP + chemgroups(34)%name="WDEP_EC_F" + chemgroups(34)%specs=>WDEP_EC_F_GROUP - chemgroups(28)%name="DDEP_PPM10" - chemgroups(28)%ptr=>DDEP_PPM10_GROUP + chemgroups(35)%name="DDEP_PM10" + chemgroups(35)%specs=>DDEP_PM10_GROUP - chemgroups(29)%name="WDEP_PPM_C" - chemgroups(29)%ptr=>WDEP_PPM_C_GROUP + chemgroups(36)%name="WDEP_SIA" + chemgroups(36)%specs=>WDEP_SIA_GROUP - chemgroups(30)%name="DDEP_PPM25_FIRE" - chemgroups(30)%ptr=>DDEP_PPM25_FIRE_GROUP + chemgroups(37)%name="BVOC" + chemgroups(37)%specs=>BVOC_GROUP - chemgroups(31)%name="WDEP_EC_F" - chemgroups(31)%ptr=>WDEP_EC_F_GROUP + chemgroups(38)%name="PWOODOA25" + chemgroups(38)%specs=>PWOODOA25_GROUP - chemgroups(32)%name="DDEP_PM10" - chemgroups(32)%ptr=>DDEP_PM10_GROUP + chemgroups(39)%name="EC_F" + chemgroups(39)%specs=>EC_F_GROUP - chemgroups(33)%name="WDEP_SIA" - chemgroups(33)%ptr=>WDEP_SIA_GROUP + chemgroups(40)%name="DDEP_NONVOLPCM" + chemgroups(40)%specs=>DDEP_NONVOLPCM_GROUP - chemgroups(34)%name="BVOC" - chemgroups(34)%ptr=>BVOC_GROUP + chemgroups(41)%name="RCHO" + chemgroups(41)%specs=>RCHO_GROUP - chemgroups(35)%name="PWOODOA25" - chemgroups(35)%ptr=>PWOODOA25_GROUP + chemgroups(42)%name="WDEP_NVFFIREOC25" + chemgroups(42)%specs=>WDEP_NVFFIREOC25_GROUP - chemgroups(36)%name="EC_F" - chemgroups(36)%ptr=>EC_F_GROUP + chemgroups(43)%name="SOX" + chemgroups(43)%specs=>SOX_GROUP - chemgroups(37)%name="DDEP_NONVOLPCM" - chemgroups(37)%ptr=>DDEP_NONVOLPCM_GROUP + chemgroups(44)%name="DUST_ANT_F" + chemgroups(44)%specs=>DUST_ANT_F_GROUP - chemgroups(38)%name="WDEP_NVFFIREOC25" - chemgroups(38)%ptr=>WDEP_NVFFIREOC25_GROUP + chemgroups(45)%name="PMFINE" + chemgroups(45)%specs=>PMFINE_GROUP - chemgroups(39)%name="SOX" - chemgroups(39)%ptr=>SOX_GROUP + chemgroups(46)%name="DDEP_NVABSOM" + chemgroups(46)%specs=>DDEP_NVABSOM_GROUP - chemgroups(40)%name="DUST_ANT_F" - chemgroups(40)%ptr=>DUST_ANT_F_GROUP + chemgroups(47)%name="WDEP_SVFFIREOA25" + chemgroups(47)%specs=>WDEP_SVFFIREOA25_GROUP - chemgroups(41)%name="PMFINE" - chemgroups(41)%ptr=>PMFINE_GROUP + chemgroups(48)%name="NONVOLPCM" + chemgroups(48)%specs=>NONVOLPCM_GROUP - chemgroups(42)%name="DDEP_NVABSOM" - chemgroups(42)%ptr=>DDEP_NVABSOM_GROUP + chemgroups(49)%name="WDEP_DAOBS" + chemgroups(49)%specs=>WDEP_DAOBS_GROUP - chemgroups(43)%name="WDEP_SVFFIREOA25" - chemgroups(43)%ptr=>WDEP_SVFFIREOA25_GROUP + chemgroups(50)%name="DDEP_TMPOX" + chemgroups(50)%specs=>DDEP_TMPOX_GROUP - chemgroups(44)%name="NONVOLPCM" - chemgroups(44)%ptr=>NONVOLPCM_GROUP + chemgroups(51)%name="WDEP_DUST_NAT_C" + chemgroups(51)%specs=>WDEP_DUST_NAT_C_GROUP - chemgroups(45)%name="WDEP_DAOBS" - chemgroups(45)%ptr=>WDEP_DAOBS_GROUP + chemgroups(52)%name="PMCO" + chemgroups(52)%specs=>PMCO_GROUP - chemgroups(46)%name="WDEP_DUST_NAT_C" - chemgroups(46)%ptr=>WDEP_DUST_NAT_C_GROUP + chemgroups(53)%name="DDEP_DUST_ANT_F" + chemgroups(53)%specs=>DDEP_DUST_ANT_F_GROUP - chemgroups(47)%name="PMCO" - chemgroups(47)%ptr=>PMCO_GROUP + chemgroups(54)%name="DDEP_OMCOARSE" + chemgroups(54)%specs=>DDEP_OMCOARSE_GROUP - chemgroups(48)%name="DDEP_DUST_ANT_F" - chemgroups(48)%ptr=>DDEP_DUST_ANT_F_GROUP + chemgroups(55)%name="NVFFIREOC25" + chemgroups(55)%specs=>NVFFIREOC25_GROUP - chemgroups(49)%name="DDEP_OMCOARSE" - chemgroups(49)%ptr=>DDEP_OMCOARSE_GROUP + chemgroups(56)%name="WDEP_RDN" + chemgroups(56)%specs=>WDEP_RDN_GROUP - chemgroups(50)%name="NVFFIREOC25" - chemgroups(50)%ptr=>NVFFIREOC25_GROUP + chemgroups(57)%name="WDEP_ASOA" + chemgroups(57)%specs=>WDEP_ASOA_GROUP - chemgroups(51)%name="WDEP_RDN" - chemgroups(51)%ptr=>WDEP_RDN_GROUP + chemgroups(58)%name="WDEP_NVWOODOC25" + chemgroups(58)%specs=>WDEP_NVWOODOC25_GROUP - chemgroups(52)%name="WDEP_ASOA" - chemgroups(52)%ptr=>WDEP_ASOA_GROUP + chemgroups(59)%name="DDEP_NVWOODOC25" + chemgroups(59)%specs=>DDEP_NVWOODOC25_GROUP - chemgroups(53)%name="WDEP_NVWOODOC25" - chemgroups(53)%ptr=>WDEP_NVWOODOC25_GROUP + chemgroups(60)%name="WDEP_ECFINE" + chemgroups(60)%specs=>WDEP_ECFINE_GROUP - chemgroups(54)%name="DDEP_NVWOODOC25" - chemgroups(54)%ptr=>DDEP_NVWOODOC25_GROUP + chemgroups(61)%name="WDEP_ECCOARSE" + chemgroups(61)%specs=>WDEP_ECCOARSE_GROUP - chemgroups(55)%name="WDEP_ECFINE" - chemgroups(55)%ptr=>WDEP_ECFINE_GROUP + chemgroups(62)%name="OXN" + chemgroups(62)%specs=>OXN_GROUP - chemgroups(56)%name="WDEP_ECCOARSE" - chemgroups(56)%ptr=>WDEP_ECCOARSE_GROUP + chemgroups(63)%name="WDEP_DUST_ANT_F" + chemgroups(63)%specs=>WDEP_DUST_ANT_F_GROUP - chemgroups(57)%name="OXN" - chemgroups(57)%ptr=>OXN_GROUP + chemgroups(64)%name="DDEP_NVFFUELOC25" + chemgroups(64)%specs=>DDEP_NVFFUELOC25_GROUP - chemgroups(58)%name="WDEP_DUST_ANT_F" - chemgroups(58)%ptr=>WDEP_DUST_ANT_F_GROUP + chemgroups(65)%name="SIA" + chemgroups(65)%specs=>SIA_GROUP - chemgroups(59)%name="DDEP_NVFFUELOC25" - chemgroups(59)%ptr=>DDEP_NVFFUELOC25_GROUP + chemgroups(66)%name="DDEP_ASH" + chemgroups(66)%specs=>DDEP_ASH_GROUP - chemgroups(60)%name="SIA" - chemgroups(60)%ptr=>SIA_GROUP + chemgroups(67)%name="DDEP_NVFFIREOC25" + chemgroups(67)%specs=>DDEP_NVFFIREOC25_GROUP - chemgroups(61)%name="DDEP_ASH" - chemgroups(61)%ptr=>DDEP_ASH_GROUP + chemgroups(68)%name="DDEP_TNO3" + chemgroups(68)%specs=>DDEP_TNO3_GROUP - chemgroups(62)%name="DDEP_NVFFIREOC25" - chemgroups(62)%ptr=>DDEP_NVFFIREOC25_GROUP + chemgroups(69)%name="DDEP_PMCO" + chemgroups(69)%specs=>DDEP_PMCO_GROUP - chemgroups(63)%name="DDEP_TNO3" - chemgroups(63)%ptr=>DDEP_TNO3_GROUP + chemgroups(70)%name="DDEP_BSOA" + chemgroups(70)%specs=>DDEP_BSOA_GROUP - chemgroups(64)%name="DDEP_PMCO" - chemgroups(64)%ptr=>DDEP_PMCO_GROUP + chemgroups(71)%name="DDEP_PCM" + chemgroups(71)%specs=>DDEP_PCM_GROUP - chemgroups(65)%name="DDEP_BSOA" - chemgroups(65)%ptr=>DDEP_BSOA_GROUP + chemgroups(72)%name="DDEP_NVFFUELOC_COARSE" + chemgroups(72)%specs=>DDEP_NVFFUELOC_COARSE_GROUP - chemgroups(66)%name="DDEP_PCM" - chemgroups(66)%ptr=>DDEP_PCM_GROUP + chemgroups(73)%name="ECCOARSE" + chemgroups(73)%specs=>ECCOARSE_GROUP - chemgroups(67)%name="DDEP_NVFFUELOC_COARSE" - chemgroups(67)%ptr=>DDEP_NVFFUELOC_COARSE_GROUP + chemgroups(74)%name="WOODEC" + chemgroups(74)%specs=>WOODEC_GROUP - chemgroups(68)%name="ECCOARSE" - chemgroups(68)%ptr=>ECCOARSE_GROUP + chemgroups(75)%name="WDEP_TNO3" + chemgroups(75)%specs=>WDEP_TNO3_GROUP - chemgroups(69)%name="WOODEC" - chemgroups(69)%ptr=>WOODEC_GROUP + chemgroups(76)%name="DDEP_DUST_ANT_C" + chemgroups(76)%specs=>DDEP_DUST_ANT_C_GROUP - chemgroups(70)%name="WDEP_TNO3" - chemgroups(70)%ptr=>WDEP_TNO3_GROUP + chemgroups(77)%name="WDEP_PMCO" + chemgroups(77)%specs=>WDEP_PMCO_GROUP - chemgroups(71)%name="DDEP_DUST_ANT_C" - chemgroups(71)%ptr=>DDEP_DUST_ANT_C_GROUP + chemgroups(78)%name="DDEP_FFUELEC" + chemgroups(78)%specs=>DDEP_FFUELEC_GROUP - chemgroups(72)%name="WDEP_PMCO" - chemgroups(72)%ptr=>WDEP_PMCO_GROUP + chemgroups(79)%name="WDEP_NVFFUELOC25" + chemgroups(79)%specs=>WDEP_NVFFUELOC25_GROUP - chemgroups(73)%name="DDEP_FFUELEC" - chemgroups(73)%ptr=>DDEP_FFUELEC_GROUP + chemgroups(80)%name="WDEP_PM10ANTHR" + chemgroups(80)%specs=>WDEP_PM10ANTHR_GROUP - chemgroups(74)%name="WDEP_NVFFUELOC25" - chemgroups(74)%ptr=>WDEP_NVFFUELOC25_GROUP + chemgroups(81)%name="WDEP_SVFFUELOA25" + chemgroups(81)%specs=>WDEP_SVFFUELOA25_GROUP - chemgroups(75)%name="WDEP_PM10ANTHR" - chemgroups(75)%ptr=>WDEP_PM10ANTHR_GROUP + chemgroups(82)%name="DDEP_PPM25" + chemgroups(82)%specs=>DDEP_PPM25_GROUP - chemgroups(76)%name="WDEP_SVFFUELOA25" - chemgroups(76)%ptr=>WDEP_SVFFUELOA25_GROUP + chemgroups(83)%name="WDEP_PPM25_FIRE" + chemgroups(83)%specs=>WDEP_PPM25_FIRE_GROUP - chemgroups(77)%name="DDEP_PPM25" - chemgroups(77)%ptr=>DDEP_PPM25_GROUP + chemgroups(84)%name="FFIREBC" + chemgroups(84)%specs=>FFIREBC_GROUP - chemgroups(78)%name="WDEP_PPM25_FIRE" - chemgroups(78)%ptr=>WDEP_PPM25_FIRE_GROUP + chemgroups(85)%name="WDEP_FFIREBC" + chemgroups(85)%specs=>WDEP_FFIREBC_GROUP - chemgroups(79)%name="FFIREBC" - chemgroups(79)%ptr=>FFIREBC_GROUP + chemgroups(86)%name="NOX" + chemgroups(86)%specs=>NOX_GROUP - chemgroups(80)%name="WDEP_FFIREBC" - chemgroups(80)%ptr=>WDEP_FFIREBC_GROUP + chemgroups(87)%name="DUST_NAT_F" + chemgroups(87)%specs=>DUST_NAT_F_GROUP - chemgroups(81)%name="NOX" - chemgroups(81)%ptr=>NOX_GROUP + chemgroups(88)%name="SS" + chemgroups(88)%specs=>SS_GROUP - chemgroups(82)%name="DUST_NAT_F" - chemgroups(82)%ptr=>DUST_NAT_F_GROUP + chemgroups(89)%name="DDEP_DUST" + chemgroups(89)%specs=>DDEP_DUST_GROUP - chemgroups(83)%name="SS" - chemgroups(83)%ptr=>SS_GROUP + chemgroups(90)%name="RO2" + chemgroups(90)%specs=>RO2_GROUP - chemgroups(84)%name="DDEP_DUST" - chemgroups(84)%ptr=>DDEP_DUST_GROUP + chemgroups(91)%name="DDEP_EC_F" + chemgroups(91)%specs=>DDEP_EC_F_GROUP - chemgroups(85)%name="RO2" - chemgroups(85)%ptr=>RO2_GROUP + chemgroups(92)%name="ROOH" + chemgroups(92)%specs=>ROOH_GROUP - chemgroups(86)%name="DDEP_EC_F" - chemgroups(86)%ptr=>DDEP_EC_F_GROUP + chemgroups(93)%name="DUST_ANT_C" + chemgroups(93)%specs=>DUST_ANT_C_GROUP - chemgroups(87)%name="ROOH" - chemgroups(87)%ptr=>ROOH_GROUP + chemgroups(94)%name="AOD" + chemgroups(94)%specs=>AOD_GROUP - chemgroups(88)%name="DUST_ANT_C" - chemgroups(88)%ptr=>DUST_ANT_C_GROUP + chemgroups(95)%name="DDEP_PPM_C" + chemgroups(95)%specs=>DDEP_PPM_C_GROUP - chemgroups(89)%name="AOD" - chemgroups(89)%ptr=>AOD_GROUP + chemgroups(96)%name="WDEP_NVABSOM" + chemgroups(96)%specs=>WDEP_NVABSOM_GROUP - chemgroups(90)%name="DDEP_PPM_C" - chemgroups(90)%ptr=>DDEP_PPM_C_GROUP + chemgroups(97)%name="SVFFUELOA25" + chemgroups(97)%specs=>SVFFUELOA25_GROUP - chemgroups(91)%name="WDEP_NVABSOM" - chemgroups(91)%ptr=>WDEP_NVABSOM_GROUP + chemgroups(98)%name="DDEP_SOX" + chemgroups(98)%specs=>DDEP_SOX_GROUP - chemgroups(92)%name="SVFFUELOA25" - chemgroups(92)%ptr=>SVFFUELOA25_GROUP + chemgroups(99)%name="WDEP_DUST_NAT_F" + chemgroups(99)%specs=>WDEP_DUST_NAT_F_GROUP - chemgroups(93)%name="DDEP_SOX" - chemgroups(93)%ptr=>DDEP_SOX_GROUP + chemgroups(100)%name="WDEP_SOX" + chemgroups(100)%specs=>WDEP_SOX_GROUP - chemgroups(94)%name="WDEP_DUST_NAT_F" - chemgroups(94)%ptr=>WDEP_DUST_NAT_F_GROUP + chemgroups(101)%name="PFFUELOA25" + chemgroups(101)%specs=>PFFUELOA25_GROUP - chemgroups(95)%name="WDEP_SOX" - chemgroups(95)%ptr=>WDEP_SOX_GROUP + chemgroups(102)%name="FFUELEC" + chemgroups(102)%specs=>FFUELEC_GROUP - chemgroups(96)%name="PFFUELOA25" - chemgroups(96)%ptr=>PFFUELOA25_GROUP + chemgroups(103)%name="PM10ANTHR" + chemgroups(103)%specs=>PM10ANTHR_GROUP - chemgroups(97)%name="FFUELEC" - chemgroups(97)%ptr=>FFUELEC_GROUP + chemgroups(104)%name="WDEP_DUST_ANT_C" + chemgroups(104)%specs=>WDEP_DUST_ANT_C_GROUP - chemgroups(98)%name="PM10ANTHR" - chemgroups(98)%ptr=>PM10ANTHR_GROUP + chemgroups(105)%name="DDEP_DUST_NAT_F" + chemgroups(105)%specs=>DDEP_DUST_NAT_F_GROUP - chemgroups(99)%name="WDEP_DUST_ANT_C" - chemgroups(99)%ptr=>WDEP_DUST_ANT_C_GROUP + chemgroups(106)%name="DDEP_PM10ANTHR" + chemgroups(106)%specs=>DDEP_PM10ANTHR_GROUP - chemgroups(100)%name="DDEP_DUST_NAT_F" - chemgroups(100)%ptr=>DDEP_DUST_NAT_F_GROUP + chemgroups(107)%name="DDEP_WOODEC" + chemgroups(107)%specs=>DDEP_WOODEC_GROUP - chemgroups(101)%name="DDEP_PM10ANTHR" - chemgroups(101)%ptr=>DDEP_PM10ANTHR_GROUP + chemgroups(108)%name="WDEP_WOODEC" + chemgroups(108)%specs=>WDEP_WOODEC_GROUP - chemgroups(102)%name="DDEP_WOODEC" - chemgroups(102)%ptr=>DDEP_WOODEC_GROUP + chemgroups(109)%name="WDEP_PCM" + chemgroups(109)%specs=>WDEP_PCM_GROUP - chemgroups(103)%name="WDEP_WOODEC" - chemgroups(103)%ptr=>WDEP_WOODEC_GROUP + chemgroups(110)%name="WDEP_SS" + chemgroups(110)%specs=>WDEP_SS_GROUP - chemgroups(104)%name="WDEP_PCM" - chemgroups(104)%ptr=>WDEP_PCM_GROUP + chemgroups(111)%name="DUST_NAT_C" + chemgroups(111)%specs=>DUST_NAT_C_GROUP - chemgroups(105)%name="WDEP_SS" - chemgroups(105)%ptr=>WDEP_SS_GROUP + chemgroups(112)%name="MONOTERP" + chemgroups(112)%specs=>MONOTERP_GROUP - chemgroups(106)%name="DUST_NAT_C" - chemgroups(106)%ptr=>DUST_NAT_C_GROUP + chemgroups(113)%name="WDEP_NONVOLPCM" + chemgroups(113)%specs=>WDEP_NONVOLPCM_GROUP - chemgroups(107)%name="WDEP_NONVOLPCM" - chemgroups(107)%ptr=>WDEP_NONVOLPCM_GROUP + chemgroups(114)%name="PPM25" + chemgroups(114)%specs=>PPM25_GROUP - chemgroups(108)%name="PPM25" - chemgroups(108)%ptr=>PPM25_GROUP + chemgroups(115)%name="ASOA" + chemgroups(115)%specs=>ASOA_GROUP - chemgroups(109)%name="ASOA" - chemgroups(109)%ptr=>ASOA_GROUP + chemgroups(116)%name="PPM10" + chemgroups(116)%specs=>PPM10_GROUP - chemgroups(110)%name="NVABSOM" - chemgroups(110)%ptr=>NVABSOM_GROUP + chemgroups(117)%name="NVABSOM" + chemgroups(117)%specs=>NVABSOM_GROUP - chemgroups(111)%name="PPM10" - chemgroups(111)%ptr=>PPM10_GROUP + chemgroups(118)%name="BSOA" + chemgroups(118)%specs=>BSOA_GROUP - chemgroups(112)%name="BSOA" - chemgroups(112)%ptr=>BSOA_GROUP + chemgroups(119)%name="CHET2" + chemgroups(119)%specs=>CHET2_GROUP - chemgroups(113)%name="ECFINE" - chemgroups(113)%ptr=>ECFINE_GROUP + chemgroups(120)%name="ECFINE" + chemgroups(120)%specs=>ECFINE_GROUP - chemgroups(114)%name="DDEP_FFIREBC" - chemgroups(114)%ptr=>DDEP_FFIREBC_GROUP + chemgroups(121)%name="DDEP_FFIREBC" + chemgroups(121)%specs=>DDEP_FFIREBC_GROUP - chemgroups(115)%name="WDEP_DUST" - chemgroups(115)%ptr=>WDEP_DUST_GROUP + chemgroups(122)%name="WDEP_DUST" + chemgroups(122)%specs=>WDEP_DUST_GROUP - chemgroups(116)%name="GRPS" - chemgroups(116)%ptr=>GRPS_GROUP + chemgroups(123)%name="GRPS" + chemgroups(123)%specs=>GRPS_GROUP - chemgroups(117)%name="NVFFUELOC_COARSE" - chemgroups(117)%ptr=>NVFFUELOC_COARSE_GROUP + chemgroups(124)%name="NVFFUELOC_COARSE" + chemgroups(124)%specs=>NVFFUELOC_COARSE_GROUP - chemgroups(118)%name="DDEP_ECFINE" - chemgroups(118)%ptr=>DDEP_ECFINE_GROUP + chemgroups(125)%name="DDEP_ECFINE" + chemgroups(125)%specs=>DDEP_ECFINE_GROUP - chemgroups(119)%name="WDEP_ROOH" - chemgroups(119)%ptr=>WDEP_ROOH_GROUP + chemgroups(126)%name="WDEP_ROOH" + chemgroups(126)%specs=>WDEP_ROOH_GROUP - chemgroups(120)%name="PCM" - chemgroups(120)%ptr=>PCM_GROUP + chemgroups(127)%name="PCM" + chemgroups(127)%specs=>PCM_GROUP - chemgroups(121)%name="SVWOODOA25" - chemgroups(121)%ptr=>SVWOODOA25_GROUP + chemgroups(128)%name="SVWOODOA25" + chemgroups(128)%specs=>SVWOODOA25_GROUP - chemgroups(122)%name="DDEP_SIA" - chemgroups(122)%ptr=>DDEP_SIA_GROUP + chemgroups(129)%name="DDEP_SIA" + chemgroups(129)%specs=>DDEP_SIA_GROUP - chemgroups(123)%name="WDEP_PFFIREOA25" - chemgroups(123)%ptr=>WDEP_PFFIREOA25_GROUP + chemgroups(130)%name="WDEP_PFFIREOA25" + chemgroups(130)%specs=>WDEP_PFFIREOA25_GROUP - chemgroups(124)%name="WDEP_OMCOARSE" - chemgroups(124)%ptr=>WDEP_OMCOARSE_GROUP + chemgroups(131)%name="WDEP_OMCOARSE" + chemgroups(131)%specs=>WDEP_OMCOARSE_GROUP - chemgroups(125)%name="TNO3" - chemgroups(125)%ptr=>TNO3_GROUP + chemgroups(132)%name="TNO3" + chemgroups(132)%specs=>TNO3_GROUP - chemgroups(126)%name="SVFFIREOA25" - chemgroups(126)%ptr=>SVFFIREOA25_GROUP + chemgroups(133)%name="SVFFIREOA25" + chemgroups(133)%specs=>SVFFIREOA25_GROUP - chemgroups(127)%name="DDEP_DAOBS" - chemgroups(127)%ptr=>DDEP_DAOBS_GROUP + chemgroups(134)%name="DDEP_DAOBS" + chemgroups(134)%specs=>DDEP_DAOBS_GROUP - chemgroups(128)%name="NVFFUELOC25" - chemgroups(128)%ptr=>NVFFUELOC25_GROUP + chemgroups(135)%name="NVFFUELOC25" + chemgroups(135)%specs=>NVFFUELOC25_GROUP - chemgroups(129)%name="OMCOARSE" - chemgroups(129)%ptr=>OMCOARSE_GROUP + chemgroups(136)%name="OMCOARSE" + chemgroups(136)%specs=>OMCOARSE_GROUP - chemgroups(130)%name="DDEP_ROOH" - chemgroups(130)%ptr=>DDEP_ROOH_GROUP + chemgroups(137)%name="DDEP_ROOH" + chemgroups(137)%specs=>DDEP_ROOH_GROUP - chemgroups(131)%name="WDEP_PMFINE" - chemgroups(131)%ptr=>WDEP_PMFINE_GROUP + chemgroups(138)%name="WDEP_PMFINE" + chemgroups(138)%specs=>WDEP_PMFINE_GROUP - chemgroups(132)%name="DDEP_RDN" - chemgroups(132)%ptr=>DDEP_RDN_GROUP + chemgroups(139)%name="DDEP_RDN" + chemgroups(139)%specs=>DDEP_RDN_GROUP - chemgroups(133)%name="PFFIREOA25" - chemgroups(133)%ptr=>PFFIREOA25_GROUP + chemgroups(140)%name="PFFIREOA25" + chemgroups(140)%specs=>PFFIREOA25_GROUP - chemgroups(134)%name="RDN" - chemgroups(134)%ptr=>RDN_GROUP + chemgroups(141)%name="RDN" + chemgroups(141)%specs=>RDN_GROUP - chemgroups(135)%name="WDEP_ASH" - chemgroups(135)%ptr=>WDEP_ASH_GROUP + chemgroups(142)%name="WDEP_ASH" + chemgroups(142)%specs=>WDEP_ASH_GROUP - chemgroups(136)%name="DAOBS" - chemgroups(136)%ptr=>DAOBS_GROUP + chemgroups(143)%name="DAOBS" + chemgroups(143)%specs=>DAOBS_GROUP - chemgroups(137)%name="WDEP_FFUELEC" - chemgroups(137)%ptr=>WDEP_FFUELEC_GROUP + chemgroups(144)%name="WDEP_FFUELEC" + chemgroups(144)%specs=>WDEP_FFUELEC_GROUP - chemgroups(138)%name="WDEP_OM25" - chemgroups(138)%ptr=>WDEP_OM25_GROUP + chemgroups(145)%name="WDEP_OM25" + chemgroups(145)%specs=>WDEP_OM25_GROUP endsubroutine Init_ChemGroups !----------------------------------------------------------- diff --git a/CM_ChemRates_ml.f90 b/CM_ChemRates_ml.f90 index e03ab00..de56f3a 100644 --- a/CM_ChemRates_ml.f90 +++ b/CM_ChemRates_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -44,7 +44,7 @@ module ChemRates_rct_ml public :: set_rct_rates - integer, parameter, public :: NRCT = 97 !! No. coefficients + integer, parameter, public :: NRCT = 115 !! No. coefficients real, allocatable, save, public, dimension(:,:) :: rct @@ -68,130 +68,152 @@ subroutine set_rct_rates() rct(7,:) = 1.7e-12*exp(-940.0*TINV) rct(8,:) = 2.03e-16*exp(-4.57*LOG300DIVT)*exp(693.0*TINV) rct(9,:) = 1.8e-11*exp(110.0*TINV) - rct(10,:) = 3.6e-12*exp(270.0*TINV) - rct(11,:) = 4.5e-14*exp(-1260.0*TINV) - rct(12,:) = 4.8e-11*exp(250.0*TINV) - rct(13,:) = 2.9e-12*exp(-160.0*TINV) - rct(14,:) = 7.7e-12*exp(-2100.0*TINV) - rct(15,:) = KMT3(2.4e-14,460.0,6.5E-34,1335.0,2.7E-17,2199.0,M) - rct(16,:) = (1.0+1.4e-21*H2O*exp(2200.0*TINV))*2.2E-13*exp(600.0*TINV) - rct(17,:) = (1.0+1.4e-21*H2O*exp(2200.0*TINV))*1.9E-33*exp(980.0*TINV)*M - rct(18,:) = 2.5e-12*exp(-260.0*TINV) - rct(19,:) = 1.85e-20*exp(2.82*LOG(TEMP))*exp(-987.0*TINV) - rct(20,:) = 1.44e-13+M*3.43E-33 - rct(21,:) = 2.3e-12*exp(360.0*TINV) - rct(22,:) = 7.4e-13*exp(-520.0*TINV) - rct(23,:) = 1.03e-13*exp(365.0*TINV)-7.4E-13*exp(-520.0*TINV) - rct(24,:) = 6.38e-18*(TEMP**2)*exp(144.0*TINV) - rct(25,:) = 3.8e-13*exp(780.0*TINV) - rct(26,:) = 5.3e-12*exp(190.0*TINV) - rct(27,:) = 1.25e-17*(TEMP**2)*exp(615.0*TINV) - rct(28,:) = 2e-12*exp(-2440.0*TINV) - rct(29,:) = 6.9e-12*exp(-1000.0*TINV) - rct(30,:) = 2.55e-12*exp(380.0*TINV) - rct(31,:) = 3.8e-13*exp(900.0*TINV) - rct(32,:) = 1.9e-12*exp(190.0*TINV) - rct(33,:) = 4.4e-12*exp(365.0*TINV) - rct(34,:) = 7.5e-12*exp(290.0*TINV) - rct(35,:) = 2e-12*exp(500.0*TINV) - rct(36,:) = 2.9e-12*exp(500.0*TINV) - rct(37,:) = 5.2e-13*exp(980.0*TINV) - rct(38,:) = 6.7e-18*(TEMP**2)*exp(511.0*TINV) - rct(39,:) = 2.03e-17*(TEMP**2)*exp(78.0*TINV) - rct(40,:) = 2.54e-12*exp(360.0*TINV) - rct(41,:) = 1.81875e-13*exp(1300.0*TINV) - rct(42,:) = 2.53e-18*(TEMP**2)*exp(503.0*TINV) - rct(43,:) = 9.1e-15*exp(-2580.0*TINV) - rct(44,:) = 5.5e-15*exp(-1880.0*TINV) - rct(45,:) = 1.5132e-13*exp(1300.0*TINV) - rct(46,:) = 2.49969e-13*exp(1300.0*TINV) - rct(47,:) = 2.05446e-13*exp(1300.0*TINV) - rct(48,:) = 6.6e-18*(TEMP**2)*exp(820.0*TINV) - rct(49,:) = 1.9e-12*exp(575.0*TINV) - rct(50,:) = 1.03e-14*exp(-1995.0*TINV) - rct(51,:) = 2.7e-11*exp(390.0*TINV) - rct(52,:) = 2.6e-12*exp(610.0*TINV) - rct(53,:) = 1.36e-15*exp(-2112.0*TINV) - rct(54,:) = 8e-12*exp(380.0*TINV) - rct(55,:) = 7.6e-12*exp(180.0*TINV) - rct(56,:) = 1.6e-12*exp(305.0*TINV) - rct(57,:) = 8.7e-12*exp(290.0*TINV) - rct(58,:) = 8.5e-16*exp(-1520.0*TINV) - rct(59,:) = 3.15e-12*exp(-450.0*TINV) - rct(60,:) = 4.3e-13*exp(1040.0*TINV) - rct(61,:) = HYDROLYSISN2O5() - rct(62,:) = IUPAC_TROE(1.0e-31*exp(1.6*LOG300DIVT) & - ,3.0E-11*exp(-0.3*LOG300DIVT) & + rct(10,:) = 3.3e-39*exp(530/TEMP)*O2 + rct(11,:) = 3.6e-12*exp(270.0*TINV) + rct(12,:) = 4.5e-14*exp(-1260.0*TINV) + rct(13,:) = 4.8e-11*exp(250.0*TINV) + rct(14,:) = 2.9e-12*exp(-160.0*TINV) + rct(15,:) = 7.7e-12*exp(-2100.0*TINV) + rct(16,:) = KMT3(2.4e-14,460.0,6.5E-34,1335.0,2.7E-17,2199.0,M) + rct(17,:) = (1.4e-31*M*(TEMP/300)**(-3.1)*4.0E-12)*10**(LOG10(0.4)/(1+(LOG10(1.4E-31*M*(TEMP/300)**(-3.1)/4.0E-12)/0.75-1.27*(LOG10(0.4)))**2))/(1.4E-31*M*(TEMP/300)**(-3.1)+4.0E-12) + rct(18,:) = (4.10e-05*M*exp(-10650/TEMP)*6.0E+15*exp(-11170/TEMP))*10**(LOG10(0.4)/(1+(LOG10(4.10E-05*M*exp(-10650/TEMP)/6.0E+15*exp(-11170/TEMP))/0.75-1.27*(LOG10(0.4)))**2))/(4.10E-05*M*exp(-10650/TEMP)+6.0E+15*exp(-11170/TEMP)) + rct(19,:) = 3.2e-13*exp(690/TEMP) + rct(20,:) = (1.0+1.4e-21*H2O*exp(2200.0*TINV))*2.2E-13*exp(600.0*TINV) + rct(21,:) = (1.0+1.4e-21*H2O*exp(2200.0*TINV))*1.9E-33*exp(980.0*TINV)*M + rct(22,:) = 2.5e-12*exp(-260.0*TINV) + rct(23,:) = 1.85e-20*exp(2.82*LOG(TEMP))*exp(-987.0*TINV) + rct(24,:) = 1.44e-13+M*3.43E-33 + rct(25,:) = 2.3e-12*exp(360.0*TINV) + rct(26,:) = 7.4e-13*exp(-520.0*TINV) + rct(27,:) = 1.03e-13*exp(365.0*TINV)-7.4E-13*exp(-520.0*TINV) + rct(28,:) = 6.38e-18*(TEMP**2)*exp(144.0*TINV) + rct(29,:) = 3.8e-13*exp(780.0*TINV) + rct(30,:) = 5.3e-12*exp(190.0*TINV) + rct(31,:) = 1.25e-17*(TEMP**2)*exp(615.0*TINV) + rct(32,:) = 2e-12*exp(-2440.0*TINV) + rct(33,:) = 6.9e-12*exp(-1000.0*TINV) + rct(34,:) = 2.55e-12*exp(380.0*TINV) + rct(35,:) = 3.8e-13*exp(900.0*TINV) + rct(36,:) = 1.9e-12*exp(190.0*TINV) + rct(37,:) = 4.4e-12*exp(365.0*TINV) + rct(38,:) = 7.5e-12*exp(290.0*TINV) + rct(39,:) = 2e-12*exp(500.0*TINV) + rct(40,:) = 2.9e-12*exp(500.0*TINV) + rct(41,:) = 5.2e-13*exp(980.0*TINV) + rct(42,:) = 6.7e-18*(TEMP**2)*exp(511.0*TINV) + rct(43,:) = 2.03e-17*(TEMP**2)*exp(78.0*TINV) + rct(44,:) = 2.54e-12*exp(360.0*TINV) + rct(45,:) = 1.81875e-13*exp(1300.0*TINV) + rct(46,:) = 2.53e-18*(TEMP**2)*exp(503.0*TINV) + rct(47,:) = 9.1e-15*exp(-2580.0*TINV) + rct(48,:) = 5.5e-15*exp(-1880.0*TINV) + rct(49,:) = 1.5132e-13*exp(1300.0*TINV) + rct(50,:) = 2.49969e-13*exp(1300.0*TINV) + rct(51,:) = 2.05446e-13*exp(1300.0*TINV) + rct(52,:) = 6.6e-18*(TEMP**2)*exp(820.0*TINV) + rct(53,:) = 1.9e-12*exp(575.0*TINV) + rct(54,:) = 2.7e-11*exp(390*TINV) + rct(55,:) = 3.4299e-15*exp(-1995*TINV) + rct(56,:) = 3.15e-12*exp(-450*TINV) + rct(57,:) = 2.286e-12*exp(360.0*TINV) + rct(58,:) = 2.54e-13*exp(360.0*TINV) + rct(59,:) = 1.3e-12*exp(610.0*TINV) + rct(60,:) = 4e-12*exp(380.0*TINV) + rct(61,:) = 2.13e-16*exp(-1520.0*TINV) + rct(62,:) = 3.5e-16*exp(-2100.0*TINV) + rct(63,:) = 1.27e-12*exp(360.0*TINV) + rct(64,:) = 1.6e-12*exp(305*TINV) + rct(65,:) = IUPAC_TROE(3.28e-28*exp(6.87*LOG300DIVT) & + ,1.125E-11*exp(1.105*LOG300DIVT) & + ,0.3 & + ,M & + ,0.75-1.27*LOG10(0.3))*0.107 + rct(66,:) = IUPAC_TROE(1.1e-5*exp(-10100.0*TINV) & + ,1.9E17*exp(-14100.0*TINV) & + ,0.3 & + ,M & + ,0.75-1.27*LOG10(0.3)) + rct(67,:) = 97760000*exp(-7261*TINV) + rct(68,:) = 1450000000000*exp(-10688*TINV) + rct(69,:) = 0.065**2 + rct(70,:) = HYDROLYSISN2O5() + rct(71,:) = IUPAC_TROE(1.0e-31*exp(1.6*LOG300DIVT) & + ,5.0E-11*exp(+0.3*LOG300DIVT) & ,0.85 & ,M & ,0.75-1.27*LOG10(0.85)) - rct(63,:) = IUPAC_TROE(3.6e-30*exp(4.1*LOG300DIVT) & + rct(72,:) = IUPAC_TROE(3.6e-30*exp(4.1*LOG300DIVT) & ,1.9E-12*exp(-0.2*LOG300DIVT) & ,0.35 & ,M & ,0.75-1.27*LOG10(0.35)) - rct(64,:) = IUPAC_TROE(1.3e-3*exp(3.5*LOG300DIVT)*exp(-11000.0*TINV) & + rct(73,:) = IUPAC_TROE(1.3e-3*exp(3.5*LOG300DIVT)*exp(-11000.0*TINV) & ,9.70E14*exp(-0.1*LOG300DIVT)*exp(-11080.0*TINV) & ,0.35 & ,M & ,0.75-1.27*LOG10(0.35)) - rct(65,:) = IUPAC_TROE(3.3e-30*exp(3.0*LOG300DIVT) & - ,4.1E-11 & - ,0.40 & - ,M & - ,0.75-1.27*LOG10(0.4)) - rct(66,:) = IUPAC_TROE(2.7e-28*exp(7.1*LOG300DIVT) & - ,1.2E-11*exp(0.9*LOG300DIVT) & - ,0.3 & + rct(74,:) = IUPAC_TROE(3.2e-30*exp(4.5*LOG300DIVT) & + ,3.0E-11 & + ,0.41 & ,M & - ,0.75-1.27*LOG10(0.3)) - rct(67,:) = IUPAC_TROE(4.9e-3*exp(-12100.0*TINV) & - ,5.4E16*exp(-13830.0*TINV) & + ,0.75-1.27*LOG10(0.41)) + rct(75,:) = IUPAC_TROE(3.28e-28*exp(6.87*LOG300DIVT) & + ,1.125E-11*exp(1.105*LOG300DIVT) & ,0.3 & ,M & ,0.75-1.27*LOG10(0.3)) - rct(68,:) = IUPAC_TROE(8.6e-29*exp(3.1*LOG300DIVT) & + rct(76,:) = IUPAC_TROE(8.6e-29*exp(3.1*LOG300DIVT) & ,9.0E-12*exp(0.85*LOG300DIVT) & ,0.48 & ,M & ,0.75-1.27*LOG10(0.48)) - rct(69,:) = IUPAC_TROE(8.0e-27*exp(3.5*LOG300DIVT) & + rct(77,:) = IUPAC_TROE(8.0e-27*exp(3.5*LOG300DIVT) & ,3.0E-11*300.0*TINV & ,0.5 & ,M & ,0.75-1.27*LOG10(0.5)) - rct(70,:) = IUPAC_TROE(7.4e-31*exp(2.4*LOG300DIVT) & + rct(78,:) = IUPAC_TROE(7.4e-31*exp(2.4*LOG300DIVT) & ,3.3E-11*exp(0.3*LOG300DIVT) & - ,exp(-temp/1420.0) & + ,0.81 & ,M & - ,0.75+3.884E-4*temp) - rct(71,:) = UPTAKERATE(CHNO3(:),GAM=0.01,S=S_M2M3(AERO%SS_C,:)) - rct(72,:) = UPTAKERATE(CHNO3(:),GAM=0.02,S=S_M2M3(AERO%DU_C,:)) - rct(73,:) = UPTAKERATE(CHO2,GAM=0.2,S=S_M2M3(AERO%PM,:)) - rct(74,:) = UPTAKERATE(CO3,GAM=1.0e-6,S=S_M2M3(AERO%DU_C,:)) - rct(75,:) = GAMN2O5(:) - rct(76,:) = 6.3e-16*exp(-580.0*TINV) - rct(77,:) = 1.2e-11*exp(444.0*TINV) - rct(78,:) = 1.2e-12*exp(490.0*TINV) - rct(79,:) = 2.65974e-13*exp(1300.0*TINV) - rct(80,:) = 4e-12*FGAS(ASOC_UG1,:) - rct(81,:) = 4e-12*FGAS(ASOC_UG10,:) - rct(82,:) = 4e-12*FGAS(ASOC_UG1E2,:) - rct(83,:) = 4e-12*FGAS(ASOC_UG1E3,:) - rct(84,:) = 4e-12*FGAS(NON_C_ASOA_UG1,:) - rct(85,:) = 4e-12*FGAS(NON_C_ASOA_UG10,:) - rct(86,:) = 4e-12*FGAS(NON_C_ASOA_UG1E2,:) - rct(87,:) = 4e-12*FGAS(NON_C_ASOA_UG1E3,:) - rct(88,:) = 4e-12*FGAS(BSOC_UG1,:) - rct(89,:) = 4e-12*FGAS(BSOC_UG10,:) - rct(90,:) = 4e-12*FGAS(BSOC_UG1E2,:) - rct(91,:) = 4e-12*FGAS(BSOC_UG1E3,:) - rct(92,:) = 4e-12*FGAS(NON_C_BSOA_UG1,:) - rct(93,:) = 4e-12*FGAS(NON_C_BSOA_UG10,:) - rct(94,:) = 4e-12*FGAS(NON_C_BSOA_UG1E2,:) - rct(95,:) = 4e-12*FGAS(NON_C_BSOA_UG1E3,:) - rct(96,:) = EC_AGEING_RATE() - rct(97,:) = EC_AGEING_RATE() + ,0.75-1.27*LOG10(0.81)) + rct(79,:) = UPTAKERATE(CNO3,GAM=0.001,S=S_M2M3(AERO%PM,:)) + rct(80,:) = UPTAKERATE(CNO2,GAM=0.0001,S=S_M2M3(AERO%PM,:)) + rct(81,:) = UPTAKERATE(CHNO3(:),GAM=0.1,S=S_M2M3(AERO%DU_C,:)) + rct(82,:) = UPTAKERATE(CHNO3(:),GAM=0.01,S=S_M2M3(AERO%SS_C,:)) + rct(83,:) = UPTAKERATE(CHO2,GAM=0.2,S=S_M2M3(AERO%PM,:)) + rct(84,:) = UPTAKERATE(CO3,GAM=1.0e-6,S=S_M2M3(AERO%DU_C,:)) + rct(85,:) = GAMN2O5(:) + rct(86,:) = UPTAKERATE(CO3,GAM=1.0e-6,S=S_M2M3(AERO%DU_F,:)) + rct(87,:) = 1.2e-11*exp(440*TINV) + rct(88,:) = 2.38e-11*exp(357*TINV) + rct(89,:) = 3.948e-11*exp(440*TINV) + rct(90,:) = 7.5e-13*exp(700*TINV) + rct(91,:) = 3.8e-12*exp(200*TINV) + rct(92,:) = 8.05e-16*exp(-640*TINV) + rct(93,:) = 1.35e-15*exp(-1270*TINV) + rct(94,:) = 2.6887e-15*exp(-640*TINV) + rct(95,:) = 1.2e-12*exp(490*TINV) + rct(96,:) = 2.6988e-12*exp(490*TINV) + rct(97,:) = 1.2e-12*exp(490.0*TINV) + rct(98,:) = 4e-12*FGAS(ASOC_UG1,:) + rct(99,:) = 4e-12*FGAS(ASOC_UG10,:) + rct(100,:) = 4e-12*FGAS(ASOC_UG1E2,:) + rct(101,:) = 4e-12*FGAS(ASOC_UG1E3,:) + rct(102,:) = 4e-12*FGAS(NON_C_ASOA_UG1,:) + rct(103,:) = 4e-12*FGAS(NON_C_ASOA_UG10,:) + rct(104,:) = 4e-12*FGAS(NON_C_ASOA_UG1E2,:) + rct(105,:) = 4e-12*FGAS(NON_C_ASOA_UG1E3,:) + rct(106,:) = 4e-12*FGAS(BSOC_UG1,:) + rct(107,:) = 4e-12*FGAS(BSOC_UG10,:) + rct(108,:) = 4e-12*FGAS(BSOC_UG1E2,:) + rct(109,:) = 4e-12*FGAS(BSOC_UG1E3,:) + rct(110,:) = 4e-12*FGAS(NON_C_BSOA_UG1,:) + rct(111,:) = 4e-12*FGAS(NON_C_BSOA_UG10,:) + rct(112,:) = 4e-12*FGAS(NON_C_BSOA_UG1E2,:) + rct(113,:) = 4e-12*FGAS(NON_C_BSOA_UG1E3,:) + rct(114,:) = EC_AGEING_RATE() + rct(115,:) = EC_AGEING_RATE() first_call=.false. end subroutine set_rct_rates end module ChemRates_rct_ml diff --git a/CM_ChemSpecs_ml.f90 b/CM_ChemSpecs_ml.f90 index dfb96a2..e49aa37 100644 --- a/CM_ChemSpecs_ml.f90 +++ b/CM_ChemSpecs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -35,7 +35,7 @@ module ChemSpecs_adv_ml ! ( Output from GenChem, sub print_species ) - integer, public, parameter :: NSPEC_ADV = 111 + integer, public, parameter :: NSPEC_ADV = 118 @@ -43,136 +43,143 @@ module ChemSpecs_adv_ml IXADV_O3 = 1 & , IXADV_NO = 2 & , IXADV_NO2 = 3 & - , IXADV_SHIPNOX = 4 & - , IXADV_PAN = 5 & - , IXADV_MPAN = 6 & + , IXADV_HO2NO2 = 4 & + , IXADV_SHIPNOX = 5 & + , IXADV_PAN = 6 & , IXADV_NO3 = 7 & , IXADV_N2O5 = 8 & - , IXADV_ISONO3 = 9 + , IXADV_HNO3 = 9 integer, public, parameter :: & - IXADV_HNO3 = 10 & - , IXADV_HONO = 11 & - , IXADV_CH3COO2 = 12 & - , IXADV_MACR = 13 & - , IXADV_ISNI = 14 & - , IXADV_ISNIR = 15 & - , IXADV_GLYOX = 16 & - , IXADV_MGLYOX = 17 & - , IXADV_MAL = 18 & - , IXADV_MEK = 19 + IXADV_HONO = 10 & + , IXADV_CH3COO2 = 11 & + , IXADV_GLYOX = 12 & + , IXADV_MGLYOX = 13 & + , IXADV_MAL = 14 & + , IXADV_MEK = 15 & + , IXADV_HCHO = 16 & + , IXADV_CH3CHO = 17 & + , IXADV_C2H6 = 18 & + , IXADV_NC4H10 = 19 integer, public, parameter :: & - IXADV_MVK = 20 & - , IXADV_HCHO = 21 & - , IXADV_CH3CHO = 22 & - , IXADV_C2H6 = 23 & - , IXADV_NC4H10 = 24 & - , IXADV_C2H4 = 25 & - , IXADV_C3H6 = 26 & - , IXADV_OXYL = 27 & - , IXADV_C5H8 = 28 & - , IXADV_APINENE = 29 + IXADV_C2H4 = 20 & + , IXADV_C3H6 = 21 & + , IXADV_OXYL = 22 & + , IXADV_C5H8 = 23 & + , IXADV_APINENE = 24 & + , IXADV_BPINENE = 25 & + , IXADV_XTERP = 26 & + , IXADV_BIOTERP = 27 & + , IXADV_CH3O2H = 28 & + , IXADV_C2H5OOH = 29 integer, public, parameter :: & - IXADV_CH3O2H = 30 & - , IXADV_C2H5OOH = 31 & - , IXADV_BURO2H = 32 & - , IXADV_ETRO2H = 33 & - , IXADV_PRRO2H = 34 & - , IXADV_OXYO2H = 35 & - , IXADV_MEKO2H = 36 & - , IXADV_MALO2H = 37 & - , IXADV_MVKO2H = 38 & - , IXADV_MACROOH = 39 + IXADV_BURO2H = 30 & + , IXADV_ETRO2H = 31 & + , IXADV_PRRO2H = 32 & + , IXADV_OXYO2H = 33 & + , IXADV_MEKO2H = 34 & + , IXADV_MALO2H = 35 & + , IXADV_H2O2 = 36 & + , IXADV_CH3COO2H = 37 & + , IXADV_CH3OH = 38 & + , IXADV_C2H5OH = 39 integer, public, parameter :: & - IXADV_MACO3H = 40 & - , IXADV_MACO2H = 41 & - , IXADV_ISRO2H = 42 & - , IXADV_H2O2 = 43 & - , IXADV_CH3COO2H = 44 & - , IXADV_ISONO3H = 45 & - , IXADV_ISNIRH = 46 & - , IXADV_CH3OH = 47 & - , IXADV_C2H5OH = 48 & - , IXADV_ACETOL = 49 + IXADV_ACETOL = 40 & + , IXADV_H2 = 41 & + , IXADV_CO = 42 & + , IXADV_CH4 = 43 & + , IXADV_SO2 = 44 & + , IXADV_ISO2 = 45 & + , IXADV_MACRO2 = 46 & + , IXADV_MACR = 47 & + , IXADV_MACROOH = 48 & + , IXADV_IEPOX = 49 integer, public, parameter :: & - IXADV_H2 = 50 & - , IXADV_CO = 51 & - , IXADV_CH4 = 52 & - , IXADV_SO2 = 53 & - , IXADV_SO4 = 54 & - , IXADV_NH3 = 55 & - , IXADV_NO3_F = 56 & - , IXADV_NO3_C = 57 & - , IXADV_NH4_F = 58 & - , IXADV_DUMMY = 59 + IXADV_HACET = 50 & + , IXADV_ISOOH = 51 & + , IXADV_ISON = 52 & + , IXADV_HCOOH = 53 & + , IXADV_MPAN = 54 & + , IXADV_NALD = 55 & + , IXADV_HPALD = 56 & + , IXADV_PACALD = 57 & + , IXADV_MVK = 58 & + , IXADV_TERPOOH = 59 integer, public, parameter :: & - IXADV_ASH_F = 60 & - , IXADV_ASH_C = 61 & - , IXADV_POM_F_WOOD = 62 & - , IXADV_POM_F_FFUEL = 63 & - , IXADV_POM_C_FFUEL = 64 & - , IXADV_EC_F_WOOD_NEW= 65 & - , IXADV_EC_F_WOOD_AGE= 66 & - , IXADV_EC_C_WOOD = 67 & - , IXADV_EC_F_FFUEL_NEW= 68 & - , IXADV_EC_F_FFUEL_AGE= 69 + IXADV_SO4 = 60 & + , IXADV_NH3 = 61 & + , IXADV_NO3_F = 62 & + , IXADV_NO3_C = 63 & + , IXADV_NH4_F = 64 & + , IXADV_DUMMY = 65 & + , IXADV_ASH_F = 66 & + , IXADV_ASH_C = 67 & + , IXADV_POM_F_WOOD = 68 & + , IXADV_POM_F_FFUEL = 69 integer, public, parameter :: & - IXADV_EC_C_FFUEL = 70 & - , IXADV_REMPPM25 = 71 & - , IXADV_REMPPM_C = 72 & - , IXADV_FFIRE_OM = 73 & - , IXADV_FFIRE_BC = 74 & - , IXADV_FFIRE_REMPPM25= 75 & - , IXADV_OM25_BGND = 76 & - , IXADV_OM25_P = 77 & - , IXADV_ASOC_NG100 = 78 & - , IXADV_ASOC_UG1 = 79 + IXADV_POM_C_FFUEL = 70 & + , IXADV_EC_F_WOOD_NEW= 71 & + , IXADV_EC_F_WOOD_AGE= 72 & + , IXADV_EC_C_WOOD = 73 & + , IXADV_EC_F_FFUEL_NEW= 74 & + , IXADV_EC_F_FFUEL_AGE= 75 & + , IXADV_EC_C_FFUEL = 76 & + , IXADV_REMPPM25 = 77 & + , IXADV_REMPPM_C = 78 & + , IXADV_FFIRE_OM = 79 integer, public, parameter :: & - IXADV_ASOC_UG10 = 80 & - , IXADV_ASOC_UG1E2 = 81 & - , IXADV_ASOC_UG1E3 = 82 & - , IXADV_NON_C_ASOA_NG100= 83 & - , IXADV_NON_C_ASOA_UG1= 84 & - , IXADV_NON_C_ASOA_UG10= 85 & - , IXADV_NON_C_ASOA_UG1E2= 86 & - , IXADV_NON_C_ASOA_UG1E3= 87 & - , IXADV_BSOC_NG100 = 88 & - , IXADV_BSOC_UG1 = 89 + IXADV_FFIRE_BC = 80 & + , IXADV_FFIRE_REMPPM25= 81 & + , IXADV_OM25_BGND = 82 & + , IXADV_OM25_P = 83 & + , IXADV_SQT_SOA_NV = 84 & + , IXADV_ASOC_NG100 = 85 & + , IXADV_ASOC_UG1 = 86 & + , IXADV_ASOC_UG10 = 87 & + , IXADV_ASOC_UG1E2 = 88 & + , IXADV_ASOC_UG1E3 = 89 integer, public, parameter :: & - IXADV_BSOC_UG10 = 90 & - , IXADV_BSOC_UG1E2 = 91 & - , IXADV_BSOC_UG1E3 = 92 & - , IXADV_NON_C_BSOA_NG100= 93 & - , IXADV_NON_C_BSOA_UG1= 94 & - , IXADV_NON_C_BSOA_UG10= 95 & - , IXADV_NON_C_BSOA_UG1E2= 96 & - , IXADV_NON_C_BSOA_UG1E3= 97 & - , IXADV_FFFUEL_NG10 = 98 & - , IXADV_WOODOA_NG10 = 99 + IXADV_NON_C_ASOA_NG100= 90 & + , IXADV_NON_C_ASOA_UG1= 91 & + , IXADV_NON_C_ASOA_UG10= 92 & + , IXADV_NON_C_ASOA_UG1E2= 93 & + , IXADV_NON_C_ASOA_UG1E3= 94 & + , IXADV_BSOC_NG100 = 95 & + , IXADV_BSOC_UG1 = 96 & + , IXADV_BSOC_UG10 = 97 & + , IXADV_BSOC_UG1E2 = 98 & + , IXADV_BSOC_UG1E3 = 99 integer, public, parameter :: & - IXADV_FFIREOA_NG10= 100 & - , IXADV_SEASALT_F = 101 & - , IXADV_SEASALT_C = 102 & - , IXADV_DUST_ROAD_F = 103 & - , IXADV_DUST_ROAD_C = 104 & - , IXADV_DUST_WB_F = 105 & - , IXADV_DUST_WB_C = 106 & - , IXADV_DUST_SAH_F = 107 & - , IXADV_DUST_SAH_C = 108 & - , IXADV_RN222 = 109 + IXADV_NON_C_BSOA_NG100= 100 & + , IXADV_NON_C_BSOA_UG1= 101 & + , IXADV_NON_C_BSOA_UG10= 102 & + , IXADV_NON_C_BSOA_UG1E2= 103 & + , IXADV_NON_C_BSOA_UG1E3= 104 & + , IXADV_FFFUEL_NG10 = 105 & + , IXADV_WOODOA_NG10 = 106 & + , IXADV_FFIREOA_NG10= 107 & + , IXADV_SEASALT_F = 108 & + , IXADV_SEASALT_C = 109 integer, public, parameter :: & - IXADV_RNWATER = 110 & - , IXADV_PB210 = 111 + IXADV_DUST_ROAD_F = 110 & + , IXADV_DUST_ROAD_C = 111 & + , IXADV_DUST_WB_F = 112 & + , IXADV_DUST_WB_C = 113 & + , IXADV_DUST_SAH_F = 114 & + , IXADV_DUST_SAH_C = 115 & + , IXADV_RN222 = 116 & + , IXADV_RNWATER = 117 & + , IXADV_PB210 = 118 !----------------------------------------------------------- end module ChemSpecs_adv_ml @@ -187,7 +194,7 @@ module ChemSpecs_shl_ml ! ( Output from GenChem, sub print_species ) - integer, public, parameter :: NSPEC_SHL = 17 + integer, public, parameter :: NSPEC_SHL = 16 @@ -208,9 +215,8 @@ module ChemSpecs_shl_ml , IXSHL_MEKO2 = 12 & , IXSHL_MALO2 = 13 & , IXSHL_MVKO2 = 14 & - , IXSHL_MACRO2 = 15 & - , IXSHL_MACO3 = 16 & - , IXSHL_TERPPEROXY = 17 + , IXSHL_TERPO2 = 15 & + , IXSHL_XMTO3_RO2 = 16 !----------------------------------------------------------- end module ChemSpecs_shl_ml @@ -225,13 +231,13 @@ module ChemSpecs_tot_ml ! ( Output from GenChem, sub print_species ) - integer, public, parameter :: NSPEC_TOT = 128 + integer, public, parameter :: NSPEC_TOT = 134 ! Aerosols: integer, public, parameter :: & NAEROSOL=23, &! Number of aerosol species - FIRST_SEMIVOL=95, &! First aerosol species - LAST_SEMIVOL=117 ! Last aerosol species + FIRST_SEMIVOL=101, &! First aerosol species + LAST_SEMIVOL=123 ! Last aerosol species @@ -252,142 +258,150 @@ module ChemSpecs_tot_ml , MEKO2 = 12 & , MALO2 = 13 & , MVKO2 = 14 & - , MACRO2 = 15 & - , MACO3 = 16 & - , TERPPEROXY = 17 & - , O3 = 18 & - , NO = 19 + , TERPO2 = 15 & + , XMTO3_RO2 = 16 & + , O3 = 17 & + , NO = 18 & + , NO2 = 19 integer, public, parameter :: & - NO2 = 20 & + HO2NO2 = 20 & , SHIPNOX = 21 & , PAN = 22 & - , MPAN = 23 & - , NO3 = 24 & - , N2O5 = 25 & - , ISONO3 = 26 & - , HNO3 = 27 & - , HONO = 28 & - , CH3COO2 = 29 + , NO3 = 23 & + , N2O5 = 24 & + , HNO3 = 25 & + , HONO = 26 & + , CH3COO2 = 27 & + , GLYOX = 28 & + , MGLYOX = 29 integer, public, parameter :: & - MACR = 30 & - , ISNI = 31 & - , ISNIR = 32 & - , GLYOX = 33 & - , MGLYOX = 34 & - , MAL = 35 & - , MEK = 36 & - , MVK = 37 & - , HCHO = 38 & - , CH3CHO = 39 + MAL = 30 & + , MEK = 31 & + , HCHO = 32 & + , CH3CHO = 33 & + , C2H6 = 34 & + , NC4H10 = 35 & + , C2H4 = 36 & + , C3H6 = 37 & + , OXYL = 38 & + , C5H8 = 39 integer, public, parameter :: & - C2H6 = 40 & - , NC4H10 = 41 & - , C2H4 = 42 & - , C3H6 = 43 & - , OXYL = 44 & - , C5H8 = 45 & - , APINENE = 46 & - , CH3O2H = 47 & - , C2H5OOH = 48 & - , BURO2H = 49 + APINENE = 40 & + , BPINENE = 41 & + , XTERP = 42 & + , BIOTERP = 43 & + , CH3O2H = 44 & + , C2H5OOH = 45 & + , BURO2H = 46 & + , ETRO2H = 47 & + , PRRO2H = 48 & + , OXYO2H = 49 integer, public, parameter :: & - ETRO2H = 50 & - , PRRO2H = 51 & - , OXYO2H = 52 & - , MEKO2H = 53 & - , MALO2H = 54 & - , MVKO2H = 55 & - , MACROOH = 56 & - , MACO3H = 57 & - , MACO2H = 58 & - , ISRO2H = 59 + MEKO2H = 50 & + , MALO2H = 51 & + , H2O2 = 52 & + , CH3COO2H = 53 & + , CH3OH = 54 & + , C2H5OH = 55 & + , ACETOL = 56 & + , H2 = 57 & + , CO = 58 & + , CH4 = 59 integer, public, parameter :: & - H2O2 = 60 & - , CH3COO2H = 61 & - , ISONO3H = 62 & - , ISNIRH = 63 & - , CH3OH = 64 & - , C2H5OH = 65 & - , ACETOL = 66 & - , H2 = 67 & - , CO = 68 & - , CH4 = 69 + SO2 = 60 & + , ISO2 = 61 & + , MACRO2 = 62 & + , MACR = 63 & + , MACROOH = 64 & + , IEPOX = 65 & + , HACET = 66 & + , ISOOH = 67 & + , ISON = 68 & + , HCOOH = 69 integer, public, parameter :: & - SO2 = 70 & - , SO4 = 71 & - , NH3 = 72 & - , NO3_F = 73 & - , NO3_C = 74 & - , NH4_F = 75 & - , DUMMY = 76 & - , ASH_F = 77 & - , ASH_C = 78 & - , POM_F_WOOD = 79 + MPAN = 70 & + , NALD = 71 & + , HPALD = 72 & + , PACALD = 73 & + , MVK = 74 & + , TERPOOH = 75 & + , SO4 = 76 & + , NH3 = 77 & + , NO3_F = 78 & + , NO3_C = 79 integer, public, parameter :: & - POM_F_FFUEL = 80 & - , POM_C_FFUEL = 81 & - , EC_F_WOOD_NEW= 82 & - , EC_F_WOOD_AGE= 83 & - , EC_C_WOOD = 84 & - , EC_F_FFUEL_NEW= 85 & - , EC_F_FFUEL_AGE= 86 & - , EC_C_FFUEL = 87 & - , REMPPM25 = 88 & - , REMPPM_C = 89 + NH4_F = 80 & + , DUMMY = 81 & + , ASH_F = 82 & + , ASH_C = 83 & + , POM_F_WOOD = 84 & + , POM_F_FFUEL = 85 & + , POM_C_FFUEL = 86 & + , EC_F_WOOD_NEW= 87 & + , EC_F_WOOD_AGE= 88 & + , EC_C_WOOD = 89 integer, public, parameter :: & - FFIRE_OM = 90 & - , FFIRE_BC = 91 & - , FFIRE_REMPPM25= 92 & - , OM25_BGND = 93 & - , OM25_P = 94 & - , ASOC_NG100 = 95 & - , ASOC_UG1 = 96 & - , ASOC_UG10 = 97 & - , ASOC_UG1E2 = 98 & - , ASOC_UG1E3 = 99 + EC_F_FFUEL_NEW= 90 & + , EC_F_FFUEL_AGE= 91 & + , EC_C_FFUEL = 92 & + , REMPPM25 = 93 & + , REMPPM_C = 94 & + , FFIRE_OM = 95 & + , FFIRE_BC = 96 & + , FFIRE_REMPPM25= 97 & + , OM25_BGND = 98 & + , OM25_P = 99 integer, public, parameter :: & - NON_C_ASOA_NG100= 100 & - , NON_C_ASOA_UG1= 101 & - , NON_C_ASOA_UG10= 102 & - , NON_C_ASOA_UG1E2= 103 & - , NON_C_ASOA_UG1E3= 104 & - , BSOC_NG100 = 105 & - , BSOC_UG1 = 106 & - , BSOC_UG10 = 107 & - , BSOC_UG1E2 = 108 & - , BSOC_UG1E3 = 109 + SQT_SOA_NV = 100 & + , ASOC_NG100 = 101 & + , ASOC_UG1 = 102 & + , ASOC_UG10 = 103 & + , ASOC_UG1E2 = 104 & + , ASOC_UG1E3 = 105 & + , NON_C_ASOA_NG100= 106 & + , NON_C_ASOA_UG1= 107 & + , NON_C_ASOA_UG10= 108 & + , NON_C_ASOA_UG1E2= 109 integer, public, parameter :: & - NON_C_BSOA_NG100= 110 & - , NON_C_BSOA_UG1= 111 & - , NON_C_BSOA_UG10= 112 & - , NON_C_BSOA_UG1E2= 113 & - , NON_C_BSOA_UG1E3= 114 & - , FFFUEL_NG10 = 115 & - , WOODOA_NG10 = 116 & - , FFIREOA_NG10= 117 & - , SEASALT_F = 118 & - , SEASALT_C = 119 + NON_C_ASOA_UG1E3= 110 & + , BSOC_NG100 = 111 & + , BSOC_UG1 = 112 & + , BSOC_UG10 = 113 & + , BSOC_UG1E2 = 114 & + , BSOC_UG1E3 = 115 & + , NON_C_BSOA_NG100= 116 & + , NON_C_BSOA_UG1= 117 & + , NON_C_BSOA_UG10= 118 & + , NON_C_BSOA_UG1E2= 119 integer, public, parameter :: & - DUST_ROAD_F = 120 & - , DUST_ROAD_C = 121 & - , DUST_WB_F = 122 & - , DUST_WB_C = 123 & - , DUST_SAH_F = 124 & - , DUST_SAH_C = 125 & - , RN222 = 126 & - , RNWATER = 127 & - , PB210 = 128 + NON_C_BSOA_UG1E3= 120 & + , FFFUEL_NG10 = 121 & + , WOODOA_NG10 = 122 & + , FFIREOA_NG10= 123 & + , SEASALT_F = 124 & + , SEASALT_C = 125 & + , DUST_ROAD_F = 126 & + , DUST_ROAD_C = 127 & + , DUST_WB_F = 128 & + , DUST_WB_C = 129 + + integer, public, parameter :: & + DUST_SAH_F = 130 & + , DUST_SAH_C = 131 & + , RN222 = 132 & + , RNWATER = 133 & + , PB210 = 134 !----------------------------------------------------------- end module ChemSpecs_tot_ml @@ -447,29 +461,23 @@ subroutine define_chemicals() species(MEKO2 ) = Chemical("MEKO2 ", 103.0000, 0, 4, 0, 0, 0.0000, 0.0 ) species(MALO2 ) = Chemical("MALO2 ", 147.0000, 0, 5, 0, 0, 0.0000, 0.0 ) species(MVKO2 ) = Chemical("MVKO2 ", 119.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(MACRO2 ) = Chemical("MACRO2 ", 119.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(MACO3 ) = Chemical("MACO3 ", 101.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(TERPPEROXY ) = Chemical("TERPPEROXY ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) + species(TERPO2 ) = Chemical("TERPO2 ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) + species(XMTO3_RO2 ) = Chemical("XMTO3_RO2 ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(O3 ) = Chemical("O3 ", 48.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(NO ) = Chemical("NO ", 30.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(NO2 ) = Chemical("NO2 ", 46.0000, 0, 0, 1, 0, 0.0000, 0.0 ) + species(HO2NO2 ) = Chemical("HO2NO2 ", 79.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(SHIPNOX ) = Chemical("SHIPNOX ", 46.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(PAN ) = Chemical("PAN ", 121.0000, 0, 2, 1, 0, 0.0000, 0.0 ) - species(MPAN ) = Chemical("MPAN ", 132.0000, 0, 4, 1, 0, 0.0000, 0.0 ) species(NO3 ) = Chemical("NO3 ", 62.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(N2O5 ) = Chemical("N2O5 ", 108.0000, 0, 0, 2, 0, 0.0000, 0.0 ) - species(ISONO3 ) = Chemical("ISONO3 ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(HNO3 ) = Chemical("HNO3 ", 63.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(HONO ) = Chemical("HONO ", 47.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(CH3COO2 ) = Chemical("CH3COO2 ", 75.0000, 0, 2, 0, 0, 0.0000, 0.0 ) - species(MACR ) = Chemical("MACR ", 70.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(ISNI ) = Chemical("ISNI ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) - species(ISNIR ) = Chemical("ISNIR ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(GLYOX ) = Chemical("GLYOX ", 58.0000, 0, 2, 0, 0, 0.0000, 0.0 ) species(MGLYOX ) = Chemical("MGLYOX ", 72.0000, 0, 3, 0, 0, 0.0000, 0.0 ) species(MAL ) = Chemical("MAL ", 98.0000, 0, 5, 0, 0, 0.0000, 0.0 ) species(MEK ) = Chemical("MEK ", 72.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(MVK ) = Chemical("MVK ", 70.0000, 0, 4, 0, 0, 0.0000, 0.0 ) species(HCHO ) = Chemical("HCHO ", 30.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(CH3CHO ) = Chemical("CH3CHO ", 44.0000, 0, 2, 0, 0, 0.0000, 0.0 ) species(C2H6 ) = Chemical("C2H6 ", 30.0000, 1, 2, 0, 0, 0.0000, 0.0 ) @@ -479,6 +487,9 @@ subroutine define_chemicals() species(OXYL ) = Chemical("OXYL ", 106.0000, 1, 8, 0, 0, 0.0000, 0.0 ) species(C5H8 ) = Chemical("C5H8 ", 68.0000, 1, 5, 0, 0, 0.0000, 0.0 ) species(APINENE ) = Chemical("APINENE ", 136.0000, 1, 10, 0, 0, 0.0000, 0.0 ) + species(BPINENE ) = Chemical("BPINENE ", 136.0000, 1, 10, 0, 0, 0.0000, 0.0 ) + species(XTERP ) = Chemical("XTERP ", 136.0000, 1, 10, 0, 0, 0.0000, 0.0 ) + species(BIOTERP ) = Chemical("BIOTERP ", 136.0000, 1, 10, 0, 0, 0.0000, 0.0 ) species(CH3O2H ) = Chemical("CH3O2H ", 48.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(C2H5OOH ) = Chemical("C2H5OOH ", 62.0000, 0, 2, 0, 0, 0.0000, 0.0 ) species(BURO2H ) = Chemical("BURO2H ", 90.0000, 0, 4, 0, 0, 0.0000, 0.0 ) @@ -487,15 +498,8 @@ subroutine define_chemicals() species(OXYO2H ) = Chemical("OXYO2H ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(MEKO2H ) = Chemical("MEKO2H ", 104.0000, 0, 4, 0, 0, 0.0000, 0.0 ) species(MALO2H ) = Chemical("MALO2H ", 147.0000, 0, 5, 0, 0, 0.0000, 0.0 ) - species(MVKO2H ) = Chemical("MVKO2H ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) - species(MACROOH ) = Chemical("MACROOH ", 120.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(MACO3H ) = Chemical("MACO3H ", 102.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(MACO2H ) = Chemical("MACO2H ", 86.0000, 0, 4, 0, 0, 0.0000, 0.0 ) - species(ISRO2H ) = Chemical("ISRO2H ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(H2O2 ) = Chemical("H2O2 ", 34.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(CH3COO2H ) = Chemical("CH3COO2H ", 76.0000, 0, 2, 0, 0, 0.0000, 0.0 ) - species(ISONO3H ) = Chemical("ISONO3H ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) - species(ISNIRH ) = Chemical("ISNIRH ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(CH3OH ) = Chemical("CH3OH ", 32.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(C2H5OH ) = Chemical("C2H5OH ", 46.0000, 0, 2, 0, 0, 0.0000, 0.0 ) species(ACETOL ) = Chemical("ACETOL ", 74.0000, 0, 3, 0, 0, 0.0000, 0.0 ) @@ -503,6 +507,21 @@ subroutine define_chemicals() species(CO ) = Chemical("CO ", 28.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(CH4 ) = Chemical("CH4 ", 16.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(SO2 ) = Chemical("SO2 ", 64.0000, 0, 0, 0, 1, 0.0000, 0.0 ) + species(ISO2 ) = Chemical("ISO2 ", 101.0000, 0, 5, 0, 0, 0.0000, 0.0 ) + species(MACRO2 ) = Chemical("MACRO2 ", 119.0000, 0, 4, 0, 0, 0.0000, 0.0 ) + species(MACR ) = Chemical("MACR ", 70.0000, 0, 4, 0, 0, 0.0000, 0.0 ) + species(MACROOH ) = Chemical("MACROOH ", 120.0000, 0, 4, 0, 0, 0.0000, 0.0 ) + species(IEPOX ) = Chemical("IEPOX ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) + species(HACET ) = Chemical("HACET ", 29.0000, 0, 1, 0, 0, 0.0000, 0.0 ) + species(ISOOH ) = Chemical("ISOOH ", 60.0000, 1, 5, 0, 0, 0.0000, 0.0 ) + species(ISON ) = Chemical("ISON ", 60.0000, 1, 5, 0, 0, 0.0000, 0.0 ) + species(HCOOH ) = Chemical("HCOOH ", 46.0000, 0, 1, 0, 0, 0.0000, 0.0 ) + species(MPAN ) = Chemical("MPAN ", 132.0000, 0, 4, 1, 0, 0.0000, 0.0 ) + species(NALD ) = Chemical("NALD ", 60.0000, 1, 5, 0, 0, 0.0000, 0.0 ) + species(HPALD ) = Chemical("HPALD ", 60.0000, 1, 5, 0, 0, 0.0000, 0.0 ) + species(PACALD ) = Chemical("PACALD ", 60.0000, 1, 5, 0, 0, 0.0000, 0.0 ) + species(MVK ) = Chemical("MVK ", 70.0000, 0, 4, 0, 0, 0.0000, 0.0 ) + species(TERPOOH ) = Chemical("TERPOOH ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(SO4 ) = Chemical("SO4 ", 96.0000, 0, 0, 0, 1, 0.0000, 0.0 ) species(NH3 ) = Chemical("NH3 ", 17.0000, 0, 0, 1, 0, 0.0000, 0.0 ) species(NO3_F ) = Chemical("NO3_F ", 62.0000, 0, 0, 1, 0, 0.0000, 0.0 ) @@ -527,6 +546,7 @@ subroutine define_chemicals() species(FFIRE_REMPPM25) = Chemical("FFIRE_REMPPM25", 12.0000, 0, 0, 0, 0, 0.0000, 0.0 ) species(OM25_BGND ) = Chemical("OM25_BGND ", 24.0000, 0, 1, 0, 0, 0.0000, 0.0 ) species(OM25_P ) = Chemical("OM25_P ", 1.0000, 0, 0, 0, 0, 0.0000, 0.0 ) + species(SQT_SOA_NV ) = Chemical("SQT_SOA_NV ", 302.0000, 0, 14, 0, 0, 0.0000, 0.0 ) species(ASOC_NG100 ) = Chemical("ASOC_NG100 ", 12.0000, 0, 1, 0, 0, 0.1000, 30.0 ) species(ASOC_UG1 ) = Chemical("ASOC_UG1 ", 12.0000, 0, 1, 0, 0, 1.0000, 30.0 ) species(ASOC_UG10 ) = Chemical("ASOC_UG10 ", 12.0000, 0, 1, 0, 0, 10.0000, 30.0 ) diff --git a/CM_DryDep.inc b/CM_DryDep.inc index 35aa698..82d34f4 100644 --- a/CM_DryDep.inc +++ b/CM_DryDep.inc @@ -1,10 +1,10 @@ - integer, public, parameter :: NDRYDEP_ADV = 65 + integer, public, parameter :: NDRYDEP_ADV = 71 type(depmap), public, dimension(NDRYDEP_ADV), parameter:: DDepMap= (/ & depmap( IXADV_O3, CDDEP_O3, -1) & , depmap( IXADV_NO2, CDDEP_NO2, -1) & + , depmap( IXADV_HO2NO2, CDDEP_HNO3, -1) & , depmap( IXADV_SHIPNOX, CDDEP_NO2, -1) & , depmap( IXADV_PAN, CDDEP_PAN, -1) & - , depmap( IXADV_MPAN, CDDEP_PAN, -1) & , depmap( IXADV_HNO3, CDDEP_HNO3, -1) & , depmap( IXADV_HONO, CDDEP_HNO2, -1) & , depmap( IXADV_MAL, CDDEP_ALD, -1) & @@ -15,6 +15,11 @@ , depmap( IXADV_H2O2, CDDEP_SO2, -1) & , depmap( IXADV_ACETOL, CDDEP_ALD, -1) & , depmap( IXADV_SO2, CDDEP_SO2, -1) & + , depmap( IXADV_MPAN, CDDEP_PAN, -1) & + , depmap( IXADV_NALD, CDDEP_ALD, -1) & + , depmap( IXADV_HPALD, CDDEP_ALD, -1) & + , depmap( IXADV_PACALD, CDDEP_ALD, -1) & + , depmap( IXADV_TERPOOH, CDDEP_ALD, -1) & , depmap( IXADV_SO4, CDDEP_PMfS, -1) & , depmap( IXADV_NH3, CDDEP_NH3, -1) & , depmap( IXADV_NO3_f, CDDEP_PMfN, -1) & @@ -36,6 +41,7 @@ , depmap( IXADV_FFIRE_OM, CDDEP_PMfS, -1) & , depmap( IXADV_FFIRE_BC, CDDEP_PMfS, -1) & , depmap( IXADV_FFIRE_REMPPM25, CDDEP_PMfS, -1) & + , depmap( IXADV_SQT_SOA_NV, CDDEP_PMfS, -1) & , depmap( IXADV_ASOC_ng100, CDDEP_ALD, -1) & , depmap( IXADV_ASOC_ug1, CDDEP_ALD, -1) & , depmap( IXADV_ASOC_ug10, CDDEP_ALD, -1) & diff --git a/CM_EmisBioNat.inc b/CM_EmisBioNat.inc index caa6b70..a89d264 100644 --- a/CM_EmisBioNat.inc +++ b/CM_EmisBioNat.inc @@ -2,10 +2,10 @@ character(len=11), save, dimension(NEMIS_BioNat), public:: & EMIS_BioNat = (/ & "C5H8 " & - , "APINENE " & , "NO " & , "ASH_F " & , "ASH_C " & + , "BIOTERP " & , "SEASALT_F " & , "SEASALT_C " & , "DUST_WB_F " & diff --git a/CM_EmisSpecs.inc b/CM_EmisSpecs.inc index e1a3247..af2d872 100644 --- a/CM_EmisSpecs.inc +++ b/CM_EmisSpecs.inc @@ -21,9 +21,9 @@ , "GLYOX " & , "MGLYOX " & , "C5H8 " & - , "APINENE " & , "ASH_F " & , "ASH_C " & + , "BIOTERP " & , "POM_F_FFUEL " & , "POM_C_FFUEL " & , "EC_F_FFUEL_NEW" & diff --git a/CM_Reactions1.inc b/CM_Reactions1.inc index e0f190f..0cffe0c 100644 --- a/CM_Reactions1.inc +++ b/CM_Reactions1.inc @@ -16,15 +16,13 @@ P = & rct(2,k) * xnew(OD ) & + rct(3,k) * xnew(OD ) & - + 0.3*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.2*rct(58,k) * xnew(MVK ) * xnew(O3 ) & + rcphot(IDAO3,K) * xnew(O3 ) & + rcphot(IDNO2,K) * xnew(NO2 ) & + rcphot(IDNO3,K) * xnew(NO3 ) L = & rct(1,k) & - + rct(62,k)* xnew(NO ) + + rct(71,k)* xnew(NO ) xnew(OP)= ( xold(OP) + dt2 * P) /(1.0 + dt2*L ) @@ -33,21 +31,33 @@ P = & 2.*rct(4,k) * xnew(OD ) & + rct(8,k) * xnew(O3 ) * xnew(HO2 ) & - + rct(10,k) * xnew(NO ) * xnew(HO2 ) & - + 0.4*rct(26,k) * xnew(CH3O2H ) * xnew(OH ) & + + rct(11,k) * xnew(NO ) * xnew(HO2 ) & + + 4.0e-12 * xnew(HO2 ) * xnew(NO3 ) & + + 0.4*rct(30,k) * xnew(CH3O2H ) * xnew(OH ) & + 8.01e-12 * xnew(C2H5OOH ) * xnew(OH ) & - + 0.44*rct(37,k) * xnew(CH3COO2 ) * xnew(HO2 ) & + + 0.44*rct(41,k) * xnew(CH3COO2 ) * xnew(HO2 ) & + 2.15e-11 * xnew(BURO2H ) * xnew(OH ) & + 1.38e-11 * xnew(ETRO2H ) * xnew(OH ) & - + 0.13*rct(43,k) * xnew(C2H4 ) * xnew(O3 ) & - + 0.36*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & + + 0.13*rct(47,k) * xnew(C2H4 ) * xnew(O3 ) & + + 0.36*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + 2.44e-11 * xnew(PRRO2H ) * xnew(OH ) & - + 0.55*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 7.5e-11 * xnew(ISRO2H ) * xnew(OH ) & - + 0.82*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + 0.08*rct(58,k) * xnew(MVK ) * xnew(O3 ) & + + 0.75*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 8.046e-11 * xnew(OH ) * xnew(ISOOH ) & + + 8.94e-12 * xnew(OH ) * xnew(ISOOH ) & + + 6.164e-17 * xnew(O3 ) * xnew(ISON ) & + + 0.38*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 0.38*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + 3.00e-11 * xnew(OH ) * xnew(MACROOH ) & + + rcphot(IDCH3O2H,K) * xnew(ISOOH ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + rct(68,k) * xnew(ISO2 ) & + + 0.065 * xnew(HPALD ) & + + 7.61e-11 * xnew(OH ) * xnew(HPALD ) & + + rct(69,k) * xnew(PACALD ) & + 2*rcphot(IDH2O2,K) * xnew(H2O2 ) & + rcphot(IDHNO3,K) * xnew(HNO3 ) & + + 0.333*rcphot(IDHO2NO2,K) * xnew(HO2NO2 ) & + rcphot(IDCH3O2H,K) * xnew(CH3O2H ) & + rcphot(IDCH3O2H,K) * xnew(C2H5OOH ) & + rcphot(IDCH3O2H,K) * xnew(ETRO2H ) & @@ -56,60 +66,66 @@ + rcphot(IDCH3O2H,K) * xnew(CH3COO2H ) & + rcphot(IDCH3O2H,K) * xnew(OXYO2H ) & + rcphot(IDCH3O2H,K) * xnew(MALO2H ) & - + 0.222*rcphot(IDNO2,K) * xnew(HONO ) + + 0.222*rcphot(IDNO2,K) * xnew(HONO ) & + + 0.25*1.0e6 * xnew(XMTO3_RO2 ) L = & rct(7,k)* xnew(O3 ) & - + rct(12,k)* xnew(HO2 ) & - + rct(13,k)* xnew(H2O2 ) & - + rct(14,k)* xnew(H2 ) & - + rct(15,k)* xnew(HNO3 ) & - + rct(18,k)* xnew(HONO ) & + + rct(13,k)* xnew(HO2 ) & + + rct(14,k)* xnew(H2O2 ) & + + rct(15,k)* xnew(H2 ) & + + rct(16,k)* xnew(HNO3 ) & + + 2.0e-11* xnew(NO3 ) & + + rct(19,k)* xnew(HO2NO2 ) & + + rct(22,k)* xnew(HONO ) & + 2e-12*AQRCK(ICLOHSO2,K)* xnew(SO2 ) & - + rct(19,k)* xnew(CH4 ) & - + rct(20,k)* xnew(CO ) & - + rct(24,k)* xnew(CH3OH ) & - + rct(26,k)* xnew(CH3O2H ) & - + rct(27,k)* xnew(HCHO ) & - + rct(29,k)* xnew(C2H6 ) & + + rct(23,k)* xnew(CH4 ) & + + rct(24,k)* xnew(CO ) & + + rct(28,k)* xnew(CH3OH ) & + + rct(30,k)* xnew(CH3O2H ) & + + rct(31,k)* xnew(HCHO ) & + + rct(33,k)* xnew(C2H6 ) & + 8.01e-12* xnew(C2H5OOH ) & - + rct(32,k)* xnew(C2H5OOH ) & - + rct(33,k)* xnew(CH3CHO ) & - + rct(32,k)* xnew(CH3COO2H ) & - + rct(38,k)* xnew(C2H5OH ) & - + rct(39,k)* xnew(NC4H10 ) & - + rct(42,k)* xnew(MEK ) & - + rct(32,k)* xnew(MEKO2H ) & - + rct(32,k)* xnew(BURO2H ) & + + rct(36,k)* xnew(C2H5OOH ) & + + rct(37,k)* xnew(CH3CHO ) & + + rct(36,k)* xnew(CH3COO2H ) & + + rct(42,k)* xnew(C2H5OH ) & + + rct(43,k)* xnew(NC4H10 ) & + + rct(46,k)* xnew(MEK ) & + + rct(36,k)* xnew(MEKO2H ) & + + rct(36,k)* xnew(BURO2H ) & + 2.15e-11* xnew(BURO2H ) & + 1.38e-11* xnew(ETRO2H ) & - + rct(32,k)* xnew(ETRO2H ) & + + rct(36,k)* xnew(ETRO2H ) & + 2.44e-11* xnew(PRRO2H ) & - + rct(32,k)* xnew(PRRO2H ) & + + rct(36,k)* xnew(PRRO2H ) & + 1.36e-11* xnew(OXYL ) & + 4.2e-11* xnew(OXYO2H ) & + 5.58e-11* xnew(MAL ) & - + rct(32,k)* xnew(MALO2H ) & - + rct(48,k)* xnew(GLYOX ) & - + rct(49,k)* xnew(MGLYOX ) & - + rct(51,k)* xnew(C5H8 ) & - + rct(52,k)* xnew(MVK ) & - + 7.5e-11* xnew(ISRO2H ) & - + rct(54,k)* xnew(MACR ) & - + 2.82e-11* xnew(MACROOH ) & - + rct(56,k)* xnew(ACETOL ) & - + 5.96e-11* xnew(ISNI ) & - + 1.87e-11* xnew(MACO3H ) & - + 1.51e-11* xnew(MACO2H ) & - + 2.0e-11* xnew(ISONO3H ) & - + 2.2e-11* xnew(MVKO2H ) & - + 3.7e-11* xnew(ISNIRH ) & - + 2.9e-11* xnew(MPAN ) & - + rct(65,k)* xnew(NO2 ) & - + rct(68,k)* xnew(C2H4 ) & - + rct(69,k)* xnew(C3H6 ) & - + rct(70,k)* xnew(NO ) & - + rct(65,k)* xnew(SHIPNOX ) + + rct(36,k)* xnew(MALO2H ) & + + rct(52,k)* xnew(GLYOX ) & + + rct(53,k)* xnew(MGLYOX ) & + + rct(54,k)* xnew(C5H8 ) & + + 8.046e-11* xnew(ISOOH ) & + + 8.94e-12* xnew(ISOOH ) & + + 9.13e-12* xnew(IEPOX ) & + + 3.34e-11* xnew(ISON ) & + + rct(59,k)* xnew(MACR ) & + + rct(60,k)* xnew(MACR ) & + + 2.90e-11* xnew(MPAN ) & + + 3.00e-11* xnew(MACROOH ) & + + rct(64,k)* xnew(HACET ) & + + 1.55e-12* xnew(NALD ) & + + 7.61e-11* xnew(HPALD ) & + + rct(74,k)* xnew(NO2 ) & + + rct(76,k)* xnew(C2H4 ) & + + rct(77,k)* xnew(C3H6 ) & + + rct(78,k)* xnew(NO ) & + + rct(74,k)* xnew(SHIPNOX ) & + + rct(87,k)* xnew(APINENE ) & + + rct(88,k)* xnew(BPINENE ) & + + rct(89,k)* xnew(XTERP ) & + + rct(91,k)* xnew(TERPOOH ) xnew(OH)= ( xold(OH) + dt2 * P) /(1.0 + dt2*L ) @@ -117,36 +133,54 @@ P = & rct(7,k) * xnew(O3 ) * xnew(OH ) & - + rct(13,k) * xnew(OH ) * xnew(H2O2 ) & - + rct(14,k) * xnew(OH ) * xnew(H2 ) & + + rct(14,k) * xnew(OH ) * xnew(H2O2 ) & + + rct(15,k) * xnew(OH ) * xnew(H2 ) & + + 2.0e-11 * xnew(OH ) * xnew(NO3 ) & + + rct(18,k) * xnew(HO2NO2 ) & + 2e-12*AQRCK(ICLOHSO2,K) * xnew(OH ) * xnew(SO2 ) & - + rct(20,k) * xnew(OH ) * xnew(CO ) & - + rct(21,k) * xnew(CH3O2 ) * xnew(NO ) & - + 2.*rct(22,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & - + rct(24,k) * xnew(OH ) * xnew(CH3OH ) & - + rct(27,k) * xnew(OH ) * xnew(HCHO ) & - + rct(28,k) * xnew(NO3 ) * xnew(HCHO ) & - + rct(30,k) * xnew(C2H5O2 ) * xnew(NO ) & - + 0.9*rct(35,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & - + rct(38,k) * xnew(OH ) * xnew(C2H5OH ) & - + 0.65*rct(40,k) * xnew(NO ) * xnew(SECC4H9O2 ) & - + rct(40,k) * xnew(ETRO2 ) * xnew(NO ) & - + 0.13*rct(43,k) * xnew(C2H4 ) * xnew(O3 ) & - + 0.28*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & - + rct(40,k) * xnew(NO ) * xnew(PRRO2 ) & - + rct(40,k) * xnew(OXYO2 ) * xnew(NO ) & - + rct(40,k) * xnew(MALO2 ) * xnew(NO ) & - + rct(48,k) * xnew(OH ) * xnew(GLYOX ) & - + 0.06*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.78*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.95*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.41*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + 0.95*rct(55,k) * xnew(MACRO2 ) * xnew(NO ) & - + 2.5e-12 * xnew(MACRO2 ) * xnew(NO3 ) & - + rct(56,k) * xnew(ACETOL ) * xnew(OH ) & - + 0.06*rct(58,k) * xnew(MVK ) * xnew(O3 ) & - + 0.05*rct(40,k) * xnew(ISNIR ) * xnew(NO ) & - + 0.8*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) & + + rct(24,k) * xnew(OH ) * xnew(CO ) & + + rct(25,k) * xnew(CH3O2 ) * xnew(NO ) & + + 2.*rct(26,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & + + rct(28,k) * xnew(OH ) * xnew(CH3OH ) & + + rct(31,k) * xnew(OH ) * xnew(HCHO ) & + + rct(32,k) * xnew(NO3 ) * xnew(HCHO ) & + + 1.2e-12 * xnew(CH3O2 ) * xnew(NO3 ) & + + rct(34,k) * xnew(C2H5O2 ) * xnew(NO ) & + + 0.9*rct(39,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & + + rct(42,k) * xnew(OH ) * xnew(C2H5OH ) & + + 0.65*rct(44,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + + rct(44,k) * xnew(ETRO2 ) * xnew(NO ) & + + 0.13*rct(47,k) * xnew(C2H4 ) * xnew(O3 ) & + + 0.28*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + rct(44,k) * xnew(NO ) * xnew(PRRO2 ) & + + rct(44,k) * xnew(OXYO2 ) * xnew(NO ) & + + rct(44,k) * xnew(MALO2 ) * xnew(NO ) & + + rct(52,k) * xnew(OH ) * xnew(GLYOX ) & + + 0.75*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + rct(56,k) * xnew(NO3 ) * xnew(C5H8 ) & + + rct(57,k) * xnew(NO ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 0.78*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 0.64*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 0.64*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + 1.5*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 1.17*1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + rct(64,k) * xnew(OH ) * xnew(HACET ) & + + rcphot(IDCH3O2H,K) * xnew(ISOOH ) & + + 0.64*rcphot(IDCH3O2H,K) * xnew(ISON ) & + + rcphot(IDACH2O,K) * xnew(MACR ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + rcphot(IDCH3COX,K) * xnew(HACET ) & + + rcphot(IDCH3CHO,K) * xnew(NALD ) & + + rct(67,k) * xnew(ISO2 ) & + + 0.065 * xnew(HPALD ) & + + rct(69,k) * xnew(PACALD ) & + + 2.0*1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) & + + 0.667*rcphot(IDHO2NO2,K) * xnew(HO2NO2 ) & + 2*rcphot(IDACH2O,K) * xnew(HCHO ) & + rcphot(IDCH3CHO,K) * xnew(CH3CHO ) & + rcphot(IDCH3O2H,K) * xnew(CH3O2H ) & @@ -158,109 +192,112 @@ + rcphot(IDCH3O2H,K) * xnew(PRRO2H ) & + rcphot(IDCH3O2H,K) * xnew(OXYO2H ) & + rcphot(IDCH3O2H,K) * xnew(MALO2H ) & - + rct(74,k) * xnew(O3 ) + + rct(84,k) * xnew(O3 ) & + + rct(86,k) * xnew(O3 ) & + + rct(44,k) * xnew(TERPO2 ) * xnew(NO ) & + + 0.25*1.0e6 * xnew(XMTO3_RO2 ) L = & rct(8,k)* xnew(O3 ) & - + rct(10,k)* xnew(NO ) & - + rct(12,k)* xnew(OH ) & - + rct(16,k)* xnew(HO2 ) & - + rct(16,k)* xnew(HO2 ) & - + rct(17,k)* xnew(HO2 ) & - + rct(17,k)* xnew(HO2 ) & - + rct(25,k)* xnew(CH3O2 ) & - + rct(31,k)* xnew(C2H5O2 ) & - + rct(37,k)* xnew(CH3COO2 ) & - + rct(41,k)* xnew(SECC4H9O2 ) & - + rct(41,k)* xnew(MEKO2 ) & + + rct(11,k)* xnew(NO ) & + + rct(13,k)* xnew(OH ) & + + rct(17,k)* xnew(NO2 ) & + + 4.0e-12* xnew(NO3 ) & + + rct(20,k)* xnew(HO2 ) & + + rct(20,k)* xnew(HO2 ) & + + rct(21,k)* xnew(HO2 ) & + + rct(21,k)* xnew(HO2 ) & + + rct(29,k)* xnew(CH3O2 ) & + + rct(35,k)* xnew(C2H5O2 ) & + + rct(41,k)* xnew(CH3COO2 ) & + + rct(45,k)* xnew(SECC4H9O2 ) & + + rct(45,k)* xnew(MEKO2 ) & + 1.2e-11* xnew(ETRO2 ) & - + rct(45,k)* xnew(PRRO2 ) & - + rct(46,k)* xnew(OXYO2 ) & - + rct(47,k)* xnew(MALO2 ) & - + rct(47,k)* xnew(ISRO2 ) & - + rct(41,k)* xnew(MACRO2 ) & - + rct(47,k)* xnew(ISONO3 ) & - + rct(41,k)* xnew(MVKO2 ) & - + rct(60,k)* xnew(MACO3 ) & - + rct(47,k)* xnew(ISNIR ) & - + rct(73,k) + + rct(49,k)* xnew(PRRO2 ) & + + rct(50,k)* xnew(OXYO2 ) & + + rct(51,k)* xnew(MALO2 ) & + + rct(51,k)* xnew(ISO2 ) & + + rct(45,k)* xnew(MACRO2 ) & + + rct(83,k) & + + rct(90,k)* xnew(TERPO2 ) xnew(HO2)= ( xold(HO2) + dt2 * P) /(1.0 + dt2*L ) !-> CH3O2 P = & - rct(19,k) * xnew(OH ) * xnew(CH4 ) & - + 0.6*rct(26,k) * xnew(CH3O2H ) * xnew(OH ) & - + 0.05*rct(33,k) * xnew(OH ) * xnew(CH3CHO ) & - + rct(34,k) * xnew(CH3COO2 ) * xnew(NO ) & - + 0.9*rct(35,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & - + rct(36,k) * xnew(CH3COO2 ) * xnew(CH3COO2 ) & - + rct(36,k) * xnew(CH3COO2 ) * xnew(CH3COO2 ) & - + 0.44*rct(37,k) * xnew(CH3COO2 ) * xnew(HO2 ) & - + 0.28*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & + rct(23,k) * xnew(OH ) * xnew(CH4 ) & + + 0.6*rct(30,k) * xnew(CH3O2H ) * xnew(OH ) & + + 0.05*rct(37,k) * xnew(OH ) * xnew(CH3CHO ) & + + rct(38,k) * xnew(CH3COO2 ) * xnew(NO ) & + + 0.9*rct(39,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & + + rct(40,k) * xnew(CH3COO2 ) * xnew(CH3COO2 ) & + + rct(40,k) * xnew(CH3COO2 ) * xnew(CH3COO2 ) & + + 0.44*rct(41,k) * xnew(CH3COO2 ) * xnew(HO2 ) & + + 0.28*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + 0.24*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + rcphot(IDCH3CHO,K) * xnew(CH3CHO ) & - + rcphot(IDCH3O2H,K) * xnew(CH3COO2H ) - - L = & - rct(21,k)* xnew(NO ) & - + rct(22,k)* xnew(CH3O2 ) & - + rct(22,k)* xnew(CH3O2 ) & - + rct(23,k)* xnew(CH3O2 ) & - + rct(23,k)* xnew(CH3O2 ) & - + rct(25,k)* xnew(HO2 ) & - + rct(35,k)* xnew(CH3COO2 ) + + rcphot(IDCH3O2H,K) * xnew(CH3COO2H ) & + + 0.08*1.0e6 * xnew(XMTO3_RO2 ) + + L = & + rct(25,k)* xnew(NO ) & + + rct(26,k)* xnew(CH3O2 ) & + + rct(26,k)* xnew(CH3O2 ) & + + rct(27,k)* xnew(CH3O2 ) & + + rct(27,k)* xnew(CH3O2 ) & + + rct(29,k)* xnew(HO2 ) & + + 1.2e-12* xnew(NO3 ) & + + rct(39,k)* xnew(CH3COO2 ) & + + 1.0e-12* xnew(MACRO2 ) & + + 1.0e-12* xnew(MACRO2 ) & + + 1.0e-12* xnew(ISO2 ) & + + 1.0e-12* xnew(ISO2 ) xnew(CH3O2)= ( xold(CH3O2) + dt2 * P) /(1.0 + dt2*L ) !-> C2H5O2 P = & - rct(29,k) * xnew(OH ) * xnew(C2H6 ) & - + rct(32,k) * xnew(C2H5OOH ) * xnew(OH ) & - + 0.35*rct(40,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + rct(33,k) * xnew(OH ) * xnew(C2H6 ) & + + rct(36,k) * xnew(C2H5OOH ) * xnew(OH ) & + + 0.35*rct(44,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + 0.35*rcphot(IDCH3O2H,K) * xnew(BURO2H ) & + rcphot(IDCH3COX,K) * xnew(MEK ) L = & - rct(30,k)* xnew(NO ) & - + rct(31,k)* xnew(HO2 ) + rct(34,k)* xnew(NO ) & + + rct(35,k)* xnew(HO2 ) xnew(C2H5O2)= ( xold(C2H5O2) + dt2 * P) /(1.0 + dt2*L ) !-> SECC4H9O2 P = & - rct(39,k) * xnew(OH ) * xnew(NC4H10 ) & - + rct(32,k) * xnew(BURO2H ) * xnew(OH ) + rct(43,k) * xnew(OH ) * xnew(NC4H10 ) & + + rct(36,k) * xnew(BURO2H ) * xnew(OH ) L = & - rct(40,k)* xnew(NO ) & - + rct(41,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(45,k)* xnew(HO2 ) xnew(SECC4H9O2)= ( xold(SECC4H9O2) + dt2 * P) /(1.0 + dt2*L ) !-> ISRO2 - - P = & - rct(51,k) * xnew(C5H8 ) * xnew(OH ) & - + 0.12*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 7.5e-11 * xnew(ISRO2H ) * xnew(OH ) - - L = & - rct(40,k)* xnew(NO ) & - + rct(47,k)* xnew(HO2 ) - - xnew(ISRO2)= ( xold(ISRO2) + dt2 * P) /(1.0 + dt2*L ) + ! P = 0.0 + + ! L = 0.0 + +!Nothing to do for ISRO2! xnew(ISRO2)= max(0.0, xold(ISRO2)) !-> ETRO2 P = & - rct(32,k) * xnew(ETRO2H ) * xnew(OH ) & - + rct(68,k) * xnew(C2H4 ) * xnew(OH ) + rct(36,k) * xnew(ETRO2H ) * xnew(OH ) & + + rct(76,k) * xnew(C2H4 ) * xnew(OH ) L = & - rct(40,k)* xnew(NO ) & + rct(44,k)* xnew(NO ) & + 1.2e-11* xnew(HO2 ) xnew(ETRO2)= ( xold(ETRO2) + dt2 * P) /(1.0 + dt2*L ) @@ -268,12 +305,12 @@ !-> PRRO2 P = & - rct(32,k) * xnew(PRRO2H ) * xnew(OH ) & - + rct(69,k) * xnew(OH ) * xnew(C3H6 ) + rct(36,k) * xnew(PRRO2H ) * xnew(OH ) & + + rct(77,k) * xnew(OH ) * xnew(C3H6 ) L = & - rct(40,k)* xnew(NO ) & - + rct(45,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(49,k)* xnew(HO2 ) xnew(PRRO2)= ( xold(PRRO2) + dt2 * P) /(1.0 + dt2*L ) @@ -284,20 +321,20 @@ + 4.2e-11 * xnew(OXYO2H ) * xnew(OH ) L = & - rct(40,k)* xnew(NO ) & - + rct(46,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(50,k)* xnew(HO2 ) xnew(OXYO2)= ( xold(OXYO2) + dt2 * P) /(1.0 + dt2*L ) !-> MEKO2 P = & - rct(42,k) * xnew(OH ) * xnew(MEK ) & - + rct(32,k) * xnew(MEKO2H ) * xnew(OH ) + rct(46,k) * xnew(OH ) * xnew(MEK ) & + + rct(36,k) * xnew(MEKO2H ) * xnew(OH ) L = & - rct(40,k)* xnew(NO ) & - + rct(41,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(45,k)* xnew(HO2 ) xnew(MEKO2)= ( xold(MEKO2) + dt2 * P) /(1.0 + dt2*L ) @@ -305,72 +342,55 @@ P = & 5.58e-11 * xnew(MAL ) * xnew(OH ) & - + rct(32,k) * xnew(MALO2H ) * xnew(OH ) + + rct(36,k) * xnew(MALO2H ) * xnew(OH ) L = & - rct(40,k)* xnew(NO ) & - + rct(47,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(51,k)* xnew(HO2 ) xnew(MALO2)= ( xold(MALO2) + dt2 * P) /(1.0 + dt2*L ) !-> MVKO2 + ! P = 0.0 + + ! L = 0.0 + +!Nothing to do for MVKO2! xnew(MVKO2)= max(0.0, xold(MVKO2)) - P = & - rct(52,k) * xnew(MVK ) * xnew(OH ) & - + 2.2e-11 * xnew(MVKO2H ) * xnew(OH ) - - L = & - rct(40,k)* xnew(NO ) & - + rct(41,k)* xnew(HO2 ) - - xnew(MVKO2)= ( xold(MVKO2) + dt2 * P) /(1.0 + dt2*L ) - -!-> MACRO2 +!-> TERPO2 P = & - 0.5*rct(54,k) * xnew(MACR ) * xnew(OH ) & - + 2.82e-11 * xnew(MACROOH ) * xnew(OH ) + rct(87,k) * xnew(APINENE ) * xnew(OH ) & + + rct(88,k) * xnew(BPINENE ) * xnew(OH ) & + + rct(89,k) * xnew(XTERP ) * xnew(OH ) & + + rct(91,k) * xnew(TERPOOH ) * xnew(OH ) & + + rct(95,k) * xnew(APINENE ) * xnew(NO3 ) & + + 2.51e-12 * xnew(BPINENE ) * xnew(NO3 ) & + + rct(96,k) * xnew(XTERP ) * xnew(NO3 ) L = & - rct(55,k)* xnew(NO ) & - + 2.5e-12* xnew(NO3 ) & - + rct(41,k)* xnew(HO2 ) + rct(44,k)* xnew(NO ) & + + rct(90,k)* xnew(HO2 ) - xnew(MACRO2)= ( xold(MACRO2) + dt2 * P) /(1.0 + dt2*L ) + xnew(TERPO2)= ( xold(TERPO2) + dt2 * P) /(1.0 + dt2*L ) -!-> MACO3 +!-> XMTO3_RO2 P = & - 0.5*rct(54,k) * xnew(MACR ) * xnew(OH ) & - + 1.87e-11 * xnew(MACO3H ) * xnew(OH ) & - + rct(67,k) * xnew(MPAN ) + rct(92,k) * xnew(APINENE ) * xnew(O3 ) & + + rct(93,k) * xnew(BPINENE ) * xnew(O3 ) & + + rct(94,k) * xnew(XTERP ) * xnew(O3 ) L = & - rct(57,k)* xnew(NO ) & - + rct(60,k)* xnew(HO2 ) & - + rct(66,k)* xnew(NO2 ) + 1.0e6 - xnew(MACO3)= ( xold(MACO3) + dt2 * P) /(1.0 + dt2*L ) - -!-> TERPPEROXY - - P = & - rct(76,k)*xnew(O3) * xnew(APINENE ) & - + rct(77,k)*xnew(OH) * xnew(APINENE ) & - + rct(78,k)*xnew(NO3) * xnew(APINENE ) - - L = & - rct(40,k)*xnew(NO) & - + rct(79,k)*xnew(HO2) - - xnew(TERPPEROXY)= ( xold(TERPPEROXY) + dt2 * P) /(1.0 + dt2*L ) + xnew(XMTO3_RO2)= ( xold(XMTO3_RO2) + dt2 * P) /(1.0 + dt2*L ) !-> O3 P = & rct(1,k) * xnew(OP ) & - + 0.15*rct(37,k) * xnew(CH3COO2 ) * xnew(HO2 ) & - + 0.29*rct(60,k) * xnew(MACO3 ) * xnew(HO2 ) + + 0.15*rct(41,k) * xnew(CH3COO2 ) * xnew(HO2 ) L = & rct(5,k)* xnew(NO ) & @@ -378,21 +398,31 @@ + rct(7,k)* xnew(OH ) & + rct(8,k)* xnew(HO2 ) & + AQRCK(ICLRC2,K)* xnew(SO2 ) & - + rct(43,k)* xnew(C2H4 ) & - + rct(44,k)* xnew(C3H6 ) & - + rct(50,k)* xnew(C5H8 ) & - + rct(53,k)* xnew(MACR ) & - + rct(58,k)* xnew(MVK ) & + + rct(47,k)* xnew(C2H4 ) & + + rct(48,k)* xnew(C3H6 ) & + + rct(55,k)* xnew(C5H8 ) & + + rct(55,k)* xnew(C5H8 ) & + + rct(55,k)* xnew(C5H8 ) & + + 6.164e-17* xnew(ISON ) & + + 3.036e-17* xnew(ISON ) & + + rct(61,k)* xnew(MACR ) & + + rct(61,k)* xnew(MACR ) & + + rct(62,k)* xnew(MACR ) & + + rct(62,k)* xnew(MACR ) & + rcphot(IDAO3,K) & + rcphot(IDBO3,K) & - + rct(74,k) + + rct(84,k) & + + rct(86,k) & + + rct(92,k)* xnew(APINENE ) & + + rct(93,k)* xnew(BPINENE ) & + + rct(94,k)* xnew(XTERP ) xnew(O3)= ( xold(O3) + dt2 * P) /(1.0 + dt2*L ) !-> NO P = & - rct(11,k) * xnew(NO2 ) * xnew(NO3 ) & + rct(12,k) * xnew(NO2 ) * xnew(NO3 ) & + rcphot(IDNO2,K) * xnew(NO2 ) & + 0.222*rcphot(IDNO2,K) * xnew(HONO ) & + rcemis(NO,k) & @@ -401,24 +431,25 @@ L = & rct(5,k)* xnew(O3 ) & + rct(9,k)* xnew(NO3 ) & - + rct(10,k)* xnew(HO2 ) & - + rct(21,k)* xnew(CH3O2 ) & - + rct(30,k)* xnew(C2H5O2 ) & - + rct(34,k)* xnew(CH3COO2 ) & - + rct(40,k)* xnew(SECC4H9O2 ) & - + rct(40,k)* xnew(MEKO2 ) & - + rct(40,k)* xnew(ETRO2 ) & - + rct(40,k)* xnew(PRRO2 ) & - + rct(40,k)* xnew(OXYO2 ) & - + rct(40,k)* xnew(MALO2 ) & - + rct(40,k)* xnew(ISRO2 ) & - + rct(40,k)* xnew(MVKO2 ) & - + rct(55,k)* xnew(MACRO2 ) & - + rct(57,k)* xnew(MACO3 ) & - + rct(40,k)* xnew(ISNIR ) & - + rct(40,k)* xnew(ISONO3 ) & - + rct(62,k)* xnew(OP ) & - + rct(70,k)* xnew(OH ) + + rct(10,k)* xnew(NO ) & + + rct(10,k)* xnew(NO ) & + + rct(11,k)* xnew(HO2 ) & + + rct(25,k)* xnew(CH3O2 ) & + + rct(34,k)* xnew(C2H5O2 ) & + + rct(38,k)* xnew(CH3COO2 ) & + + rct(44,k)* xnew(SECC4H9O2 ) & + + rct(44,k)* xnew(MEKO2 ) & + + rct(44,k)* xnew(ETRO2 ) & + + rct(44,k)* xnew(PRRO2 ) & + + rct(44,k)* xnew(OXYO2 ) & + + rct(44,k)* xnew(MALO2 ) & + + rct(57,k)* xnew(ISO2 ) & + + rct(58,k)* xnew(ISO2 ) & + + rct(63,k)* xnew(MACRO2 ) & + + rct(63,k)* xnew(MACRO2 ) & + + rct(71,k)* xnew(OP ) & + + rct(78,k)* xnew(OH ) & + + rct(44,k)* xnew(TERPO2 ) xnew(NO)= ( xold(NO) + dt2 * P) /(1.0 + dt2*L ) @@ -428,142 +459,152 @@ rct(5,k) * xnew(O3 ) * xnew(NO ) & + rct(9,k) * xnew(NO ) * xnew(NO3 ) & + rct(9,k) * xnew(NO ) * xnew(NO3 ) & - + rct(10,k) * xnew(NO ) * xnew(HO2 ) & - + rct(11,k) * xnew(NO2 ) * xnew(NO3 ) & - + rct(18,k) * xnew(OH ) * xnew(HONO ) & - + rct(21,k) * xnew(CH3O2 ) * xnew(NO ) & - + rct(30,k) * xnew(C2H5O2 ) * xnew(NO ) & - + rct(34,k) * xnew(CH3COO2 ) * xnew(NO ) & - + rct(40,k) * xnew(NO ) * xnew(SECC4H9O2 ) & - + rct(40,k) * xnew(MEKO2 ) * xnew(NO ) & - + rct(40,k) * xnew(ETRO2 ) * xnew(NO ) & - + rct(40,k) * xnew(NO ) * xnew(PRRO2 ) & - + rct(40,k) * xnew(OXYO2 ) * xnew(NO ) & - + rct(40,k) * xnew(MALO2 ) * xnew(NO ) & - + 0.86*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.95*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.95*rct(55,k) * xnew(MACRO2 ) * xnew(NO ) & - + 2.5e-12 * xnew(MACRO2 ) * xnew(NO3 ) & - + rct(57,k) * xnew(MACO3 ) * xnew(NO ) & - + 1.9*rct(40,k) * xnew(ISNIR ) * xnew(NO ) & - + 1.1*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) & - + 2.9e-11 * xnew(MPAN ) * xnew(OH ) & - + rct(62,k) * xnew(OP ) * xnew(NO ) & - + rct(64,k) * xnew(N2O5 ) & - + rct(67,k) * xnew(PAN ) & - + rct(67,k) * xnew(MPAN ) & + + rct(10,k) * xnew(NO ) * xnew(NO ) & + + rct(10,k) * xnew(NO ) * xnew(NO ) & + + rct(11,k) * xnew(NO ) * xnew(HO2 ) & + + rct(12,k) * xnew(NO2 ) * xnew(NO3 ) & + + 2.0e-11 * xnew(OH ) * xnew(NO3 ) & + + rct(18,k) * xnew(HO2NO2 ) & + + rct(19,k) * xnew(OH ) * xnew(HO2NO2 ) & + + 4.0e-12 * xnew(HO2 ) * xnew(NO3 ) & + + rct(22,k) * xnew(OH ) * xnew(HONO ) & + + rct(25,k) * xnew(CH3O2 ) * xnew(NO ) & + + 1.2e-12 * xnew(CH3O2 ) * xnew(NO3 ) & + + rct(34,k) * xnew(C2H5O2 ) * xnew(NO ) & + + rct(38,k) * xnew(CH3COO2 ) * xnew(NO ) & + + rct(44,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + + rct(44,k) * xnew(MEKO2 ) * xnew(NO ) & + + rct(44,k) * xnew(ETRO2 ) * xnew(NO ) & + + rct(44,k) * xnew(NO ) * xnew(PRRO2 ) & + + rct(44,k) * xnew(OXYO2 ) * xnew(NO ) & + + rct(44,k) * xnew(MALO2 ) * xnew(NO ) & + + rct(57,k) * xnew(NO ) * xnew(ISO2 ) & + + 0.22*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 3.036e-17 * xnew(O3 ) * xnew(ISON ) & + + 2.0*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 2.90e-11 * xnew(OH ) * xnew(MPAN ) & + + 1.55e-12 * xnew(OH ) * xnew(NALD ) & + + 0.64*rcphot(IDCH3O2H,K) * xnew(ISON ) & + + rcphot(IDCH3CHO,K) * xnew(NALD ) & + + rct(66,k) * xnew(MPAN ) & + + rct(71,k) * xnew(OP ) * xnew(NO ) & + + rct(73,k) * xnew(N2O5 ) & + + rct(66,k) * xnew(PAN ) & + rcphot(IDHNO3,K) * xnew(HNO3 ) & + + 0.667*rcphot(IDHO2NO2,K) * xnew(HO2NO2 ) & + rcphot(IDNO3,K) * xnew(NO3 ) & - + rcemis(NO2,k) + + rcemis(NO2,k) & + + rct(44,k) * xnew(TERPO2 ) * xnew(NO ) L = & rct(6,k)* xnew(O3 ) & - + rct(11,k)* xnew(NO3 ) & - + rct(63,k)* xnew(NO3 ) & - + rct(65,k)* xnew(OH ) & - + rct(66,k)* xnew(CH3COO2 ) & - + rct(66,k)* xnew(MACO3 ) & - + rcphot(IDNO2,K) + + rct(12,k)* xnew(NO3 ) & + + rct(17,k)* xnew(HO2 ) & + + rct(65,k)* xnew(MACRO2 ) & + + rct(72,k)* xnew(NO3 ) & + + rct(74,k)* xnew(OH ) & + + rct(75,k)* xnew(CH3COO2 ) & + + rcphot(IDNO2,K) & + + rct(80,k) xnew(NO2)= ( xold(NO2) + dt2 * P) /(1.0 + dt2*L ) -!-> SHIPNOX +!-> HO2NO2 P = & - rcemis(SHIPNOX,k) + rct(17,k) * xnew(HO2 ) * xnew(NO2 ) L = & - rct(65,k)* xnew(OH ) & - + 3.2e-5 + rct(18,k) & + + rct(19,k)* xnew(OH ) & + + rcphot(IDHO2NO2,K) - xnew(SHIPNOX)= ( xold(SHIPNOX) + dt2 * P) /(1.0 + dt2*L ) + xnew(HO2NO2)= ( xold(HO2NO2) + dt2 * P) /(1.0 + dt2*L ) -!-> PAN +!-> SHIPNOX P = & - rct(66,k) * xnew(CH3COO2 ) * xnew(NO2 ) + rcemis(SHIPNOX,k) L = & - rct(67,k) + rct(74,k)* xnew(OH ) & + + 3.2e-5 - xnew(PAN)= ( xold(PAN) + dt2 * P) /(1.0 + dt2*L ) + xnew(SHIPNOX)= ( xold(SHIPNOX) + dt2 * P) /(1.0 + dt2*L ) -!-> MPAN +!-> PAN P = & - rct(66,k) * xnew(MACO3 ) * xnew(NO2 ) + rct(75,k) * xnew(CH3COO2 ) * xnew(NO2 ) L = & - 2.9e-11* xnew(OH ) & - + rct(67,k) + rct(66,k) - xnew(MPAN)= ( xold(MPAN) + dt2 * P) /(1.0 + dt2*L ) + xnew(PAN)= ( xold(PAN) + dt2 * P) /(1.0 + dt2*L ) !-> NO3 P = & rct(6,k) * xnew(O3 ) * xnew(NO2 ) & - + rct(15,k) * xnew(OH ) * xnew(HNO3 ) & - + rct(64,k) * xnew(N2O5 ) + + rct(16,k) * xnew(OH ) * xnew(HNO3 ) & + + rct(73,k) * xnew(N2O5 ) & + + 0.333*rcphot(IDHO2NO2,K) * xnew(HO2NO2 ) L = & rct(9,k)* xnew(NO ) & - + rct(11,k)* xnew(NO2 ) & - + rct(28,k)* xnew(HCHO ) & - + 2.5e-12* xnew(MACRO2 ) & - + rct(59,k)* xnew(C5H8 ) & - + rct(63,k)* xnew(NO2 ) & - + rcphot(IDNO3,K) + + rct(12,k)* xnew(NO2 ) & + + 2.0e-11* xnew(OH ) & + + 4.0e-12* xnew(HO2 ) & + + rct(32,k)* xnew(HCHO ) & + + 1.2e-12* xnew(CH3O2 ) & + + rct(56,k)* xnew(C5H8 ) & + + rct(72,k)* xnew(NO2 ) & + + rcphot(IDNO3,K) & + + rct(79,k) & + + rct(95,k)* xnew(APINENE ) & + + 2.51e-12* xnew(BPINENE ) & + + rct(96,k)* xnew(XTERP ) xnew(NO3)= ( xold(NO3) + dt2 * P) /(1.0 + dt2*L ) !-> N2O5 P = & - rct(63,k) * xnew(NO2 ) * xnew(NO3 ) + rct(72,k) * xnew(NO2 ) * xnew(NO3 ) L = & - rct(61,k) & - + rct(64,k) + rct(70,k) & + + rct(73,k) xnew(N2O5)= ( xold(N2O5) + dt2 * P) /(1.0 + dt2*L ) -!-> ISONO3 - - P = & - rct(59,k) * xnew(C5H8 ) * xnew(NO3 ) & - + 2.0e-11 * xnew(ISONO3H ) * xnew(OH ) - - L = & - rct(40,k)* xnew(NO ) & - + rct(47,k)* xnew(HO2 ) - - xnew(ISONO3)= ( xold(ISONO3) + dt2 * P) /(1.0 + dt2*L ) - !-> HNO3 P = & - rct(28,k) * xnew(NO3 ) * xnew(HCHO ) & - + 2*rct(61,k) * xnew(N2O5 ) & - + rct(65,k) * xnew(NO2 ) * xnew(OH ) & - + rct(65,k) * xnew(SHIPNOX ) * xnew(OH ) & - + 3.2e-5 * xnew(SHIPNOX ) + rct(32,k) * xnew(NO3 ) * xnew(HCHO ) & + + 2*rct(70,k) * xnew(N2O5 ) & + + rct(74,k) * xnew(NO2 ) * xnew(OH ) & + + rct(74,k) * xnew(SHIPNOX ) * xnew(OH ) & + + 3.2e-5 * xnew(SHIPNOX ) & + + rct(79,k) * xnew(NO3 ) & + + 0.5*rct(80,k) * xnew(NO2 ) L = & - rct(15,k)* xnew(OH ) & + rct(16,k)* xnew(OH ) & + rcphot(IDHNO3,K) & - + rct(71,k) & - + rct(72,k) + + rct(81,k) & + + rct(82,k) xnew(HNO3)= ( xold(HNO3) + dt2 * P) /(1.0 + dt2*L ) !-> HONO P = & - rct(70,k) * xnew(OH ) * xnew(NO ) + rct(78,k) * xnew(OH ) * xnew(NO ) & + + 0.5*rct(80,k) * xnew(NO2 ) L = & - rct(18,k)* xnew(OH ) & + rct(22,k)* xnew(OH ) & + 0.222*rcphot(IDNO2,K) xnew(HONO)= ( xold(HONO) + dt2 * P) /(1.0 + dt2*L ) @@ -571,77 +612,42 @@ !-> CH3COO2 P = & - 0.95*rct(33,k) * xnew(OH ) * xnew(CH3CHO ) & - + rct(32,k) * xnew(CH3COO2H ) * xnew(OH ) & - + rct(40,k) * xnew(MEKO2 ) * xnew(NO ) & - + rct(49,k) * xnew(OH ) * xnew(MGLYOX ) & - + 0.684*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.41*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + rct(57,k) * xnew(MACO3 ) * xnew(NO ) & - + 1.51e-11 * xnew(MACO2H ) * xnew(OH ) & - + rct(67,k) * xnew(PAN ) & + 0.95*rct(37,k) * xnew(OH ) * xnew(CH3CHO ) & + + rct(36,k) * xnew(CH3COO2H ) * xnew(OH ) & + + rct(44,k) * xnew(MEKO2 ) * xnew(NO ) & + + rct(53,k) * xnew(OH ) * xnew(MGLYOX ) & + + 0.3*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 0.2*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 0.2*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + 0.5*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 0.25*1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + rcphot(IDACH2O,K) * xnew(MACR ) & + + rcphot(IDCH3COX,K) * xnew(HACET ) & + + rct(66,k) * xnew(PAN ) & + rcphot(IDRCOHCO,K) * xnew(MGLYOX ) & + rcphot(IDCH3O2H,K) * xnew(MEKO2H ) & - + rcphot(IDCH3COX,K) * xnew(MEK ) + + rcphot(IDCH3COX,K) * xnew(MEK ) & + + 1.0e6 * xnew(XMTO3_RO2 ) L = & - rct(34,k)* xnew(NO ) & - + rct(35,k)* xnew(CH3O2 ) & - + rct(36,k)* xnew(CH3COO2 ) & - + rct(36,k)* xnew(CH3COO2 ) & - + rct(37,k)* xnew(HO2 ) & - + rct(66,k)* xnew(NO2 ) + rct(38,k)* xnew(NO ) & + + rct(39,k)* xnew(CH3O2 ) & + + rct(40,k)* xnew(CH3COO2 ) & + + rct(40,k)* xnew(CH3COO2 ) & + + rct(41,k)* xnew(HO2 ) & + + rct(75,k)* xnew(NO2 ) xnew(CH3COO2)= ( xold(CH3COO2) + dt2 * P) /(1.0 + dt2*L ) -!-> MACR - - P = & - 0.67*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.32*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.1*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) - - L = & - rct(53,k)* xnew(O3 ) & - + rct(54,k)* xnew(OH ) - - xnew(MACR)= ( xold(MACR) + dt2 * P) /(1.0 + dt2*L ) - -!-> ISNI - - P = & - 0.14*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.05*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.05*rct(55,k) * xnew(MACRO2 ) * xnew(NO ) & - + 0.05*rct(40,k) * xnew(ISNIR ) * xnew(NO ) & - + 0.85*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) - - L = & - 5.96e-11* xnew(OH ) - - xnew(ISNI)= ( xold(ISNI) + dt2 * P) /(1.0 + dt2*L ) - -!-> ISNIR - - P = & - 5.96e-11 * xnew(ISNI ) * xnew(OH ) & - + 3.7e-11 * xnew(ISNIRH ) * xnew(OH ) - - L = & - rct(40,k)* xnew(NO ) & - + rct(47,k)* xnew(HO2 ) - - xnew(ISNIR)= ( xold(ISNIR) + dt2 * P) /(1.0 + dt2*L ) - !-> GLYOX P = & - rct(40,k) * xnew(MALO2 ) * xnew(NO ) & + rct(44,k) * xnew(MALO2 ) * xnew(NO ) & + rcphot(IDCH3O2H,K) * xnew(MALO2H ) & + rcemis(GLYOX,k) L = & - rct(48,k)* xnew(OH ) & + rct(52,k)* xnew(OH ) & + rcphot(IDHCOHCO,K) xnew(GLYOX)= ( xold(GLYOX) + dt2 * P) /(1.0 + dt2*L ) @@ -649,18 +655,24 @@ !-> MGLYOX P = & - rct(40,k) * xnew(OXYO2 ) * xnew(NO ) & - + rct(40,k) * xnew(MALO2 ) * xnew(NO ) & - + 0.266*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.59*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + rct(56,k) * xnew(ACETOL ) * xnew(OH ) & - + 0.82*rct(58,k) * xnew(MVK ) * xnew(O3 ) & + rct(44,k) * xnew(OXYO2 ) * xnew(NO ) & + + rct(44,k) * xnew(MALO2 ) * xnew(NO ) & + + 1.8*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 1.8*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 2.0*1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + rct(64,k) * xnew(OH ) * xnew(HACET ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + 7.61e-11 * xnew(OH ) * xnew(HPALD ) & + + rct(69,k) * xnew(PACALD ) & + + 0.5*1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) & + rcphot(IDCH3O2H,K) * xnew(OXYO2H ) & + rcphot(IDCH3O2H,K) * xnew(MALO2H ) & + rcemis(MGLYOX,k) L = & - rct(49,k)* xnew(OH ) & + rct(53,k)* xnew(OH ) & + rcphot(IDRCOHCO,K) xnew(MGLYOX)= ( xold(MGLYOX) + dt2 * P) /(1.0 + dt2*L ) @@ -668,7 +680,7 @@ !-> MAL P = & - rct(40,k) * xnew(OXYO2 ) * xnew(NO ) & + rct(44,k) * xnew(OXYO2 ) * xnew(NO ) & + rcphot(IDCH3O2H,K) * xnew(OXYO2H ) L = & @@ -679,62 +691,61 @@ !-> MEK P = & - 0.65*rct(40,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + 0.65*rct(44,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + 2.15e-11 * xnew(BURO2H ) * xnew(OH ) & + 0.65*rcphot(IDCH3O2H,K) * xnew(BURO2H ) & + rcemis(MEK,k) L = & - rct(42,k)* xnew(OH ) & + rct(46,k)* xnew(OH ) & + rcphot(IDCH3COX,K) xnew(MEK)= ( xold(MEK) + dt2 * P) /(1.0 + dt2*L ) -!-> MVK - - P = & - 0.26*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.42*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.05*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) - - L = & - rct(52,k)* xnew(OH ) & - + rct(58,k)* xnew(O3 ) - - xnew(MVK)= ( xold(MVK) + dt2 * P) /(1.0 + dt2*L ) - !-> HCHO P = & - rct(21,k) * xnew(CH3O2 ) * xnew(NO ) & - + 2.*rct(22,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & - + rct(23,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & - + rct(24,k) * xnew(OH ) * xnew(CH3OH ) & - + 0.1*rct(25,k) * xnew(HO2 ) * xnew(CH3O2 ) & - + 0.4*rct(26,k) * xnew(CH3O2H ) * xnew(OH ) & - + rct(35,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & - + 2.*rct(40,k) * xnew(ETRO2 ) * xnew(NO ) & - + 1.14*rct(43,k) * xnew(C2H4 ) * xnew(O3 ) & - + 0.545*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & - + rct(40,k) * xnew(NO ) * xnew(PRRO2 ) & - + 0.8*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.74*rct(40,k) * xnew(ISRO2 ) * xnew(NO ) & - + 0.266*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.534*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + 2.5e-12 * xnew(MACRO2 ) * xnew(NO3 ) & - + rct(57,k) * xnew(MACO3 ) * xnew(NO ) & - + 0.8*rct(58,k) * xnew(MVK ) * xnew(O3 ) & - + 0.15*rct(40,k) * xnew(ISONO3 ) * xnew(NO ) & - + 1.51e-11 * xnew(MACO2H ) * xnew(OH ) & + rct(25,k) * xnew(CH3O2 ) * xnew(NO ) & + + 2.*rct(26,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & + + rct(27,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & + + rct(28,k) * xnew(OH ) * xnew(CH3OH ) & + + 0.1*rct(29,k) * xnew(HO2 ) * xnew(CH3O2 ) & + + 0.4*rct(30,k) * xnew(CH3O2H ) * xnew(OH ) & + + 1.2e-12 * xnew(CH3O2 ) * xnew(NO3 ) & + + rct(39,k) * xnew(CH3O2 ) * xnew(CH3COO2 ) & + + 2.*rct(44,k) * xnew(ETRO2 ) * xnew(NO ) & + + 1.14*rct(47,k) * xnew(C2H4 ) * xnew(O3 ) & + + 0.545*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + rct(44,k) * xnew(NO ) * xnew(PRRO2 ) & + + 1.740*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + rct(57,k) * xnew(NO ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 0.22*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 3.036e-17 * xnew(O3 ) * xnew(ISON ) & + + 1.5*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 2.75*1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + 1.55e-12 * xnew(OH ) * xnew(NALD ) & + + rcphot(IDCH3O2H,K) * xnew(ISOOH ) & + + 0.64*rcphot(IDCH3O2H,K) * xnew(ISON ) & + + rcphot(IDACH2O,K) * xnew(MACR ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + rcphot(IDCH3COX,K) * xnew(HACET ) & + + rcphot(IDCH3CHO,K) * xnew(NALD ) & + + rct(68,k) * xnew(ISO2 ) & + + 7.61e-11 * xnew(OH ) * xnew(HPALD ) & + + 2.5*1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) & + rcphot(IDCH3O2H,K) * xnew(CH3O2H ) & + 0.1*rcphot(IDHCOHCO,K) * xnew(GLYOX ) & + 1.56*rcphot(IDCH3O2H,K) * xnew(ETRO2H ) & + rcphot(IDCH3O2H,K) * xnew(PRRO2H ) & - + rcemis(HCHO,k) + + rcemis(HCHO,k) & + + 0.58*1.0e6 * xnew(XMTO3_RO2 ) L = & - rct(27,k)* xnew(OH ) & - + rct(28,k)* xnew(NO3 ) & + rct(31,k)* xnew(OH ) & + + rct(32,k)* xnew(NO3 ) & + rcphot(IDACH2O,K) & + rcphot(IDBCH2O,K) @@ -743,17 +754,14 @@ !-> CH3CHO P = & - rct(30,k) * xnew(C2H5O2 ) * xnew(NO ) & + rct(34,k) * xnew(C2H5O2 ) * xnew(NO ) & + 8.01e-12 * xnew(C2H5OOH ) * xnew(OH ) & - + rct(38,k) * xnew(OH ) * xnew(C2H5OH ) & - + 0.35*rct(40,k) * xnew(NO ) * xnew(SECC4H9O2 ) & - + rct(40,k) * xnew(MEKO2 ) * xnew(NO ) & + + rct(42,k) * xnew(OH ) * xnew(C2H5OH ) & + + 0.35*rct(44,k) * xnew(NO ) * xnew(SECC4H9O2 ) & + + rct(44,k) * xnew(MEKO2 ) * xnew(NO ) & + 1.38e-11 * xnew(ETRO2H ) * xnew(OH ) & - + 0.545*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & - + rct(40,k) * xnew(NO ) * xnew(PRRO2 ) & - + 0.684*rct(40,k) * xnew(MVKO2 ) * xnew(NO ) & - + 0.04*rct(58,k) * xnew(MVK ) * xnew(O3 ) & - + 0.95*rct(40,k) * xnew(ISNIR ) * xnew(NO ) & + + 0.545*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + rct(44,k) * xnew(NO ) * xnew(PRRO2 ) & + rcphot(IDCH3O2H,K) * xnew(C2H5OOH ) & + 0.22*rcphot(IDCH3O2H,K) * xnew(ETRO2H ) & + 0.35*rcphot(IDCH3O2H,K) * xnew(BURO2H ) & @@ -762,7 +770,7 @@ + rcemis(CH3CHO,k) L = & - rct(33,k)* xnew(OH ) & + rct(37,k)* xnew(OH ) & + rcphot(IDCH3CHO,K) xnew(CH3CHO)= ( xold(CH3CHO) + dt2 * P) /(1.0 + dt2*L ) @@ -773,7 +781,7 @@ rcemis(C2H6,k) L = & - rct(29,k)* xnew(OH ) + rct(33,k)* xnew(OH ) xnew(C2H6)= ( xold(C2H6) + dt2 * P) /(1.0 + dt2*L ) @@ -783,7 +791,7 @@ rcemis(NC4H10,k) L = & - rct(39,k)* xnew(OH ) + rct(43,k)* xnew(OH ) xnew(NC4H10)= ( xold(NC4H10) + dt2 * P) /(1.0 + dt2*L ) @@ -793,20 +801,19 @@ rcemis(C2H4,k) L = & - rct(43,k)* xnew(O3 ) & - + rct(68,k)* xnew(OH ) + rct(47,k)* xnew(O3 ) & + + rct(76,k)* xnew(OH ) xnew(C2H4)= ( xold(C2H4) + dt2 * P) /(1.0 + dt2*L ) !-> C3H6 P = & - 0.07*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + rcemis(C3H6,k) + rcemis(C3H6,k) L = & - rct(44,k)* xnew(O3 ) & - + rct(69,k)* xnew(OH ) + rct(48,k)* xnew(O3 ) & + + rct(77,k)* xnew(OH ) xnew(C3H6)= ( xold(C3H6) + dt2 * P) /(1.0 + dt2*L ) @@ -827,31 +834,64 @@ + 0 !Skip bio rate since rcemis exists L = & - rct(50,k)* xnew(O3 ) & - + rct(51,k)* xnew(OH ) & - + rct(59,k)* xnew(NO3 ) + rct(54,k)* xnew(OH ) & + + rct(55,k)* xnew(O3 ) & + + rct(55,k)* xnew(O3 ) & + + rct(55,k)* xnew(O3 ) & + + rct(56,k)* xnew(NO3 ) xnew(C5H8)= ( xold(C5H8) + dt2 * P) /(1.0 + dt2*L ) !-> APINENE P = & - rcemis(APINENE,k) + 0.45*rcemis(BIOTERP,k) L = & - rct(76,k)*xnew(O3) & - + rct(77,k)*xnew(OH) & - + rct(78,k)*xnew(NO3) + rct(87,k)* xnew(OH ) & + + rct(92,k)* xnew(O3 ) & + + rct(95,k)* xnew(NO3 ) xnew(APINENE)= ( xold(APINENE) + dt2 * P) /(1.0 + dt2*L ) +!-> BPINENE + + P = & + 0.2*rcemis(BIOTERP,k) + + L = & + rct(88,k)* xnew(OH ) & + + rct(93,k)* xnew(O3 ) & + + 2.51e-12* xnew(NO3 ) + + xnew(BPINENE)= ( xold(BPINENE) + dt2 * P) /(1.0 + dt2*L ) + +!-> XTERP + + P = & + 0.35*rcemis(BIOTERP,k) + + L = & + rct(89,k)* xnew(OH ) & + + rct(94,k)* xnew(O3 ) & + + rct(96,k)* xnew(NO3 ) + + xnew(XTERP)= ( xold(XTERP) + dt2 * P) /(1.0 + dt2*L ) + +!-> BIOTERP + ! P = 0.0 + + ! L = 0.0 + +!Nothing to do for BIOTERP! xnew(BIOTERP)= max(0.0, xold(BIOTERP)) + !-> CH3O2H P = & - 0.9*rct(25,k) * xnew(HO2 ) * xnew(CH3O2 ) + 0.9*rct(29,k) * xnew(HO2 ) * xnew(CH3O2 ) L = & - rct(26,k)* xnew(OH ) & + rct(30,k)* xnew(OH ) & + 1.0e-5 & + rcphot(IDCH3O2H,K) @@ -860,11 +900,11 @@ !-> C2H5OOH P = & - rct(31,k) * xnew(C2H5O2 ) * xnew(HO2 ) + rct(35,k) * xnew(C2H5O2 ) * xnew(HO2 ) L = & 8.01e-12* xnew(OH ) & - + rct(32,k)* xnew(OH ) & + + rct(36,k)* xnew(OH ) & + rcphot(IDCH3O2H,K) xnew(C2H5OOH)= ( xold(C2H5OOH) + dt2 * P) /(1.0 + dt2*L ) @@ -872,10 +912,10 @@ !-> BURO2H P = & - 0.95*rct(41,k) * xnew(SECC4H9O2 ) * xnew(HO2 ) + rct(45,k) * xnew(SECC4H9O2 ) * xnew(HO2 ) L = & - rct(32,k)* xnew(OH ) & + rct(36,k)* xnew(OH ) & + 2.15e-11* xnew(OH ) & + rcphot(IDCH3O2H,K) @@ -888,7 +928,7 @@ L = & 1.38e-11* xnew(OH ) & - + rct(32,k)* xnew(OH ) & + + rct(36,k)* xnew(OH ) & + rcphot(IDCH3O2H,K) xnew(ETRO2H)= ( xold(ETRO2H) + dt2 * P) /(1.0 + dt2*L ) @@ -896,11 +936,11 @@ !-> PRRO2H P = & - 0.795*rct(45,k) * xnew(PRRO2 ) * xnew(HO2 ) + rct(49,k) * xnew(PRRO2 ) * xnew(HO2 ) L = & 2.44e-11* xnew(OH ) & - + rct(32,k)* xnew(OH ) & + + rct(36,k)* xnew(OH ) & + rcphot(IDCH3O2H,K) xnew(PRRO2H)= ( xold(PRRO2H) + dt2 * P) /(1.0 + dt2*L ) @@ -908,7 +948,7 @@ !-> OXYO2H P = & - 0.33*rct(46,k) * xnew(OXYO2 ) * xnew(HO2 ) + 0.96*rct(50,k) * xnew(OXYO2 ) * xnew(HO2 ) L = & 4.2e-11* xnew(OH ) & @@ -919,10 +959,10 @@ !-> MEKO2H P = & - rct(41,k) * xnew(MEKO2 ) * xnew(HO2 ) + rct(45,k) * xnew(MEKO2 ) * xnew(HO2 ) L = & - rct(32,k)* xnew(OH ) & + rct(36,k)* xnew(OH ) & + rcphot(IDCH3O2H,K) xnew(MEKO2H)= ( xold(MEKO2H) + dt2 * P) /(1.0 + dt2*L ) @@ -930,205 +970,352 @@ !-> MALO2H P = & - rct(47,k) * xnew(MALO2 ) * xnew(HO2 ) + rct(51,k) * xnew(MALO2 ) * xnew(HO2 ) L = & - rct(32,k)* xnew(OH ) & + rct(36,k)* xnew(OH ) & + rcphot(IDCH3O2H,K) xnew(MALO2H)= ( xold(MALO2H) + dt2 * P) /(1.0 + dt2*L ) -!-> MVKO2H +!-> H2O2 P = & - rct(41,k) * xnew(MVKO2 ) * xnew(HO2 ) + rct(20,k) * xnew(HO2 ) * xnew(HO2 ) & + + rct(21,k) * xnew(HO2 ) * xnew(HO2 ) & + + 0.14*rct(47,k) * xnew(C2H4 ) * xnew(O3 ) & + + 0.09*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + 0.27*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 0.5*rct(83,k) * xnew(HO2 ) & + + 0.09*1.0e6 * xnew(XMTO3_RO2 ) L = & - 2.2e-11* xnew(OH ) + rct(14,k)* xnew(OH ) & + + AQRCK(ICLRC1,K)* xnew(SO2 ) & + + 1.0e-5 & + + rcphot(IDH2O2,K) - xnew(MVKO2H)= ( xold(MVKO2H) + dt2 * P) /(1.0 + dt2*L ) + xnew(H2O2)= ( xold(H2O2) + dt2 * P) /(1.0 + dt2*L ) -!-> MACROOH +!-> CH3COO2H P = & - rct(41,k) * xnew(MACRO2 ) * xnew(HO2 ) + 0.41*rct(41,k) * xnew(CH3COO2 ) * xnew(HO2 ) L = & - 2.82e-11* xnew(OH ) + rct(36,k)* xnew(OH ) & + + rcphot(IDCH3O2H,K) - xnew(MACROOH)= ( xold(MACROOH) + dt2 * P) /(1.0 + dt2*L ) + xnew(CH3COO2H)= ( xold(CH3COO2H) + dt2 * P) /(1.0 + dt2*L ) + +!-> CH3OH -!-> MACO3H + P = & + rct(27,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & + + 0.5*1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) & + + rcemis(CH3OH,k) + + L = & + rct(28,k)* xnew(OH ) + + xnew(CH3OH)= ( xold(CH3OH) + dt2 * P) /(1.0 + dt2*L ) + +!-> C2H5OH P = & - 0.71*rct(60,k) * xnew(MACO3 ) * xnew(HO2 ) + rcemis(C2H5OH,k) L = & - 1.87e-11* xnew(OH ) + rct(42,k)* xnew(OH ) - xnew(MACO3H)= ( xold(MACO3H) + dt2 * P) /(1.0 + dt2*L ) + xnew(C2H5OH)= ( xold(C2H5OH) + dt2 * P) /(1.0 + dt2*L ) -!-> MACO2H +!-> ACETOL P = & - 0.29*rct(60,k) * xnew(MACO3 ) * xnew(HO2 ) + 2.44e-11 * xnew(PRRO2H ) * xnew(OH ) + ! L = 0.0 + + + xnew(ACETOL)= xold(ACETOL) + dt2 * P + +!-> H2 + + P = & + rcphot(IDBCH2O,K) * xnew(HCHO ) L = & - 1.51e-11* xnew(OH ) + rct(15,k)* xnew(OH ) - xnew(MACO2H)= ( xold(MACO2H) + dt2 * P) /(1.0 + dt2*L ) + xnew(H2)= ( xold(H2) + dt2 * P) /(1.0 + dt2*L ) -!-> ISRO2H +!-> CO P = & - 0.97*rct(47,k) * xnew(ISRO2 ) * xnew(HO2 ) + rct(31,k) * xnew(OH ) * xnew(HCHO ) & + + rct(32,k) * xnew(NO3 ) * xnew(HCHO ) & + + 0.05*rct(37,k) * xnew(OH ) * xnew(CH3CHO ) & + + 0.63*rct(47,k) * xnew(C2H4 ) * xnew(O3 ) & + + 0.56*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) & + + rct(52,k) * xnew(OH ) * xnew(GLYOX ) & + + rct(52,k) * xnew(OH ) * xnew(GLYOX ) & + + rct(53,k) * xnew(OH ) * xnew(MGLYOX ) & + + 0.42*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 0.44*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 0.44*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + 0.5*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 0.25*1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + 3.00e-11 * xnew(OH ) * xnew(MACROOH ) & + + 1.55e-12 * xnew(OH ) * xnew(NALD ) & + + rcphot(IDACH2O,K) * xnew(MACR ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + rcphot(IDCH3CHO,K) * xnew(NALD ) & + + 7.61e-11 * xnew(OH ) * xnew(HPALD ) & + + rct(69,k) * xnew(PACALD ) & + + rcphot(IDACH2O,K) * xnew(HCHO ) & + + rcphot(IDBCH2O,K) * xnew(HCHO ) & + + rcphot(IDCH3CHO,K) * xnew(CH3CHO ) & + + 1.9*rcphot(IDHCOHCO,K) * xnew(GLYOX ) & + + rcphot(IDRCOHCO,K) * xnew(MGLYOX ) & + + rcemis(CO,k) & + + 0.14*1.0e6 * xnew(XMTO3_RO2 ) L = & - 7.5e-11* xnew(OH ) + rct(24,k)* xnew(OH ) - xnew(ISRO2H)= ( xold(ISRO2H) + dt2 * P) /(1.0 + dt2*L ) + xnew(CO)= ( xold(CO) + dt2 * P) /(1.0 + dt2*L ) -!-> H2O2 +!-> CH4 P = & - rct(16,k) * xnew(HO2 ) * xnew(HO2 ) & - + rct(17,k) * xnew(HO2 ) * xnew(HO2 ) & - + 0.14*rct(43,k) * xnew(C2H4 ) * xnew(O3 ) & - + 0.09*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & - + 0.124*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + 0.5*rct(73,k) * xnew(HO2 ) + 0.1*rct(48,k) * xnew(O3 ) * xnew(C3H6 ) L = & - rct(13,k)* xnew(OH ) & - + AQRCK(ICLRC1,K)* xnew(SO2 ) & - + 1.0e-5 & - + rcphot(IDH2O2,K) + rct(23,k)* xnew(OH ) - xnew(H2O2)= ( xold(H2O2) + dt2 * P) /(1.0 + dt2*L ) + xnew(CH4)= ( xold(CH4) + dt2 * P) /(1.0 + dt2*L ) -!-> CH3COO2H +!-> SO2 P = & - 0.41*rct(37,k) * xnew(CH3COO2 ) * xnew(HO2 ) + rcemis(SO2,k) L = & - rct(32,k)* xnew(OH ) & - + rcphot(IDCH3O2H,K) + 2e-12*AQRCK(ICLOHSO2,K)* xnew(OH ) & + + AQRCK(ICLRC1,K)* xnew(H2O2 ) & + + AQRCK(ICLRC2,K)* xnew(O3 ) & + + AQRCK(ICLRC3,K) - xnew(CH3COO2H)= ( xold(CH3COO2H) + dt2 * P) /(1.0 + dt2*L ) + xnew(SO2)= ( xold(SO2) + dt2 * P) /(1.0 + dt2*L ) -!-> ISONO3H +!-> ISO2 P = & - rct(47,k) * xnew(ISONO3 ) * xnew(HO2 ) + rct(54,k) * xnew(OH ) * xnew(C5H8 ) L = & - 2.0e-11* xnew(OH ) + rct(57,k)* xnew(NO ) & + + rct(58,k)* xnew(NO ) & + + rct(51,k)* xnew(HO2 ) & + + 2.00e-12* xnew(ISO2 ) & + + 2.00e-12* xnew(ISO2 ) & + + rct(67,k) & + + rct(68,k) & + + 1.0e-12* xnew(CH3O2 ) & + + 1.0e-12* xnew(CH3O2 ) - xnew(ISONO3H)= ( xold(ISONO3H) + dt2 * P) /(1.0 + dt2*L ) + xnew(ISO2)= ( xold(ISO2) + dt2 * P) /(1.0 + dt2*L ) -!-> ISNIRH +!-> MACRO2 P = & - rct(47,k) * xnew(ISNIR ) * xnew(HO2 ) + 0.3*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 9.13e-12 * xnew(OH ) * xnew(IEPOX ) & + + rct(59,k) * xnew(OH ) * xnew(MACR ) & + + rct(60,k) * xnew(OH ) * xnew(MACR ) & + + rct(66,k) * xnew(MPAN ) & + + 1.0e6 * xnew(XMTO3_RO2 ) L = & - 3.7e-11* xnew(OH ) + rct(63,k)* xnew(NO ) & + + rct(63,k)* xnew(NO ) & + + rct(45,k)* xnew(HO2 ) & + + 1.00e-12* xnew(MACRO2 ) & + + 1.00e-12* xnew(MACRO2 ) & + + 1.00e-12* xnew(MACRO2 ) & + + 1.00e-12* xnew(MACRO2 ) & + + 1.0e-12* xnew(CH3O2 ) & + + 1.0e-12* xnew(CH3O2 ) & + + rct(65,k)* xnew(NO2 ) - xnew(ISNIRH)= ( xold(ISNIRH) + dt2 * P) /(1.0 + dt2*L ) + xnew(MACRO2)= ( xold(MACRO2) + dt2 * P) /(1.0 + dt2*L ) -!-> CH3OH +!-> MACR P = & - rct(23,k) * xnew(CH3O2 ) * xnew(CH3O2 ) & - + rcemis(CH3OH,k) + 1.95*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + rct(57,k) * xnew(NO ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 2.00e-12 * xnew(ISO2 ) * xnew(ISO2 ) & + + 8.94e-12 * xnew(OH ) * xnew(ISOOH ) & + + 0.22*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 3.036e-17 * xnew(O3 ) * xnew(ISON ) & + + rcphot(IDCH3O2H,K) * xnew(ISOOH ) & + + 0.64*rcphot(IDCH3O2H,K) * xnew(ISON ) & + + rct(68,k) * xnew(ISO2 ) & + + 1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) & + + rct(44,k) * xnew(TERPO2 ) * xnew(NO ) & + + 0.65*1.0e6 * xnew(XMTO3_RO2 ) + + L = & + rct(59,k)* xnew(OH ) & + + rct(60,k)* xnew(OH ) & + + rct(61,k)* xnew(O3 ) & + + rct(61,k)* xnew(O3 ) & + + rct(62,k)* xnew(O3 ) & + + rct(62,k)* xnew(O3 ) & + + rcphot(IDACH2O,K) + + xnew(MACR)= ( xold(MACR) + dt2 * P) /(1.0 + dt2*L ) + +!-> MACROOH + + P = & + rct(45,k) * xnew(HO2 ) * xnew(MACRO2 ) L = & - rct(24,k)* xnew(OH ) + 3.00e-11* xnew(OH ) & + + 0.5*rcphot(IDCH3O2H,K) & + + 0.5*rcphot(IDCH3O2H,K) - xnew(CH3OH)= ( xold(CH3OH) + dt2 * P) /(1.0 + dt2*L ) + xnew(MACROOH)= ( xold(MACROOH) + dt2 * P) /(1.0 + dt2*L ) -!-> C2H5OH +!-> IEPOX P = & - rcemis(C2H5OH,k) + 8.046e-11 * xnew(OH ) * xnew(ISOOH ) L = & - rct(38,k)* xnew(OH ) + 9.13e-12* xnew(OH ) - xnew(C2H5OH)= ( xold(C2H5OH) + dt2 * P) /(1.0 + dt2*L ) + xnew(IEPOX)= ( xold(IEPOX) + dt2 * P) /(1.0 + dt2*L ) -!-> ACETOL +!-> HACET P = & - 2.44e-11 * xnew(PRRO2H ) * xnew(OH ) & - + 0.95*rct(55,k) * xnew(MACRO2 ) * xnew(NO ) & - + 2.5e-12 * xnew(MACRO2 ) * xnew(NO3 ) & - + 0.95*rct(40,k) * xnew(ISNIR ) * xnew(NO ) & - + 2.9e-11 * xnew(MPAN ) * xnew(OH ) + 0.78*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 0.5*rct(63,k) * xnew(NO ) * xnew(MACRO2 ) & + + 2.0*1.00e-12 * xnew(MACRO2 ) * xnew(MACRO2 ) & + + 0.75*1.0e-12 * xnew(MACRO2 ) * xnew(CH3O2 ) & + + 2.90e-11 * xnew(OH ) * xnew(MPAN ) & + + 3.00e-11 * xnew(OH ) * xnew(MACROOH ) & + + 0.5*rcphot(IDCH3O2H,K) * xnew(MACROOH ) & + + 0.5*1.0e-12 * xnew(ISO2 ) * xnew(CH3O2 ) L = & - rct(56,k)* xnew(OH ) + rct(64,k)* xnew(OH ) & + + rcphot(IDCH3COX,K) - xnew(ACETOL)= ( xold(ACETOL) + dt2 * P) /(1.0 + dt2*L ) + xnew(HACET)= ( xold(HACET) + dt2 * P) /(1.0 + dt2*L ) -!-> H2 +!-> ISOOH P = & - rcphot(IDBCH2O,K) * xnew(HCHO ) + rct(51,k) * xnew(HO2 ) * xnew(ISO2 ) L = & - rct(14,k)* xnew(OH ) + 8.046e-11* xnew(OH ) & + + 8.94e-12* xnew(OH ) & + + rcphot(IDCH3O2H,K) - xnew(H2)= ( xold(H2) + dt2 * P) /(1.0 + dt2*L ) + xnew(ISOOH)= ( xold(ISOOH) + dt2 * P) /(1.0 + dt2*L ) -!-> CO +!-> ISON P = & - rct(27,k) * xnew(OH ) * xnew(HCHO ) & - + rct(28,k) * xnew(NO3 ) * xnew(HCHO ) & - + 0.05*rct(33,k) * xnew(OH ) * xnew(CH3CHO ) & - + 0.63*rct(43,k) * xnew(C2H4 ) * xnew(O3 ) & - + 0.56*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) & - + rct(48,k) * xnew(OH ) * xnew(GLYOX ) & - + rct(48,k) * xnew(OH ) * xnew(GLYOX ) & - + rct(49,k) * xnew(OH ) * xnew(MGLYOX ) & - + 0.05*rct(50,k) * xnew(C5H8 ) * xnew(O3 ) & - + 0.82*rct(53,k) * xnew(MACR ) * xnew(O3 ) & - + 0.95*rct(55,k) * xnew(MACRO2 ) * xnew(NO ) & - + 0.05*rct(58,k) * xnew(MVK ) * xnew(O3 ) & - + 2.9e-11 * xnew(MPAN ) * xnew(OH ) & - + rcphot(IDACH2O,K) * xnew(HCHO ) & - + rcphot(IDBCH2O,K) * xnew(HCHO ) & - + rcphot(IDCH3CHO,K) * xnew(CH3CHO ) & - + 1.9*rcphot(IDHCOHCO,K) * xnew(GLYOX ) & - + rcphot(IDRCOHCO,K) * xnew(MGLYOX ) & - + rcemis(CO,k) + rct(56,k) * xnew(NO3 ) * xnew(C5H8 ) & + + rct(58,k) * xnew(NO ) * xnew(ISO2 ) L = & - rct(20,k)* xnew(OH ) + 3.34e-11* xnew(OH ) & + + 6.164e-17* xnew(O3 ) & + + 3.036e-17* xnew(O3 ) & + + 0.64*rcphot(IDCH3O2H,K) - xnew(CO)= ( xold(CO) + dt2 * P) /(1.0 + dt2*L ) + xnew(ISON)= ( xold(ISON) + dt2 * P) /(1.0 + dt2*L ) -!-> CH4 +!-> HCOOH + + P = & + 0.84*rct(55,k) * xnew(O3 ) * xnew(C5H8 ) & + + 0.9*rct(61,k) * xnew(O3 ) * xnew(MACR ) & + + 0.9*rct(62,k) * xnew(O3 ) * xnew(MACR ) & + + 0.28*1.0e6 * xnew(XMTO3_RO2 ) + ! L = 0.0 + + + xnew(HCOOH)= xold(HCOOH) + dt2 * P + +!-> MPAN P = & - 0.1*rct(44,k) * xnew(O3 ) * xnew(C3H6 ) + rct(65,k) * xnew(MACRO2 ) * xnew(NO2 ) L = & - rct(19,k)* xnew(OH ) + 2.90e-11* xnew(OH ) & + + rct(66,k) - xnew(CH4)= ( xold(CH4) + dt2 * P) /(1.0 + dt2*L ) + xnew(MPAN)= ( xold(MPAN) + dt2 * P) /(1.0 + dt2*L ) -!-> SO2 +!-> NALD P = & - rcemis(SO2,k) + 0.78*3.34e-11 * xnew(OH ) * xnew(ISON ) & + + 6.164e-17 * xnew(O3 ) * xnew(ISON ) L = & - 2e-12*AQRCK(ICLOHSO2,K)* xnew(OH ) & - + AQRCK(ICLRC1,K)* xnew(H2O2 ) & - + AQRCK(ICLRC2,K)* xnew(O3 ) & - + AQRCK(ICLRC3,K) + 1.55e-12* xnew(OH ) & + + rcphot(IDCH3CHO,K) - xnew(SO2)= ( xold(SO2) + dt2 * P) /(1.0 + dt2*L ) + xnew(NALD)= ( xold(NALD) + dt2 * P) /(1.0 + dt2*L ) + +!-> HPALD + + P = & + rct(67,k) * xnew(ISO2 ) + + L = & + 0.065 & + + 7.61e-11* xnew(OH ) + + xnew(HPALD)= ( xold(HPALD) + dt2 * P) /(1.0 + dt2*L ) + +!-> PACALD + + P = & + 0.065 * xnew(HPALD ) + + L = & + rct(69,k) + + xnew(PACALD)= ( xold(PACALD) + dt2 * P) /(1.0 + dt2*L ) + +!-> MVK + + P = & + rct(44,k) * xnew(TERPO2 ) * xnew(NO ) + ! L = 0.0 + + + xnew(MVK)= xold(MVK) + dt2 * P + +!-> TERPOOH + + P = & + rct(90,k) * xnew(TERPO2 ) * xnew(HO2 ) + + L = & + rct(91,k)* xnew(OH ) + + xnew(TERPOOH)= ( xold(TERPOOH) + dt2 * P) /(1.0 + dt2*L ) diff --git a/CM_Reactions2.inc b/CM_Reactions2.inc index adabf94..229d4fc 100644 --- a/CM_Reactions2.inc +++ b/CM_Reactions2.inc @@ -31,8 +31,8 @@ !-> NO3_C P = & - rct(71,k) * xnew(HNO3 ) & - + rct(72,k) * xnew(HNO3 ) + rct(81,k) * xnew(HNO3 ) & + + rct(82,k) * xnew(HNO3 ) ! L = 0.0 @@ -50,7 +50,7 @@ L = & - rct(75,k) + rct(85,k) xnew(DUMMY)= xold(DUMMY) / ( 1.0 + dt2 * L ) @@ -105,7 +105,7 @@ rcemis(EC_F_WOOD_NEW,k) L = & - rct(96,k) + rct(114,k) xnew(EC_F_WOOD_NEW)= ( xold(EC_F_WOOD_NEW) + dt2 * P) /(1.0 + dt2*L ) @@ -113,7 +113,7 @@ P = & rcemis(EC_F_WOOD_AGE,k) & - + rct(96,k) * xnew(EC_F_WOOD_NEW ) + + rct(114,k) * xnew(EC_F_WOOD_NEW ) ! L = 0.0 @@ -132,7 +132,7 @@ rcemis(EC_F_FFUEL_NEW,k) L = & - rct(97,k) + rct(115,k) xnew(EC_F_FFUEL_NEW)= ( xold(EC_F_FFUEL_NEW) + dt2 * P) /(1.0 + dt2*L ) @@ -140,7 +140,7 @@ P = & rcemis(EC_F_FFUEL_AGE,k) & - + rct(97,k) * xnew(EC_F_FFUEL_NEW ) + + rct(115,k) * xnew(EC_F_FFUEL_NEW ) ! L = 0.0 @@ -214,10 +214,19 @@ !Nothing to do for OM25_P! xnew(OM25_P)= max(0.0, xold(OM25_P)) +!-> SQT_SOA_NV + + P = & + 0.01534*rcemis(BIOTERP,k) + ! L = 0.0 + + + xnew(SQT_SOA_NV)= xold(SQT_SOA_NV) + dt2 * P + !-> ASOC_NG100 P = & - rct(80,k)*xnew(OH) * xnew(ASOC_UG1 ) + rct(98,k)*xnew(OH) * xnew(ASOC_UG1 ) ! L = 0.0 @@ -226,65 +235,59 @@ !-> ASOC_UG1 P = & - 0.00206*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.010294*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 0.008413*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 0.315476*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + rct(81,k)*xnew(OH) * xnew(ASOC_UG10 ) + YCOXY(0) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YCALK(0) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YCOLE(0) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + rct(99,k)*xnew(OH) * xnew(ASOC_UG10 ) L = & - rct(80,k)*xnew(OH) + rct(98,k)*xnew(OH) xnew(ASOC_UG1)= ( xold(ASOC_UG1) + dt2 * P) /(1.0 + dt2*L ) !-> ASOC_UG10 P = & - 0.108*rct(40,k)*xnew(NO)*xnew(SECC4H9O2) & - + 0.2132*rct(41,k)*xnew(SECC4H9O2)*xnew(HO2) & - + 0.01029*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.018529*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 0.820238*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 1.261905*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + rct(82,k)*xnew(OH) * xnew(ASOC_UG1E2 ) + YCOXY(1) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YCALK(1) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YCOLE(1) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + rct(100,k)*xnew(OH) * xnew(ASOC_UG1E2 ) L = & - rct(81,k)*xnew(OH) + rct(99,k)*xnew(OH) xnew(ASOC_UG10)= ( xold(ASOC_UG10) + dt2 * P) /(1.0 + dt2*L ) !-> ASOC_UG1E2 P = & - 0.078235*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.123529*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 1.261905*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 1.577381*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + rct(83,k)*xnew(OH) * xnew(ASOC_UG1E3 ) + YCOXY(2) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YCALK(2) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YCOLE(2) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + rct(101,k)*xnew(OH) * xnew(ASOC_UG1E3 ) L = & - rct(82,k)*xnew(OH) + rct(100,k)*xnew(OH) xnew(ASOC_UG1E2)= ( xold(ASOC_UG1E2) + dt2 * P) /(1.0 + dt2*L ) !-> ASOC_UG1E3 P = & - 0.30882*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.463235*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 1.829762*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 2.208333*rct(46,k)*xnew(OXYO2)*xnew(HO2) + YCOXY(3) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YCALK(3) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YCOLE(3) * rct(77,k)*xnew(OH)*xnew(C3H6) L = & - rct(83,k)*xnew(OH) + rct(101,k)*xnew(OH) xnew(ASOC_UG1E3)= ( xold(ASOC_UG1E3) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_ASOA_NG100 P = & - 0.9*rct(80,k)*xnew(OH) * xnew(ASOC_UG1 ) & - + 1.075*rct(84,k)*xnew(OH) * xnew(NON_C_ASOA_UG1 ) + 0.9*rct(98,k)*xnew(OH) * xnew(ASOC_UG1 ) & + + 1.075*rct(102,k)*xnew(OH) * xnew(NON_C_ASOA_UG1 ) ! L = 0.0 @@ -293,67 +296,61 @@ !-> NON_C_ASOA_UG1 P = & - 0.0173*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.08647*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 0.11105*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 4.16429*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + 0.9*rct(81,k)*xnew(OH) * xnew(ASOC_UG10 ) & - + 1.075*rct(85,k)*xnew(OH) * xnew(NON_C_ASOA_UG10 ) + YNOXY(0) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YNALK(0) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YNOLE(0) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + 0.9*rct(99,k)*xnew(OH) * xnew(ASOC_UG10 ) & + + 1.075*rct(103,k)*xnew(OH) * xnew(NON_C_ASOA_UG10 ) L = & - rct(84,k)*xnew(OH) + rct(102,k)*xnew(OH) xnew(NON_C_ASOA_UG1)= ( xold(NON_C_ASOA_UG1) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_ASOA_UG10 P = & - 0.90753*rct(40,k)*xnew(NO)*xnew(SECC4H9O2) & - + 1.7912*rct(41,k)*xnew(SECC4H9O2)*xnew(HO2) & - + 0.08647*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 0.15565*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 10.8271*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 16.6571*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + 0.9*rct(82,k)*xnew(OH) * xnew(ASOC_UG1E2 ) & - + 1.075*rct(86,k)*xnew(OH) * xnew(NON_C_ASOA_UG1E2 ) + YNOXY(1) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YNALK(1) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YNOLE(1) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + 0.9*rct(100,k)*xnew(OH) * xnew(ASOC_UG1E2 ) & + + 1.075*rct(104,k)*xnew(OH) * xnew(NON_C_ASOA_UG1E2 ) L = & - rct(85,k)*xnew(OH) + rct(103,k)*xnew(OH) xnew(NON_C_ASOA_UG10)= ( xold(NON_C_ASOA_UG10) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_ASOA_UG1E2 P = & - 0.65718*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 1.03765*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 16.6571*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 20.82143*rct(46,k)*xnew(OXYO2)*xnew(HO2) & - + 0.9*rct(83,k)*xnew(OH) * xnew(ASOC_UG1E3 ) & - + 1.075*rct(87,k)*xnew(OH) * xnew(NON_C_ASOA_UG1E3 ) + YNOXY(2) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YNALK(2) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YNOLE(2) * rct(77,k)*xnew(OH)*xnew(C3H6) & + + 0.9*rct(101,k)*xnew(OH) * xnew(ASOC_UG1E3 ) & + + 1.075*rct(105,k)*xnew(OH) * xnew(NON_C_ASOA_UG1E3 ) L = & - rct(86,k)*xnew(OH) + rct(104,k)*xnew(OH) xnew(NON_C_ASOA_UG1E2)= ( xold(NON_C_ASOA_UG1E2) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_ASOA_UG1E3 P = & - 2.59412*rct(40,k)*xnew(NO)*xnew(PRRO2) & - + 3.89118*rct(45,k)*xnew(PRRO2)*xnew(HO2) & - + 24.15286*rct(40,k)*xnew(OXYO2)*xnew(NO) & - + 29.15*rct(46,k)*xnew(OXYO2)*xnew(HO2) + YNOXY(3) * 1.36e-11*xnew(OXYL)*xnew(OH) & + + YNALK(3) * rct(43,k)*xnew(OH)*xnew(NC4H10) & + + YNOLE(3) * rct(77,k)*xnew(OH)*xnew(C3H6) L = & - rct(87,k)*xnew(OH) + rct(105,k)*xnew(OH) xnew(NON_C_ASOA_UG1E3)= ( xold(NON_C_ASOA_UG1E3) + dt2 * P) /(1.0 + dt2*L ) !-> BSOC_NG100 P = & - rct(88,k)*xnew(OH) * xnew(BSOC_UG1 ) + rct(106,k)*xnew(OH) * xnew(BSOC_UG1 ) ! L = 0.0 @@ -362,61 +359,87 @@ !-> BSOC_UG1 P = & - 0.002833*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 0.0255*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 0.08*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 0.715333*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + rct(89,k)*xnew(OH) * xnew(BSOC_UG10 ) + YCISOP(0) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YCTERP(0) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YCTERP(0) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YCTERP(0) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YCTERP(0) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YCTERP(0) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YCTERP(0) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YCTERP(0) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YCTERP(0) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YCTERP(0) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + rct(107,k)*xnew(OH) * xnew(BSOC_UG10 ) L = & - rct(88,k)*xnew(OH) + rct(106,k)*xnew(OH) xnew(BSOC_UG1)= ( xold(BSOC_UG1) + dt2 * P) /(1.0 + dt2*L ) !-> BSOC_UG10 P = & - 0.065167*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 0.085*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 0.813333*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 0.612*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + rct(90,k)*xnew(OH) * xnew(BSOC_UG1E2 ) + YCISOP(1) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YCTERP(1) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YCTERP(1) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YCTERP(1) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YCTERP(1) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YCTERP(1) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YCTERP(1) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YCTERP(1) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YCTERP(1) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YCTERP(1) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + rct(108,k)*xnew(OH) * xnew(BSOC_UG1E2 ) L = & - rct(89,k)*xnew(OH) + rct(107,k)*xnew(OH) xnew(BSOC_UG10)= ( xold(BSOC_UG10) + dt2 * P) /(1.0 + dt2*L ) !-> BSOC_UG1E2 P = & - 0.0425*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 0.0425*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 1.34*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 2.391333*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + rct(91,k)*xnew(OH) * xnew(BSOC_UG1E3 ) + YCISOP(2) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YCTERP(2) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YCTERP(2) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YCTERP(2) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YCTERP(2) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YCTERP(2) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YCTERP(2) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YCTERP(2) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YCTERP(2) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YCTERP(2) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + rct(109,k)*xnew(OH) * xnew(BSOC_UG1E3 ) L = & - rct(90,k)*xnew(OH) + rct(108,k)*xnew(OH) xnew(BSOC_UG1E2)= ( xold(BSOC_UG1E2) + dt2 * P) /(1.0 + dt2*L ) !-> BSOC_UG1E3 P = & - 3.333333*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 4.05*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) + YCISOP(3) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YCTERP(3) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YCTERP(3) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YCTERP(3) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YCTERP(3) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YCTERP(3) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YCTERP(3) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YCTERP(3) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YCTERP(3) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YCTERP(3) * rct(96,k)*xnew(NO3)*xnew(XTERP) L = & - rct(91,k)*xnew(OH) + rct(109,k)*xnew(OH) xnew(BSOC_UG1E3)= ( xold(BSOC_UG1E3) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_BSOA_NG100 P = & - 0.9*rct(88,k)*xnew(OH) * xnew(BSOC_UG1 ) & - + 1.075*rct(92,k)*xnew(OH) * xnew(NON_C_BSOA_UG1 ) + 0.9*rct(106,k)*xnew(OH) * xnew(BSOC_UG1 ) & + + 1.075*rct(110,k)*xnew(OH) * xnew(NON_C_BSOA_UG1 ) ! L = 0.0 @@ -425,56 +448,82 @@ !-> NON_C_BSOA_UG1 P = & - 0.034*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 0.306*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 0.672*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 6.009*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + 0.9*rct(89,k)*xnew(OH) * xnew(BSOC_UG10 ) & - + 1.075*rct(93,k)*xnew(OH) * xnew(NON_C_BSOA_UG10 ) + YNISOP(0) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YNTERP(0) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YNTERP(0) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YNTERP(0) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YNTERP(0) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YNTERP(0) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YNTERP(0) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YNTERP(0) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YNTERP(0) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YNTERP(0) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + 0.9*rct(107,k)*xnew(OH) * xnew(BSOC_UG10 ) & + + 1.075*rct(111,k)*xnew(OH) * xnew(NON_C_BSOA_UG10 ) L = & - rct(92,k)*xnew(OH) + rct(110,k)*xnew(OH) xnew(NON_C_BSOA_UG1)= ( xold(NON_C_BSOA_UG1) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_BSOA_UG10 P = & - 0.782*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 1.02*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 6.832*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 5.1408*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + 0.9*rct(90,k)*xnew(OH) * xnew(BSOC_UG1E2 ) & - + 1.075*rct(94,k)*xnew(OH) * xnew(NON_C_BSOA_UG1E2 ) + YNISOP(1) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YNTERP(1) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YNTERP(1) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YNTERP(1) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YNTERP(1) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YNTERP(1) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YNTERP(1) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YNTERP(1) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YNTERP(1) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YNTERP(1) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + 0.9*rct(108,k)*xnew(OH) * xnew(BSOC_UG1E2 ) & + + 1.075*rct(112,k)*xnew(OH) * xnew(NON_C_BSOA_UG1E2 ) L = & - rct(93,k)*xnew(OH) + rct(111,k)*xnew(OH) xnew(NON_C_BSOA_UG10)= ( xold(NON_C_BSOA_UG10) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_BSOA_UG1E2 P = & - 0.51*rct(40,k)*xnew(ISRO2)*xnew(NO) & - + 0.51*rct(47,k)*xnew(ISRO2)*xnew(HO2) & - + 11.256*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 20.0872*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) & - + 0.9*rct(91,k)*xnew(OH) * xnew(BSOC_UG1E3 ) & - + 1.075*rct(95,k)*xnew(OH) * xnew(NON_C_BSOA_UG1E3 ) + YNISOP(2) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YNTERP(2) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YNTERP(2) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YNTERP(2) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YNTERP(2) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YNTERP(2) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YNTERP(2) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YNTERP(2) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YNTERP(2) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YNTERP(2) * rct(96,k)*xnew(NO3)*xnew(XTERP) & + + 0.9*rct(109,k)*xnew(OH) * xnew(BSOC_UG1E3 ) & + + 1.075*rct(113,k)*xnew(OH) * xnew(NON_C_BSOA_UG1E3 ) L = & - rct(94,k)*xnew(OH) + rct(112,k)*xnew(OH) xnew(NON_C_BSOA_UG1E2)= ( xold(NON_C_BSOA_UG1E2) + dt2 * P) /(1.0 + dt2*L ) !-> NON_C_BSOA_UG1E3 P = & - 28.*rct(40,k)*xnew(NO) * xnew(TERPPEROXY ) & - + 34.02*rct(79,k)*xnew(HO2) * xnew(TERPPEROXY ) + YNISOP(3) * rct(54,k)*xnew(OH)*xnew(C5H8) & + + YNTERP(3) * rct(87,k)*xnew(OH)*xnew(APINENE) & + + YNTERP(3) * rct(88,k)*xnew(OH)*xnew(BPINENE) & + + YNTERP(3) * rct(89,k)*xnew(OH)*xnew(XTERP) & + + YNTERP(3) * rct(92,k)*xnew(O3)*xnew(APINENE) & + + YNTERP(3) * rct(93,k)*xnew(O3)*xnew(BPINENE) & + + YNTERP(3) * rct(94,k)*xnew(O3)*xnew(XTERP) & + + YNTERP(3) * rct(97,k)*xnew(NO3)*xnew(APINENE) & + + YNTERP(3) * 2.51e-12*xnew(NO3)*xnew(BPINENE) & + + YNTERP(3) * rct(96,k)*xnew(NO3)*xnew(XTERP) L = & - rct(95,k)*xnew(OH) + rct(113,k)*xnew(OH) xnew(NON_C_BSOA_UG1E3)= ( xold(NON_C_BSOA_UG1E3) + dt2 * P) /(1.0 + dt2*L ) diff --git a/CM_WetDep.inc b/CM_WetDep.inc index d8cd9cd..04822fd 100644 --- a/CM_WetDep.inc +++ b/CM_WetDep.inc @@ -1,6 +1,7 @@ - integer, public, parameter :: NWETDEP_ADV = 55 + integer, public, parameter :: NWETDEP_ADV = 57 type(depmap), public, dimension(NWETDEP_ADV), parameter:: WDepMap= (/ & - depmap( IXADV_HNO3, CWDEP_HNO3, -1) & + depmap( IXADV_HO2NO2, CWDEP_HNO3, -1) & + , depmap( IXADV_HNO3, CWDEP_HNO3, -1) & , depmap( IXADV_HONO, CWDEP_HNO3, -1) & , depmap( IXADV_HCHO, CWDEP_HCHO, -1) & , depmap( IXADV_H2O2, CWDEP_H2O2, -1) & @@ -26,6 +27,7 @@ , depmap( IXADV_FFIRE_OM, CWDEP_PMf, -1) & , depmap( IXADV_FFIRE_BC, CWDEP_PMf, -1) & , depmap( IXADV_FFIRE_REMPPM25, CWDEP_PMf, -1) & + , depmap( IXADV_SQT_SOA_NV, CWDEP_PMf, -1) & , depmap( IXADV_ASOC_ng100, CWDEP_PMf, -1) & , depmap( IXADV_ASOC_ug1, CWDEP_PMf, -1) & , depmap( IXADV_ASOC_ug10, CWDEP_PMf, -1) & diff --git a/CellMet_ml.f90 b/CellMet_ml.f90 index 3deef7b..772039f 100644 --- a/CellMet_ml.f90 +++ b/CellMet_ml.f90 @@ -1,9 +1,8 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* !* Contact information: !* Norwegian Meteorological Institute !* Box 43 Blindern @@ -11,45 +10,43 @@ !* NORWAY !* email: emep.mscw@met.no !* http://www.emep.int -!* +!* !* This program is free software: you can redistribute it and/or modify !* it under the terms of the GNU General Public License as published by !* the Free Software Foundation, either version 3 of the License, or !* (at your option) any later version. -!* +!* !* This program is distributed in the hope that it will be useful, !* but WITHOUT ANY WARRANTY; without even the implied warranty of !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !* GNU General Public License for more details. -!* +!* !* You should have received a copy of the GNU General Public License !* along with this program. If not, see . -!*****************************************************************************! +!*****************************************************************************! module CellMet_ml !============================================================================= !+ ! Description ! Module for setting some near-surface meteorology params -! ** calls SubMet_ml ** -! for calculating sub-grid meteorology for each land-use. +! ** calls SubMet_ml ** +! for calculating sub-grid meteorology for each land-use. !============================================================================= - -use CheckStop_ml, only : CheckStop -use GridValues_ml, only : sigma_bnd,dA,dB -use Landuse_ml, only : LandCover, ice_landcover ! Provides SGS, hveg, LAI .... -use Landuse_ml, only : mainly_sea -use LocalVariables_ml, only: Grid, ResetSub -use MicroMet_ml, only : PsiH, PsiM, AerRes !functions -use MetFields_ml, only: ps, u_ref -use MetFields_ml, only: cc3dmax, sdepth,ice_nwp, surface_precip, & - fh,fl,z_mid, z_bnd, q, roa, rh2m, rho_surf, th, pzpbl, t2_nwp, ustar_nwp,& - zen, coszen, Idirect, Idiffuse -use ModelConstants_ml, only : KMAX_MID, KMAX_BND, PT, USE_ZREF -use PhysicalConstants_ml, only : PI, RGAS_KG, CP, GRAV, KARMAN, CHARNOCK, T0 -use SoilWater_ml, only : fSW -use SubMet_ml, only : Get_SubMet, Sub -use TimeDate_ml, only: current_date +use CheckStop_ml, only: CheckStop +use GridValues_ml, only: dA,dB +use Landuse_ml, only: LandCover, ice_landcover ! Provides SGS,hveg,LAI,... +use Landuse_ml, only: mainly_sea +use LocalVariables_ml,only: Grid, ResetSub +use MicroMet_ml, only: PsiH, PsiM, AerRes ! functions +use MetFields_ml, only: ps, u_ref, cc3dmax, sdepth, surface_precip, & + ice_nwp,fh, fl, z_mid, z_bnd, q, roa, rh2m, & + rho_surf, th, pzpbl, t2_nwp, ustar_nwp, zen,& + coszen, Idirect, Idiffuse +use ModelConstants_ml, only: KMAX_MID, KMAX_BND, PT, USE_ZREF +use PhysicalConstants_ml, only: PI, CP, GRAV, KARMAN +use SoilWater_ml, only: fSW +use SubMet_ml, only: Get_SubMet, Sub implicit none private @@ -64,132 +61,122 @@ module CellMet_ml contains !======================================================================= - subroutine Get_CellMet(i,j,debug_flag) - integer, intent(in) :: i,j - logical, intent(in) :: debug_flag ! set true for wanted grid square - integer :: lu, ilu, nlu - +subroutine Get_CellMet(i,j,debug_flag) + integer, intent(in) :: i,j + logical, intent(in) :: debug_flag ! set true for wanted grid square + integer :: lu, ilu, nlu !--------------------------------------------------------------- - - ! We assume that the area of grid which is wet is proportional to - ! cloud-cover. To avoid some compiler/numerical issues when - ! prec almost equal to zero, we allow a small build-up phase, with - ! linear increase from wetarea=0 to wetarea = cc3dmax for values of - ! prec between 1.0e-8 (near-zero!) to 0.01. - - if ( surface_precip(i,j) > 1.0d-2 ) then - Grid%is_wet = .true. - Grid%wetarea = cc3dmax(i,j,KMAX_MID) - else if ( surface_precip(i,j) > 1.0d-8 ) then - Grid%is_wet = .true. - Grid%wetarea = surface_precip(i,j)/1.0d-2 * cc3dmax(i,j,KMAX_MID) - else - Grid%is_wet = .false. - Grid%wetarea = 0.0 - end if - - - Grid%i = i - Grid%j = j - Grid%psurf = ps(i,j,1) ! Surface pressure, Pa - Grid%z_mid = z_mid(i,j,KMAX_MID) ! NB! Approx, updated every 3h - - ! Have option to use a different reference ht: - if ( USE_ZREF ) then - Grid%z_ref = & - min( 0.1*pzpbl(i,j), z_mid(i,j,KMAX_MID) ) ! within or top of SL - else - Grid%z_ref = z_mid(i,j,KMAX_MID) ! within or top of SL - end if - -! More exact for thickness of bottom layer, since used for emissions -! from dp = g. rho . dz and d sigma = dp/pstar -! we get dz = d sigma . pstar/(g.rho) -! Grid%DeltaZ &! = z_bnd(i,j,KMAX_BND-1) ! NB! Approx,updated every 3h -! = (1.0 - sigma_bnd(20) ) * (ps(i,j,1)-PT) /(GRAV*roa(i,j,20,1)) -!Eta coordinates: -!dp = dA+dB*Ps - Grid%DeltaZ &! = z_bnd(i,j,KMAX_BND-1) ! NB! Approx,updated every 3h - = (dA(KMAX_MID)+dB(KMAX_MID)*ps(i,j,1) )/(GRAV*roa(i,j,KMAX_MID,1)) - - Grid%u_ref = u_ref(i,j) - Grid%qw_ref = q(i,j,KMAX_MID,1) ! specific humidity - Grid%rho_ref = roa(i,j,KMAX_MID,1) - Grid%zen = zen(i,j) - Grid%coszen = coszen(i,j) - Grid%izen = max( 1, int ( Grid%zen + 0.5 ) )! 1 avoids zero in indices. - Grid%Idirect = Idirect(i,j) - Grid%Idiffuse = Idiffuse(i,j) - - !** prefer micromet signs and terminology here: - - Grid%Hd = -fh(i,j,1) ! Heat flux, *away from* surface - Grid%LE = -fl(i,j,1) ! Heat flux, *away from* surface - Grid%ustar = ustar_nwp(i,j) ! u* - Grid%t2 = t2_nwp(i,j,1) ! t2 , K - Grid%t2C = Grid%t2 - 273.15 ! deg C - Grid%theta_ref = th(i,j,KMAX_MID,1) - Grid%rh2m = rh2m(i,j,1) ! - Grid%rho_s = rho_surf(i,j) ! Should replace Met_ml calc. in future - - Grid%is_mainlysea = mainly_sea(i,j) - Grid%is_allsea = ( mainly_sea(i,j) .and. LandCover(i,j)%ncodes == 1) - Grid%sdepth = sdepth(i,j,1) - Grid%ice_nwp = max( ice_nwp(i,j,1), ice_landcover(i,j) ) - Grid%snowice = ( Grid%sdepth > 1.0e-10 .or. Grid%ice_nwp > 1.0e-10 ) - - Grid%fSW = fSW(i,j) - - ! we limit u* to a physically plausible value - ! to prevent numerical problems - - Grid%ustar = max( Grid%ustar, 0.1 ) - - Grid%invL = -1* KARMAN * GRAV * Grid%Hd & ! -Grid%Hd disliked by gfortran +! We assume that the area of grid which is wet is proportional to +! cloud-cover. To avoid some compiler/numerical issues when +! prec almost equal to zero, we allow a small build-up phase, with +! linear increase from wetarea=0 to wetarea = cc3dmax for values of +! prec between 1.0e-8 (near-zero!) to 0.01. + + if ( surface_precip(i,j) > 1.0d-2 ) then + Grid%is_wet = .true. + Grid%wetarea = cc3dmax(i,j,KMAX_MID) + elseif ( surface_precip(i,j) > 1.0d-8 ) then + Grid%is_wet = .true. + Grid%wetarea = surface_precip(i,j)/1.0d-2 * cc3dmax(i,j,KMAX_MID) + else + Grid%is_wet = .false. + Grid%wetarea = 0.0 + end if + + + Grid%i = i + Grid%j = j + Grid%psurf = ps(i,j,1) ! Surface pressure, Pa + Grid%z_mid = z_mid(i,j,KMAX_MID) ! NB: Approx, updated every 3h + + ! Have option to use a different reference ht: + if ( USE_ZREF ) then + Grid%z_ref = & + min( 0.1*pzpbl(i,j), z_mid(i,j,KMAX_MID) ) ! within or top of SL + else + Grid%z_ref = z_mid(i,j,KMAX_MID) ! within or top of SL + end if + + ! The biggest trees in the new CLM ssytem are 35m high, giving displacement + ! hts of 24.5m. We ensure that z_ref -d > z0 + Grid%z_ref = max(30.0, Grid%z_ref ) ! for trees d=14m, + + ! More exact for thickness of bottom layer, since used for emissions + ! from dp = dA+dB*Ps (eta coordinates) + Grid%DeltaZ &! = z_bnd(i,j,KMAX_BND-1) ! NB! Approx,updated every 3h + = (dA(KMAX_MID)+dB(KMAX_MID)*ps(i,j,1) )/(GRAV*roa(i,j,KMAX_MID,1)) + Grid%u_ref = u_ref(i,j) + Grid%qw_ref = q(i,j,KMAX_MID,1) ! specific humidity + Grid%rho_ref = roa(i,j,KMAX_MID,1) + Grid%zen = zen(i,j) + Grid%coszen = coszen(i,j) + Grid%izen = max( 1, int ( Grid%zen + 0.5 ) )! 1 avoids zero in indices. + Grid%Idirect = Idirect(i,j) + Grid%Idiffuse = Idiffuse(i,j) + + !** prefer micromet signs and terminology here: + Grid%Hd = -fh(i,j,1) ! Heat flux, *away from* surface + Grid%LE = -fl(i,j,1) ! Heat flux, *away from* surface + Grid%ustar = ustar_nwp(i,j) ! u* + Grid%t2 = t2_nwp(i,j,1) ! t2 , K + Grid%t2C = Grid%t2 - 273.15 ! deg C + Grid%theta_ref = th(i,j,KMAX_MID,1) + Grid%rh2m = rh2m(i,j,1) ! + Grid%rho_s = rho_surf(i,j) ! Should replace Met_ml calc. in future + + Grid%is_mainlysea = mainly_sea(i,j) + Grid%is_allsea = ( mainly_sea(i,j) .and. LandCover(i,j)%ncodes == 1) + Grid%sdepth = sdepth(i,j,1) + Grid%ice_nwp = max( ice_nwp(i,j,1), ice_landcover(i,j) ) + Grid%snowice = ( Grid%sdepth > 1.0e-10 .or. Grid%ice_nwp > 1.0e-10 ) + + Grid%fSW = fSW(i,j) + + ! we limit u* to a physically plausible value + ! to prevent numerical problems + Grid%ustar = max( Grid%ustar, 0.1 ) + + Grid%invL = -1* KARMAN * GRAV * Grid%Hd & ! -Grid%Hd disliked by gfortran / (CP*Grid%rho_s * Grid%ustar*Grid%ustar*Grid%ustar * Grid%t2 ) + !.. we limit the range of 1/L to prevent numerical and printout problems + !.. and because we don't trust HIRLAM or other NWPs enough. + ! This range is very wide anyway. + ! Grid%invL = max( -1.0, Grid%invL ) !! limit very unstable + ! Grid%invL = min( 1.0, Grid%invL ) !! limit very stable - !.. we limit the range of 1/L to prevent numerical and printout problems - !.. and because we don't trust HIRLAM or other NWPs enough. - ! This range is very wide anyway. - - ! Grid%invL = max( -1.0, Grid%invL ) !! limit very unstable - ! Grid%invL = min( 1.0, Grid%invL ) !! limit very stable - - ! wstar for particle deposition, based on Wesely - if(Grid%Hd > 0.0 ) then ! unstable stratification - Grid%wstar = ( GRAV * pzpbl(i,j) * Grid%Hd / & + ! wstar for particle deposition, based on Wesely + if(Grid%Hd > 0.0 ) then ! unstable stratification + Grid%wstar = ( GRAV * pzpbl(i,j) * Grid%Hd / & (Grid%rho_ref * CP * th(i,j,KMAX_MID,1))) ** (1./3.) - else - Grid%wstar = 0. - end if + else + Grid%wstar = 0. + end if nlu = LandCover(i,j)%ncodes ! Added for safety - Sub(:) = ResetSub ! + Sub(:) = ResetSub Sub(:)%coverage = 0.0 Sub(:)%LAI = 0.0 Sub(:)%SAI = 0.0 Sub(:)%hveg = 0.0 - LULOOP: do ilu= 1, nlu - lu = LandCover(i,j)%codes(ilu) - - Sub(lu)%coverage = LandCover(i,j)%fraction(ilu) - Sub(lu)%LAI = LandCover(i,j)%LAI(ilu) - Sub(lu)%SAI = LandCover(i,j)%SAI(ilu) - Sub(lu)%hveg = LandCover(i,j)%hveg(ilu) + LULOOP: do ilu= 1, nlu + lu = LandCover(i,j)%codes(ilu) - !======================= + Sub(lu)%coverage = LandCover(i,j)%fraction(ilu) + Sub(lu)%LAI = LandCover(i,j)%LAI(ilu) + Sub(lu)%SAI = LandCover(i,j)%SAI(ilu) + Sub(lu)%hveg = LandCover(i,j)%hveg(ilu) - call Get_SubMet(lu, debug_flag ) + !======================= + call Get_SubMet(lu, debug_flag ) + Sub(lu)%SWP = 0.0 ! Not yet implemented + !======================= + end do LULOOP - Sub(lu)%SWP = 0.0 ! Not yet implemented - !======================= - end do LULOOP - - end subroutine Get_CellMet - !======================================================================= +end subroutine Get_CellMet +!======================================================================= end module CellMet_ml diff --git a/CheckStop_ml.f90 b/CheckStop_ml.f90 index 972fec6..6e6dcde 100644 --- a/CheckStop_ml.f90 +++ b/CheckStop_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -70,8 +70,8 @@ subroutine StopAll(errmsg) if(errmsg/="ok") then write(*,*) "STOP-ALL ERROR: ", trim(errmsg) call MPI_ABORT(MPI_COMM_CALC,9,IERROR) - endif -endsubroutine StopAll + end if +end subroutine StopAll !---- Variations on CheckStop: subroutine CheckStop_ok(errmsg) ! Test if errmsg /= "ok" @@ -80,8 +80,8 @@ subroutine CheckStop_ok(errmsg) ! Test if errmsg /= "ok" if(errmsg/="ok") then !write(*,*) "CheckStop_ok Called with: errmsg ", errmsg call StopAll(errmsg) - endif -endsubroutine CheckStop_ok + end if +end subroutine CheckStop_ok subroutine CheckStop_okinfo(errmsg,infomsg) ! Test if errmsg /= "ok" character(len=*), intent(in) :: errmsg @@ -91,8 +91,8 @@ subroutine CheckStop_okinfo(errmsg,infomsg) ! Test if errmsg /= "ok" !write(*,*) "CheckStop_ok Called with: errmsg ", errmsg write(*,*) " infomsg ", infomsg call StopAll(errmsg) - endif -endsubroutine CheckStop_okinfo + end if +end subroutine CheckStop_okinfo subroutine CheckStop_int1(int1,infomsg) ! Test if int1 /= 0 integer, intent(in) :: int1 @@ -102,8 +102,8 @@ subroutine CheckStop_int1(int1,infomsg) ! Test if int1 /= 0 write(*,*) "CheckStopl_int1 Called with: int1 ", int1 !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_int1 + end if +end subroutine CheckStop_int1 subroutine CheckStop_int2(int1,int2, infomsg) ! Test if int1 /= int2 integer, intent(in) :: int1, int2 @@ -113,8 +113,8 @@ subroutine CheckStop_int2(int1,int2, infomsg) ! Test if int1 /= int2 write(*,*) "CheckStopl_int2 Called with: int1 ", int1, " int2 ", int2 !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_int2 + end if +end subroutine CheckStop_int2 subroutine CheckStop_str2(str1,str2, infomsg) ! Test if str1 /= str2 character(len=*), intent(in) :: str1, str2, infomsg @@ -123,8 +123,8 @@ subroutine CheckStop_str2(str1,str2, infomsg) ! Test if str1 /= str2 write(*,*) "CheckStopl_str2 Called with: str1 ", str1, " str2 ", str2 !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_str2 + end if +end subroutine CheckStop_str2 subroutine CheckStop_TF(is_error, infomsg) ! Test expression, e.g. lu<0 logical, intent(in) :: is_error @@ -134,8 +134,8 @@ subroutine CheckStop_TF(is_error, infomsg) ! Test expression, e.g. lu<0 !write(*,*) "CheckStopl_TF Called with: logical ", is_error !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_TF + end if +end subroutine CheckStop_TF subroutine CheckStop_rangeR(var,vrange,infomsg) ! test .not.(vrange(0)<=var<=vrange(1)) real, intent(in) :: var,vrange(0:1) @@ -147,8 +147,8 @@ subroutine CheckStop_rangeR(var,vrange,infomsg) ! test .not.(vrange(0)<=var<=vr write(*,errfmt) "CheckStopl_range: variable",var,vrange !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_rangeR + end if +end subroutine CheckStop_rangeR subroutine CheckStop_rangeI(var,vrange,infomsg) ! test .not.(vrange(0)<=var<=vrange(1)) integer, intent(in) :: var,vrange(0:1) @@ -160,8 +160,8 @@ subroutine CheckStop_rangeI(var,vrange,infomsg) ! test .not.(vrange(0)<=var<=vr write(*,errfmt) "CheckStopl_range: variable",var,vrange !write(*,*) " infomsg ", infomsg call StopAll(infomsg) - endif -endsubroutine CheckStop_rangeI + end if +end subroutine CheckStop_rangeI subroutine CheckNC(status,errmsg) implicit none @@ -172,8 +172,8 @@ subroutine CheckNC(status,errmsg) print *, trim(nf90_strerror(status)) if(present(errmsg)) print *, "ERRMSG: ", trim(errmsg) call StopAll("Error in netcdf routine") - endif -endsubroutine CheckNC + end if +end subroutine CheckNC endmodule CheckStop_ml diff --git a/Chem_ml.f90 b/ChemFields_ml.f90 similarity index 93% rename from Chem_ml.f90 rename to ChemFields_ml.f90 index d859f6e..32a45f3 100644 --- a/Chem_ml.f90 +++ b/ChemFields_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -24,7 +24,7 @@ !* You should have received a copy of the GNU General Public License !* along with this program. If not, see . !*****************************************************************************! -module Chemfields_ml +module ChemFields_ml ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> use AllocInits, only: AllocInit use ChemSpecs, only: NSPEC_ADV, NSPEC_SHL, NSPEC_TOT, & ! => No. species @@ -57,6 +57,11 @@ module Chemfields_ml ! model, as well as cfac (converts from 50m to 1m/3m output) ! !---------------------------------------------------------------------! + + !March 2017: moved from Solver + real, save, public, dimension(NSPEC_TOT):: & + x, xold ,xnew ! Work arrays [molecules/cm3] + real, save, allocatable, public :: & xn_adv(:,:,:,:) & ,xn_shl(:,:,:,:) & @@ -81,6 +86,8 @@ module Chemfields_ml real, save, allocatable, public :: & Grid_snow(:,:) !snow_flag fraction in grid + real, save, public :: cell_tinv ! 1/temp, tmp location + public ::alloc_ChemFields contains @@ -120,7 +127,7 @@ subroutine alloc_ChemFields if(FIRST_SEMIVOL>0)then !FSOA allocate(Fgas3d(FIRST_SEMIVOL:LAST_SEMIVOL,LIMAX,LJMAX,KCHEMTOP:KMAX_MID)) Fgas3d = 1.0 - endif + end if allocate(rcemis(NSPEC_SHL+1:NSPEC_TOT,KCHEMTOP:KMAX_MID)) allocate(deltaZcm(KCHEMTOP:KMAX_MID)) @@ -166,5 +173,5 @@ end subroutine alloc_ChemFields !_____________________________________________________________________________ -endmodule Chemfields_ml +endmodule ChemFields_ml ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/ChemFunctions_ml.f90 b/ChemFunctions_ml.f90 index 2fb0914..e025863 100644 --- a/ChemFunctions_ml.f90 +++ b/ChemFunctions_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -322,7 +322,7 @@ function RiemerN2O5() result(rate) + VOLFACNH4 * x(NH4_f,k) ) !SIA aerosol surface else rate(k) = 0.0 - endif + end if end do ! k end function RiemerN2O5 @@ -366,7 +366,7 @@ function HydrolysisN2O5(ormethod) result(rate) real, dimension(K1:K2) :: rate real :: rc real :: f ! Was f_Riemer - real :: gam, S, Rwet ! for newer methods + real :: gam, S, S_ss, S_du, Rwet ! for newer methods real, save :: g1 = 0.02, g2=0.002 ! gammas for 100% SO4, 100% NO3, default real, save :: gFix ! for Gamma:xxxx values real, parameter :: EPSIL = 1.0 ! One mol/cm3 to stop div by zero @@ -407,10 +407,10 @@ function HydrolysisN2O5(ormethod) result(rate) + VOLFACNH4 * x(NH4_f,k) ) !SIA aerosol surface else rate(k) = 0.0 - endif + end if end do ! k !--------------------------------------- - case ( "Smix", "SmixTen" ) + case ( "Smix", "SmixTen", "SmixC" ) do k = K1, K2 @@ -426,6 +426,15 @@ function HydrolysisN2O5(ormethod) result(rate) if( method == "SmixTen") gam = 0.1 * gam ! cf Brown et al, 2009! rate(k) = UptakeRate(cN2O5(k),gam,S) !1=fine SIA ! +OM + + if( method == "SmixC") then + S_ss = S_m2m3(AERO%SS_C,k) + gam=GammaN2O5_EJSS(rh(k)) + S_du = S_m2m3(AERO%DU_C,k) + gam=0.01 ! for dust + ! same as UptakeRate(cN2O5,gam,S), but easier to code here: + rate(k) = rate(k) + cN2O5(k)*(gam*S_ss+0.01*S_du)/4 + end if ! SmixC else gam = 0.0 ! just for export rate(k) = 0.0 @@ -492,7 +501,7 @@ function HydrolysisN2O5(ormethod) result(rate) else rate(k) = 0.0 - endif + end if end do ! k case ( "Gamma:0.002", "Gamma:0.05", "Gamma:0.005") ! Inspired by Brown et al. 2009 do k = K1, K2 @@ -569,7 +578,7 @@ function ec_ageing_rate() result(rate) rate (K1 : K2-3) = 1.4e-4 ! ~ 2h else rate (K1 : K2 ) = 9.2e-6 ! ~ 30h - endif + end if end function ec_ageing_rate diff --git a/CM_ChemSpecs_tmp.f90 b/ChemSpecs_wrapper.f90 similarity index 89% rename from CM_ChemSpecs_tmp.f90 rename to ChemSpecs_wrapper.f90 index aca3737..96f0bfd 100644 --- a/CM_ChemSpecs_tmp.f90 +++ b/ChemSpecs_wrapper.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/CoDep_ml.f90 b/CoDep_ml.f90 index 649130f..313a22f 100644 --- a/CoDep_ml.f90 +++ b/CoDep_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -238,7 +238,7 @@ subroutine Tabulate() tab_F3 (ia_SN_24hr) = 11.84 * exp(1.1 * a_SN_24hr) if(MY_DEBUG.and. MasterProc ) write(6,*) "TABIA24 ", ia_SN_24hr, & a_SN_24hr, tab_F3(ia_SN_24hr) - enddo + end do do IRH = 0, 100 tab_exp_rh(IRH) = exp( (100.0-IRH)/7.0) @@ -285,10 +285,10 @@ subroutine make_so2nh3_24hr(hour,so2conc,nh3conc,cfac_so2,cfac_nh3) so2nh3_hr(nhour,i,j),so2nh3_24hr(i,j) write(*,*) "so2nh3_24hr output", so2nh3_24hr(i,j),& so2conc(i,j),cfac_so2(i,j),nh3conc(i,j),cfac_nh3(i,j) - endif - enddo ! nhour - enddo - enddo + end if + end do ! nhour + end do + end do end subroutine make_so2nh3_24hr !======================================================================= diff --git a/ColumnSource_ml.f90 b/ColumnSource_ml.f90 index d8d2e6f..03d69d6 100644 --- a/ColumnSource_ml.f90 +++ b/ColumnSource_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,11 +39,12 @@ module ColumnSource_ml use ChemGroups_ml, only: chemgroups use EmisDef_ml, only: VOLCANOES_LL use GridValues_ml, only: xm2,sigma_bnd,GridArea_m2,& + GRIDWIDTH_M,& coord_in_processor,coord_in_gridbox use Io_ml, only: open_file,read_line,IO_TMP,PrintLog -use MetFields_ml, only: roa, z_bnd -use ModelConstants_ml, only: KCHEMTOP,KMAX_MID,MasterProc, & - USE_ASH,DEBUG=>DEBUG_COLSRC,& +use MetFields_ml, only: roa, z_bnd, u_xmj, v_xmi +use ModelConstants_ml, only: KCHEMTOP,KMAX_MID,MasterProc,NPROC, & + USE_ASH,DEBUG,USE_PreADV,& TXTLEN_NAME,dt_advec,dt_advec_inv,& startdate,enddate use NetCDF_ml, only: GetCDF_modelgrid @@ -60,14 +61,15 @@ module ColumnSource_ml !** subroutines: public :: ColumnRate ! Emission rate +public :: getWinds ! Wind speeds at locations logical, save :: & source_found=.true.,& ! Are sources found on this processor/subdomain? topo_found=.false. ! topo_nc file found? (vent elevation-model surface height) integer, parameter :: & - NMAX_LOC = 24, & ! Max number of locations on processor/subdomain - NMAX_EMS =10000 ! Max number of events def per location + NMAX_LOC = 5, & ! Max number of locations on processor/subdomain (increase to 24 for eEMEP) + NMAX_EMS = 300 ! Max number of events def per location (increase to 6000 for eEMEP) integer, save :: & ! No. of ... found on processor/subdomain nloc = -1,& ! Source locations @@ -82,7 +84,7 @@ module ColumnSource_ml real :: lat=-1.0,lon=-1.0,elev=-1.0 ! vent coords and elevation character(len=SLEN) :: etype='' ! e.g. S0, 10kt integer :: grp=-1,iloc=-1,jloc=-1 ! Which (ash)goup,local i,j indes -endtype loc +end type loc type(loc), save, dimension(NMAX_LOC):: & locdef=loc('UNDEF','UNKNOWN',-999.0,-999.0,-999.0,"??",-99,-99,-99) @@ -100,7 +102,7 @@ module ColumnSource_ml integer :: loc=-1,spc=-1,grp=-1 ! Which loc,(adv)spc,(ash)goup logical :: edef=.true.,& ! default setings? dsec=.false. ! correct rate by 1/secs(send-sbeg) -endtype ems +end type ems type(ems), save, allocatable ,dimension(:,:):: emsdef character(len=*),parameter :: & @@ -120,6 +122,8 @@ module ColumnSource_ml EXPAND_SCENARIO_NAME(1)="" ! do not expand real,save,allocatable,dimension(:,:) :: surf_height ! [m], read from topo_nc +integer, public, save :: PROC_LOC(NMAX_LOC)=-1 +real, allocatable, public, save :: Winds(:,:,:) contains !-----------------------------------------------------------------------! @@ -136,14 +140,15 @@ function ColumnRate(i,j,REDUCE_VOLCANO) result(emiss) real, intent(in), optional :: REDUCE_VOLCANO real, dimension(NSPEC_SHL+1:NSPEC_TOT,KCHEMTOP:KMAX_MID) :: emiss logical, save :: first_call=.true. - character(len=SLEN)::&! Time strings in SDATE_FMT format - sbeg=SDATE_FMT,& ! Begin - snow=SDATE_FMT,& ! Now (current date) - send=SDATE_FMT ! End - integer :: v,e,itot,k1,k0 + character(len=SLEN)::& ! Time strings in SDATE_FMT format + sbeg=SDATE_FMT,& ! Begin + snow=SDATE_FMT,& ! Now (current date) + send=SDATE_FMT ! End + integer :: v,e,itot,k1,k0,k real :: uconv integer, save :: iSO2=-1 integer, pointer, save :: iASH(:)=>null() + real :: Ncells, frac !----------------------------! ! !----------------------------! @@ -157,27 +162,37 @@ function ColumnRate(i,j,REDUCE_VOLCANO) result(emiss) first_call=.false. itot=find_index("SO2",species(:)%name) if(itot<1)then - call PrintLog("WARNING: "//mname//" SO2 not found",MasterProc) + call PrintLog("WARNING: "//mname//" SO2 not found",MasterProc) else iSO2=itot - endif + end if itot=find_index("ASH",chemgroups(:)%name) if(itot<1)then call PrintLog("WARNING: "//mname//" ASH not found",MasterProc) else - iASH=>chemgroups(itot)%ptr - endif - endif + iASH=>chemgroups(itot)%specs + end if + + end if !----------------------------! ! !----------------------------! emiss(:,:)=0.0 if(.not.source_found)return snow=date2string(SDATE_FMT,current_date) - doLOC: do v=1,nloc - if((i/=locdef(v)%iloc).or.(j/=locdef(v)%jloc) & ! Wrong gridbox - .or.(nems(v)<1)) cycle doLOC ! Not erupting - if(DEBUG) & + + doLOC: do v=1,nloc + + if(USE_PreADV)then ! spread emissions in case of strong winds + !cannot use formula below directly, because location may be in another subdomain + ! Winds(:,1,l)=u_xmj(locdef(l)%iloc,locdef(l)%jloc,:,1)*xm2(locdef(l)%iloc,locdef(l)%jloc)*dt_advec/gridwidth_m + ! Winds(:,2,l)=v_xmi(locdef(l)%iloc,locdef(l)%jloc,:,1)*xm2(locdef(l)%iloc,locdef(l)%jloc)*dt_advec/gridwidth_m + if(nems(v)<1) cycle doLOC ! Not erupting + else + if((i/=locdef(v)%iloc).or.(j/=locdef(v)%jloc) & ! Wrong gridbox + .or.(nems(v)<1)) cycle doLOC ! Not erupting + end if + if(DEBUG%COLSRC .and. .not. USE_PreADV) & write(*,MSG_FMT)snow//' Vent',me,'me',v,trim(locdef(v)%id),i,"i",j,"j" doEMS: do e=1,nems(v) sbeg=date2string(emsdef(v,e)%sbeg,current_date) @@ -191,19 +206,51 @@ function ColumnRate(i,j,REDUCE_VOLCANO) result(emiss) else k0=getModLev(i,j,emsdef(v,e)%base) k1=getModLev(i,j,emsdef(v,e)%top) - endif + end if uconv=1e-3 ! Kg/s --> ton/s=1e6 g/s if(emsdef(v,e)%dsec)uconv=1e6/max(dt_advec,& ! Tg --> ton/s=1e6 g/s tdif_secs(to_stamp(sbeg,SDATE_FMT),to_stamp(send,SDATE_FMT))) uconv=uconv/(GridArea_m2(i,j)*DIM(z_bnd(i,j,k1),z_bnd(i,j,k0+1))) ! --> g/s/cm3=1e-6 g/s/m3 uconv=uconv*AVOG/species(itot)%molwt ! --> molecules/s/cm3 - emiss(itot,k1:k0)=emiss(itot,k1:k0)+emsdef(v,e)%rate*uconv - if(DEBUG) & + + if(USE_PreADV)then ! spread emissions in case of strong winds + do k=k1,k0 + ! only a fraction of the emission is used in each reachable gridcell + ! test if in range. NB: Winds have sign + if(Winds(k,1,v)>=0.0 .and. ((i-locdef(v)%iloc)>floor(Winds(k,1,v)) .or. (i-locdef(v)%iloc)<0))cycle + if(Winds(k,1,v)<=0.0 .and. ((i-locdef(v)%iloc)0))cycle + if(Winds(k,2,v)>=0.0 .and. ((j-locdef(v)%jloc)>floor(Winds(k,2,v)) .or. (j-locdef(v)%jloc)<0))cycle + if(Winds(k,2,v)<=0.0 .and. ((j-locdef(v)%jloc)0))cycle + + ! test if along the line of wind, i.e. i/j = Winds(:,1,v)/Winds(:,2,v) + if(abs(Winds(k,1,v))>1.E-6)then + if(nint((i-locdef(v)%iloc)*Winds(k,2,v)/Winds(k,1,v))/=j-locdef(v)%jloc) cycle + end if + + if(DEBUG%COLSRC)write(*,MSG_FMT)snow//' Vent',me,'me',v,trim(locdef(v)%id),i,"i",j,"j" + + Ncells=max(abs(Winds(k,1,v)),abs(Winds(k,2,v))) ! NB: not an integer + if(Ncells<=1.0)then + emiss(itot,k)=emiss(itot,k)+emsdef(v,e)%rate*uconv + else + frac=1.0/Ncells + if(abs(i-locdef(v)%iloc)-floor(abs(Winds(k,1,v)))==0 .and. & + abs(j-locdef(v)%jloc)-floor(abs(Winds(k,2,v)))==0)frac=frac*mod(Ncells,1.0) ! last cell take only what is left + if(DEBUG%COLSRC)write(*,*)'including fraction ',frac,' for ',i,j,k,v,locdef(v)%iloc,locdef(v)%jloc + + emiss(itot,k)=emiss(itot,k)+frac*emsdef(v,e)%rate*uconv + end if + end do + else + emiss(itot,k1:k0)=emiss(itot,k1:k0)+emsdef(v,e)%rate*uconv + end if + + if(DEBUG%COLSRC) & write(*,MSG_FMT)snow//' Erup.',me,'me',e,emsdef(v,e)%sbeg,& itot,trim(species(itot)%name),k1,'k1',k0,'k0',& emiss(itot,k1),'emiss',emsdef(v,e)%rate,'rate',uconv,'uconv' - enddo doEMS - enddo doLOC + end do doEMS + end do doLOC !----------------------------! ! Volcanic emission reduction for SR run !----------------------------! @@ -212,7 +259,7 @@ function ColumnRate(i,j,REDUCE_VOLCANO) result(emiss) emiss(iSO2,:)=emiss(iSO2,:)*REDUCE_VOLCANO if(associated(iASH))& emiss(iASH,:)=emiss(iASH,:)*REDUCE_VOLCANO - endif + end if !----------------------------! ! Disable Volcanic emissions !----------------------------! @@ -233,8 +280,8 @@ function getModLev(i,j,height) result(k) if(height<=0.0)return do while(k>0.and.height>z_bnd(i,j,k)) k=k-1 - enddo -endfunction getModLev + end do +end function getModLev !----------------------------! ! Set Volcanic Eruption Param. !----------------------------! @@ -257,29 +304,31 @@ subroutine setRate() 0.079647,0.060689,0.07127 ,0.069065],& NILU_1BIN_SPLIT(1)=[1.0] real, pointer, dimension(:) :: binsplit => NULL() + !----------------------------! ! !----------------------------! + if(first_call .and. USE_PreADV) allocate(Winds(KMAX_MID,2,NMAX_LOC)) if(.not.first_call)then - if(MasterProc.and.DEBUG.and.second_call) & + if(MasterProc.and.DEBUG%COLSRC.and.second_call) & write(*,MSG_FMT)'No need for reset volc.def...' second_call=.false. return - endif + end if first_call=.false. if(.not.allocated(emsdef)) then allocate(emsdef(0:NMAX_LOC,NMAX_EMS)) emsdef(:,:)=ems('UNDEF','UNKNOWN','??',-999.0,-999.0,-999.0,& '??','??',-1,-1,-1,.true.,.false.) - endif + end if !----------------------------! ! Read Vent CVS !----------------------------! - if(DEBUG) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) + if(DEBUG%COLSRC) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) if(MasterProc)then call open_file(IO_TMP,"r",flocdef,needed=.true.,iostat=stat) call CheckStop(stat,ERR_LOC_CSV//' not found') - endif + end if nloc=0 l = 1 doLOC: do while (l<=NMAX_LOC) @@ -289,141 +338,161 @@ subroutine setRate() if(txtline(1:1)=='#')cycle doLOC ! Comment line dloc=getVent(txtline) if(coord_in_processor(dloc%lon,dloc%lat,iloc=dloc%iloc,jloc=dloc%jloc))then + PROC_LOC(l) = ME!The source is located on this proc nloc=nloc+1 call CheckStop(nloc>NMAX_LOC,ERR_LOC_MAX//" read") ! remove model surface height from vent elevation dloc%elev=dloc%elev-surf_height(dloc%iloc,dloc%jloc) locdef(nloc)=dloc - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Vent',me,'in',nloc,trim(dloc%id),& dloc%grp,trim(dloc%name),dloc%iloc,"i",dloc%jloc,"j",& dloc%lon,"lon",dloc%lat,"lat" elseif(MasterProc)then - if(DEBUG) & + PROC_LOC(l) = -1 ! The source is not located on this proc we use -1, so that we know + ! that if the sum all PROC_LOC(l)<0, it is not in the rundomain + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Vent',me,'out',-1,trim(dloc%id),& dloc%grp,trim(dloc%name),dloc%iloc,"i",dloc%jloc,"j",& dloc%lon,"lon",dloc%lat,"lat" - endif + end if l = l+1 - enddo doLOC + end do doLOC if(MasterProc) close(IO_TMP) - source_found=(nloc>0).or.(MasterProc.and.DEBUG) + source_found=(nloc>0).or.(MasterProc.and.DEBUG%COLSRC) + + if(USE_PreADV)then ! spread emissions in case of strong winds + ! broadcast the PROC_LOC + CALL MPI_ALLREDUCE(MPI_IN_PLACE,PROC_LOC,NMAX_LOC,MPI_INTEGER, & + MPI_SUM,MPI_COMM_CALC,IERROR) + do l=1,NMAX_LOC + PROC_LOC(l) = PROC_LOC(l)+NPROC-1 + if(MasterProc .and. PROC_LOC(l)>=0)& + write(*,*)'source ',l,' on PROC ',PROC_LOC(l) + enddo + ! Now PROC_LOC=ME, because + ! (ME) + (NPROC-1)*(-1) + NPROC-1= ME + ! if not in the rundomain, PROC_LOC = -1 + call getWinds + endif !----------------------------! ! Read Eruption CVS !----------------------------! - if(DEBUG) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) + if(DEBUG%COLSRC) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) if(MasterProc)then call open_file(IO_TMP,"r",femsdef,needed=.true.,iostat=stat) call CheckStop(stat,ERR_EMS_CSV//' not found') - endif + end if nems(:)=0 l = 1 sbeg=date2string(SDATE_FMT,startdate) - send=date2string(SDATE_FMT,enddate) + send=date2string(SDATE_FMT,enddate) doEMS: do while(l<=NMAX_EMS) call read_line(IO_TMP,txtline,stat) if(stat/=0) exit doEMS ! End of file - if(.not.source_found)cycle doEMS ! There is no vents on subdomain + if(.not.source_found)cycle doEMS ! There is no vents on sub-domain txtline=ADJUSTL(txtline) ! Remove leading spaces if(txtline(1:1)=='#')cycle doEMS ! Comment line dems=getErup(txtline) - if(sbeg>date2string(dems%send,enddate ).or.& ! starts after end of run - send0) & + if(sbeg>date2string(dems%send,enddate ).or.& ! starts after end of run + send0) & write(*,MSG_FMT)'Erup.skip',me,'in',dems%loc,trim(dems%id),& 0,trim(dems%sbeg),1,trim(dems%send) + if(DEBUG%COLSRC.and.dems%loc>0)write(*,*)'RATE',dems%rate cycle doEMS elseif(dems%edef)then ! Default nems(0)=nems(0)+1 call CheckStop(nems(0)>NMAX_EMS,ERR_EMS_MAX//" read") emsdef(0,nems(dems%loc))=dems - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Default',me,'in',nems(0),trim(dems%id) elseif(dems%loc>0.and.(dems%spc>0.or.dems%grp>0))then ! Specific nems(dems%loc)=nems(dems%loc)+1 call CheckStop(nems(dems%loc)>NMAX_EMS,ERR_EMS_MAX//" read") emsdef(dems%loc,nems(dems%loc))=dems - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Specific',me,'in',nems(dems%loc),trim(dems%id),& dems%spc,trim(dems%name),dems%grp,trim(dems%name)//"_GROUP" - elseif(MasterProc)then ! or Unknown Vent/SPC/GROUP - if(DEBUG) & + call CheckStop(dems%spc<1.and.dems%grp>0,"Erup.Specific unsupported group") + elseif(MasterProc)then ! in MasterProc or Unknown Vent/SPC/GROUP + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Specific',me,'out',-1,trim(dems%id),& dems%spc,trim(dems%name),dems%grp,trim(dems%name)//"_GROUP" - endif + end if l = l+1 - enddo doEMS + end do doEMS if(MasterProc) close(IO_TMP) source_found=any(nems(1:nloc)>0) !----------------------------! ! Expand Eruption Defaults !----------------------------! - if(DEBUG) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) + if(DEBUG%COLSRC) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) if(nems(0)<1)then - !if(DEBUG) write(*,MSG_FMT)'Erup.Default',me,'not found' + ! if(DEBUG%COLSRC) write(*,MSG_FMT)'Erup.Default',me,'not found' return - endif + end if doLOCe: do v=1,nloc if(nems(v)>0)cycle doLOCe ! Specific found --> no need for Default - e=nems(0)+1 ! A single defaul can have multiple lines, e.g. - do ! each line with a difinition for a different specie + e=nems(0)+1 ! A single default can have multiple lines, e.g. + do ! each line with a definition for a different specie e=find_index(locdef(v)%etype,emsdef(0,:e-1)%id) - if(e<1) cycle doLOCe ! No Default found - if(DEBUG) & + if(e<1) cycle doLOCe ! No Default found + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Default',me,'Expand',& v,trim(locdef(v)%id),e,trim(emsdef(0,e)%id) dems=emsdef(0,e) if(dems%htype=='VENT')then -!! call CheckStop(.not.topo_found,ERR_TOPO_NC//' not found') +!! call CheckStop(.not.topo_found,ERR_TOPO_NC//' not found') dems%base=dems%base+locdef(v)%elev dems%top =dems%top +locdef(v)%elev - if(DEBUG)& + if(DEBUG%COLSRC)& write(*,MSG_FMT)'Erup.Default',me,'Add loc%elev',& nint(dems%base),'ems%base',nint(dems%top),'ems%top' - endif + end if if(dems%spc<1.and.any(dems%name(1:3)==EXPAND_SCENARIO_NAME))then ! Expand variable name dems%name=trim(locdef(v)%id)//trim(dems%name(4:)) ! e.g. ASH_F --> V1702A02B_F dems%spc=find_index(dems%name,species(:)%name) ! Specie (total) - if(DEBUG)& + if(DEBUG%COLSRC)& write(*,MSG_FMT)'Erup.Default',me,'Expand',& dems%spc,trim(dems%name) - endif - if(dems%spc>0)then ! Expand single SPC + end if + if(dems%spc>0)then ! Expand single SPC nems(v)=nems(v)+1 call CheckStop(nems(v)>NMAX_EMS,ERR_EMS_MAX//" expand") emsdef(v,nems(v))=dems - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Default',me,'Expand SPC',nems(v),trim(dems%id) elseif(dems%grp>0.or.locdef(v)%grp>0)then ! Expand GROUP of SPC - if(dems%grp<1)dems%grp=locdef(v)%grp - select case (size(chemgroups(dems%grp)%ptr)) + if(dems%grp<1)dems%grp=locdef(v)%grp + select case (size(chemgroups(dems%grp)%specs)) case(2);binsplit=>VAAC_2BIN_SPLIT case(7);binsplit=>VAAC_7BIN_SPLIT case(9);binsplit=>NILU_9BIN_SPLIT case(1);binsplit=>NILU_1BIN_SPLIT case default call CheckStop(ERR_EMS_CSV//' can not expand '//trim(locdef(v)%id)) - endselect - do g=1,size(chemgroups(dems%grp)%ptr) - dems%spc=chemgroups(dems%grp)%ptr(g) ! Specie (total) + end select + do g=1,size(chemgroups(dems%grp)%specs) + dems%spc=chemgroups(dems%grp)%specs(g) ! Specie (total) dems%name=species(dems%spc)%name dems%rate=emsdef(0,e)%rate*binsplit(g) nems(v)=nems(v)+1 call CheckStop(nems(v)>NMAX_EMS,ERR_EMS_MAX//" expand") emsdef(v,nems(v))=dems - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Default',me,'Expand GRP',nems(v),trim(dems%id),& dems%spc,trim(dems%name) - enddo + end do else - if(DEBUG) & + if(DEBUG%COLSRC) & write(*,MSG_FMT)'Erup.Default',me,'not found' - endif - enddo - enddo doLOCe + end if + end do + end do doLOCe source_found=any(nems(1:nloc)>0) -endsubroutine setRate +end subroutine setRate !----------------------------! ! Extract Vent info from CVS line !----------------------------! @@ -444,18 +513,18 @@ function getVent(line) result(def) case("S","s","degS");lat=-lat ! degS case default call CheckStop("EMERGENCY: Unknown degN/S "//trim(words(5))) - endselect + end select read(words(6),*)lon select case (words(7)) ! EW case("E","e","degE") ! degE case("W","w","degW");lon=-lon ! degW case default call CheckStop("EMERGENCY: Unknown degE/W "//trim(words(7))) - endselect + end select read(words(8),*)elev ! [m] igrp=find_index(words(1),chemgroups(:)%name) def=loc(trim(words(1)),trim(words(2)),lat,lon,elev,trim(words(10)),igrp) -endfunction getVent +end function getVent !----------------------------! ! Extract Erup. info from CVS line !----------------------------! @@ -491,9 +560,9 @@ function getErup(line) result(def) ! emiss default: vent%elev is added on expansion (doLOCe: in setRate) base=0.0 if(iloc>0)then -!! call CheckStop(.not.topo_found,ERR_TOPO_NC//' not found') +!! call CheckStop(.not.topo_found,ERR_TOPO_NC//' not found') base=locdef(iloc)%elev ! [m] - endif + end if read(words(4),*)top ! [km] top=top*1e3 ! [m] top=top+base ! [m] @@ -507,29 +576,29 @@ function getErup(line) result(def) base=base*1e3 ! [m] read(words(4),*)top ! [km] top=top*1e3 ! [m] - endselect + end select read(words(6),*)rate select case (words(7)) ! m63 or effect.fraction case(" ") ;frac=1.0 case default;read(words(7),*)frac - endselect + end select select case (words(5)) ! dt[h] case("1dt","1DT","1adv","1ADV") dhh=dt_advec/3600 ! only one time step frac=frac*dt_advec_inv ! assume rate=total emission in [Kg] dsec=.false. - case("total","TOTAL","event","EVENT") + case("total","TOTAL","event","EVENT") dsec=.true. case default read(words(5),*)dhh ! assume rate in [Kg/s] dhh=max(dhh,dt_advec/3600) ! at least 1 time step dsec=.false. - endselect - words(8)=getDate(words(8),words(8),words(9),dhh,debug=DEBUG) ! Start [date/code] - words(9)=getDate(words(9),words(8),words(9),dhh,debug=DEBUG) ! End [date/code] + end select + words(8)=getDate(words(8),words(8),words(9),dhh,debug=DEBUG%COLSRC) ! Start [date/code] + words(9)=getDate(words(9),words(8),words(9),dhh,debug=DEBUG%COLSRC) ! End [date/code] def=ems(trim(words(1)),trim(words(2)),trim(words(3)),base,top,rate*frac,& trim(words(8)),trim(words(9)),max(iloc,0),max(ispc,0),max(igrp,0),edef,dsec) -endfunction getErup +end function getErup !----------------------------! ! Time/Date CODE--> YYYY-MM-DD hh:mm:ss !----------------------------! @@ -565,7 +634,23 @@ function getDate(code,se,ee,dh,debug) result(str) str=date2string(SDATE_FMT,enddate,debug=dbg) case default str=code - endselect -endfunction getDate -endfunction ColumnRate -endmodule ColumnSource_ml + end select +end function getDate +end function ColumnRate + +subroutine getWinds + integer ::l + !broadcast wind speeds at emis locations + do l=1,NMAX_LOC + if(PROC_LOC(l)>=0)then + !exchange wind speed. Converted to Courant number + if(PROC_LOC(l) == ME)then + Winds(:,1,l)=u_xmj(locdef(l)%iloc,locdef(l)%jloc,:,1)*xm2(locdef(l)%iloc,locdef(l)%jloc)*dt_advec/gridwidth_m + Winds(:,2,l)=v_xmi(locdef(l)%iloc,locdef(l)%jloc,:,1)*xm2(locdef(l)%iloc,locdef(l)%jloc)*dt_advec/gridwidth_m + endif + CALL MPI_BCAST(Winds(1,1,l),2*8*KMAX_MID,MPI_BYTE,PROC_LOC(l),MPI_COMM_CALC,IERROR) + endif + enddo +end subroutine getWinds + +end module ColumnSource_ml diff --git a/Convection_ml.f90 b/Convection_ml.f90 index 15fd2e4..3d93a44 100644 --- a/Convection_ml.f90 +++ b/Convection_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -68,7 +68,7 @@ subroutine convection_pstar(ps3d,dt_conv) do k=1,KMAX_MID dk(k)=sigma_bnd(k+1)-sigma_bnd(k) - enddo + end do totdk=sigma_bnd(KMAX_MID+1)-sigma_bnd(1)!=1 in sigma coordinates !UPWARD @@ -84,12 +84,12 @@ subroutine convection_pstar(ps3d,dt_conv) ! do k=1,KMAX_MID mass=mass+ps3d(i,j,k)*dk(k) - enddo + end do mass=mass/totdk do k=1,KMAX_MID dp(k)=dA(k)+dB(k)*ps(i,j,1) - enddo + end do mass_air_core=0.0 do k=KMAX_MID,1,-1 @@ -109,7 +109,7 @@ subroutine convection_pstar(ps3d,dt_conv) mass_air_core(k+1)=0.0 xn_in_core(:,k) =xn_in_core(:,k1)*dp(k+1)/dp(k)!flux from below xn_in_core(:,k+1) =0.0 - endif + end if !fraction of grid moved to core: ! df/(dp/g) df=horizontal flux dp/g= total mass (/m2) in grid @@ -125,12 +125,12 @@ subroutine convection_pstar(ps3d,dt_conv) !limit fluxes cnvuf(i,j,k+1)=0.99*dp(k)/(GRAV*dt_conv)+cnvuf(i,j,k+1)!0.99 to determine mass_exchanged=(cnvuf(i,j,k+1)-cnvuf(i,j,k))*GRAV*dt_conv/dp(k)*mass_air_grid(k) - endif + end if else !mass from core to grid - horizontal exchange mass_exchanged=(cnvuf(i,j,k+1)-cnvuf(i,j,k))/cnvuf(i,j,k+1)*mass_air_core(k) - endif + end if !horizontal exchange if(cnvuf(i,j,k+1)-cnvuf(i,j,k)<=0.0)then @@ -148,9 +148,9 @@ subroutine convection_pstar(ps3d,dt_conv) xn_in_core(:,k) = xn_in_core(:,k)-(cnvuf(i,j,k+1)-cnvuf(i,j,k))/cnvuf(i,j,k+1)*xn_in_core(:,k) mass_air_core(k)=mass_air_core(k)-mass_exchanged mass_air_grid(k) = mass_air_grid(k)+mass_exchanged - endif + end if - enddo + end do !DOWNWARD if(.true.)then @@ -170,7 +170,7 @@ subroutine convection_pstar(ps3d,dt_conv) mass_air_core(k-1)=0.0 xn_in_core(:,k) = xn_in_core(:,k-1)*dp(k-1)/dp(k)!flux from above xn_in_core(:,k-1) =0.0 - endif + end if if(cnvdf(i,j,k+1)-cnvdf(i,j,k)<=0.0)then !mass from grid to core - horizontal exchange @@ -179,11 +179,11 @@ subroutine convection_pstar(ps3d,dt_conv) !limit fluxes cnvdf(i,j,k+1)=-0.99*dp(k)/(GRAV*dt_conv)+cnvdf(i,j,k)!0.99 to determine mass_exchanged=(cnvdf(i,j,k+1)-cnvdf(i,j,k))*mass_air_grid(k)*GRAV*dt_conv/dp(k) - endif + end if else !NB: cnvdf < 0 mass_exchanged=-(cnvdf(i,j,k+1)-cnvdf(i,j,k))/cnvdf(i,j,k)*mass_air_core(k) - endif + end if !horizontal exchange !NB: cnvdf < 0 @@ -203,11 +203,11 @@ subroutine convection_pstar(ps3d,dt_conv) mass_air_grid(k) = mass_air_grid(k)+mass_exchanged - endif + end if - enddo + end do - endif + end if if(.true.)then !diffusion free method @@ -226,7 +226,7 @@ subroutine convection_pstar(ps3d,dt_conv) mass_air_grid_k_temp=mass_air_grid_k_temp+mass_air_grid(k_fill)*dk(k_fill) mass_air_grid(k_fill)=mass_air_grid(k_fill)-mass_air_grid(k_fill)!ZERO k_fill=k_fill+1 - enddo + end do xn_buff(:,k)=xn_buff(:,k)+ xn_adv(:,i,j,k_fill)*dk(k_fill)*& (mass_air_grid0(k)*dk(k)-mass_air_grid_k_temp)/(mass_air_grid(k_fill)*dk(k_fill)) @@ -239,23 +239,23 @@ subroutine convection_pstar(ps3d,dt_conv) ps3d(i,j,k) = mass_air_grid0(k)!=(mass_air_grid_k_temp+(mass_air_grid0(k)*dk(k)-mass_air_grid_k_temp))/dk(k) - enddo + end do do k=1,KMAX_MID xn_adv(:,i,j,k)=xn_buff(:,k)/dk(k) - enddo + end do !check that all mass is distributed ! if(abs(mass_air_grid(k_fill))>1.0.or.k_fill/=KMAX_MID)then ! if(ME==0)write(*,*)'ERRORMASS',ME,i,j,k_fill,mass_air_grid(k_fill),mass_air_grid_k_temp,mass_air_grid0(k) -! endif +! end if else do k=1,KMAX_MID ps3d(i,j,k) = mass_air_grid(k) - enddo + end do - endif + end if - enddo - enddo + end do + end do end subroutine convection_pstar subroutine convection_Eta(dpdeta,dt_conv) @@ -276,7 +276,7 @@ subroutine convection_Eta(dpdeta,dt_conv) do k=1,KMAX_MID dk(k)=dA(k)/Pref+dB(k) totdk=totdk+dk(k) - enddo + end do !UPWARD @@ -291,12 +291,12 @@ subroutine convection_Eta(dpdeta,dt_conv) ! do k=1,KMAX_MID mass=mass+dpdeta(i,j,k)*dk(k) - enddo + end do mass=mass/totdk do k=1,KMAX_MID dp(k)=dA(k)+dB(k)*ps(i,j,1) - enddo + end do mass_air_core=0.0 do k=KMAX_MID,1,-1 @@ -316,7 +316,7 @@ subroutine convection_Eta(dpdeta,dt_conv) mass_air_core(k+1)=0.0 xn_in_core(:,k) =xn_in_core(:,k1)*dp(k+1)/dp(k)!flux from below xn_in_core(:,k+1) =0.0 - endif + end if !fraction of grid moved to core: ! df/(dp/g) df=horizontal flux dp/g= total mass (/m2) in grid @@ -332,12 +332,12 @@ subroutine convection_Eta(dpdeta,dt_conv) !limit fluxes cnvuf(i,j,k+1)=0.99*dp(k)/(GRAV*dt_conv)+cnvuf(i,j,k+1)!0.99 to determine mass_exchanged=(cnvuf(i,j,k+1)-cnvuf(i,j,k))*GRAV*dt_conv/dp(k)*mass_air_grid(k) - endif + end if else !mass from core to grid - horizontal exchange mass_exchanged=(cnvuf(i,j,k+1)-cnvuf(i,j,k))/cnvuf(i,j,k+1)*mass_air_core(k) - endif + end if !horizontal exchange if(cnvuf(i,j,k+1)-cnvuf(i,j,k)<=0.0)then @@ -355,9 +355,9 @@ subroutine convection_Eta(dpdeta,dt_conv) xn_in_core(:,k) = xn_in_core(:,k)-(cnvuf(i,j,k+1)-cnvuf(i,j,k))/cnvuf(i,j,k+1)*xn_in_core(:,k) mass_air_core(k)=mass_air_core(k)-mass_exchanged mass_air_grid(k) = mass_air_grid(k)+mass_exchanged - endif + end if - enddo + end do !DOWNWARD if(.true.)then @@ -377,7 +377,7 @@ subroutine convection_Eta(dpdeta,dt_conv) mass_air_core(k-1)=0.0 xn_in_core(:,k) = xn_in_core(:,k-1)*dp(k-1)/dp(k)!flux from above xn_in_core(:,k-1) =0.0 - endif + end if if(cnvdf(i,j,k+1)-cnvdf(i,j,k)<=0.0)then !mass from grid to core - horizontal exchange @@ -386,11 +386,11 @@ subroutine convection_Eta(dpdeta,dt_conv) !limit fluxes cnvdf(i,j,k+1)=-0.99*dp(k)/(GRAV*dt_conv)+cnvdf(i,j,k)!0.99 to determine mass_exchanged=(cnvdf(i,j,k+1)-cnvdf(i,j,k))*mass_air_grid(k)*GRAV*dt_conv/dp(k) - endif + end if else !NB: cnvdf < 0 mass_exchanged=-(cnvdf(i,j,k+1)-cnvdf(i,j,k))/cnvdf(i,j,k)*mass_air_core(k) - endif + end if !horizontal exchange !NB: cnvdf < 0 @@ -410,11 +410,11 @@ subroutine convection_Eta(dpdeta,dt_conv) mass_air_grid(k) = mass_air_grid(k)+mass_exchanged - endif + end if - enddo + end do - endif + end if if(.true.)then !diffusion free method @@ -433,7 +433,7 @@ subroutine convection_Eta(dpdeta,dt_conv) mass_air_grid_k_temp=mass_air_grid_k_temp+mass_air_grid(k_fill)*dk(k_fill) mass_air_grid(k_fill)=mass_air_grid(k_fill)-mass_air_grid(k_fill)!ZERO k_fill=k_fill+1 - enddo + end do xn_buff(:,k)=xn_buff(:,k)+ xn_adv(:,i,j,k_fill)*dk(k_fill)*& (mass_air_grid0(k)*dk(k)-mass_air_grid_k_temp)/(mass_air_grid(k_fill)*dk(k_fill)) @@ -446,23 +446,23 @@ subroutine convection_Eta(dpdeta,dt_conv) dpdeta(i,j,k) = mass_air_grid0(k)!=(mass_air_grid_k_temp+(mass_air_grid0(k)*dk(k)-mass_air_grid_k_temp))/dk(k) - enddo + end do do k=1,KMAX_MID xn_adv(:,i,j,k)=xn_buff(:,k)/dk(k) - enddo + end do !check that all mass is distributed ! if(abs(mass_air_grid(k_fill))>1.0.or.k_fill/=KMAX_MID)then ! if(ME==0)write(*,*)'ERRORMASS',ME,i,j,k_fill,mass_air_grid(k_fill),mass_air_grid_k_temp,mass_air_grid0(k) -! endif +! end if else do k=1,KMAX_MID dpdeta(i,j,k) = mass_air_grid(k) - enddo + end do - endif + end if - enddo - enddo + end do + end do end subroutine convection_Eta end module Convection_ml diff --git a/Country_ml.f90 b/Country_ml.f90 index 9954c6a..31630d0 100644 --- a/Country_ml.f90 +++ b/Country_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -49,10 +49,10 @@ module Country_ml implicit none - public :: Country_Init ! sets country details - public :: Country_test ! just to test numbering + public :: init_Country ! sets country details + public :: self_test ! just to test numbering - integer, parameter, public :: MAXNLAND = 350 ! max number of countries + integer, parameter, public :: MAXNLAND = 400 ! max number of countries integer, public :: NLAND ! actaua number of countries defined logical, parameter, private :: T = .true. ! shorthand logical, parameter, private :: F = .false. ! shorthand @@ -74,10 +74,11 @@ module Country_ml EUMACC2(41) = (/ EEA, XMACC2 /) - !/ to be set in Country_Init: + !/ to be set in init_Country: type, public :: cc character(len=10) :: code ! up to 3 letter land code + character(len=4) :: gains ! 4 letter GAINS code integer :: icode ! integer number for land code (corresponds to ! country code number in emission files) logical :: is_sea ! 1 for sea area, 0 otherwise @@ -211,7 +212,7 @@ module Country_ml integer, public :: IC_EGYP ! Egypt integer, public :: IC_HANO ! Hanoi integer, public :: IC_NVIE ! North Vietnam -integer, public :: IC_RVIE ! Rest of Vietnam +integer, public :: IC_SVIE ! South Vietnam integer, public :: IC_BOLV ! Bolivia integer, public :: IC_CARB ! Caribbean integer, public :: IC_CEAM ! Central America @@ -221,6 +222,10 @@ module Country_ml integer, public :: IC_PERU ! Peru integer, public :: IC_URUG ! Uruguay integer, public :: IC_VENE ! Venezuela +integer, public :: IC_IRAN ! Iran +integer, public :: IC_SAAR ! Saudi Arabia +integer, public :: IC_KOSO ! Kosovo +integer, public :: IC_OCEC ! Oceania ! extra subdivisions of ship emissions into shipping categories: ! Baltic Sea (30) @@ -320,6 +325,9 @@ module Country_ml ! NH3Emis x=44-75, y=35-66 integer, public :: IC_NMR ! EMEP NMR-NH3 temporal emissions + ! 199 not country-specific land based emissions -found in PANHAM/MEIC + integer, public :: IC_LANDX ! 199 not country-specific land based emissions + ! HTAP2 regions integer, public :: IC_HTNATL integer, public :: IC_HTUSCA @@ -342,9 +350,101 @@ module Country_ml integer, public :: IC_HT1020 integer, public :: IC_HT1000 +! UNEP SR regions + integer, public :: IC_BANG_DHAK + integer, public :: IC_BANG_REST + integer, public :: IC_CHIN_ANHU + integer, public :: IC_CHIN_BEIJ + integer, public :: IC_CHIN_CHON + integer, public :: IC_CHIN_FUJI + integer, public :: IC_CHIN_GANS + integer, public :: IC_CHIN_GUAD + integer, public :: IC_CHIN_GUAX + integer, public :: IC_CHIN_GUIZ + integer, public :: IC_CHIN_HAIN + integer, public :: IC_CHIN_HEBE + integer, public :: IC_CHIN_HEIL + integer, public :: IC_CHIN_HENA + integer, public :: IC_CHIN_HONG + integer, public :: IC_CHIN_HUBE + integer, public :: IC_CHIN_HUNA + integer, public :: IC_CHIN_JILI + integer, public :: IC_CHIN_JINU + integer, public :: IC_CHIN_JINX + integer, public :: IC_CHIN_LIAO + integer, public :: IC_CHIN_NEMO + integer, public :: IC_CHIN_NINX + integer, public :: IC_CHIN_QING + integer, public :: IC_CHIN_SHAA + integer, public :: IC_CHIN_SHAN + integer, public :: IC_CHIN_SHND + integer, public :: IC_CHIN_SHNX + integer, public :: IC_CHIN_SICH + integer, public :: IC_CHIN_TIAN + integer, public :: IC_CHIN_TIBE + integer, public :: IC_CHIN_XING + integer, public :: IC_CHIN_YUNN + integer, public :: IC_CHIN_ZHEJ + integer, public :: IC_INDI_ANPR + integer, public :: IC_INDI_ASSA + integer, public :: IC_INDI_BENG + integer, public :: IC_INDI_BIHA + integer, public :: IC_INDI_CHHA + integer, public :: IC_INDI_DELH + integer, public :: IC_INDI_EHIM + integer, public :: IC_INDI_GOA + integer, public :: IC_INDI_GUJA + integer, public :: IC_INDI_HARY + integer, public :: IC_INDI_HIPR + integer, public :: IC_INDI_JHAR + integer, public :: IC_INDI_KARN + integer, public :: IC_INDI_KERA + integer, public :: IC_INDI_MAHA + integer, public :: IC_INDI_MAPR + integer, public :: IC_INDI_ORIS + integer, public :: IC_INDI_PUNJ + integer, public :: IC_INDI_RAJA + integer, public :: IC_INDI_TAMI + integer, public :: IC_INDI_UTAN + integer, public :: IC_INDI_UTPR + integer, public :: IC_INDI_WHIM + integer, public :: IC_INDO_JAKA + integer, public :: IC_INDO_JAVA + integer, public :: IC_INDO_REST + integer, public :: IC_INDO_SUMA + integer, public :: IC_JAPA_CHSH + integer, public :: IC_JAPA_CHUB + integer, public :: IC_JAPA_HOTO + integer, public :: IC_JAPA_KANT + integer, public :: IC_JAPA_KINK + integer, public :: IC_JAPA_KYOK + integer, public :: IC_KORS_NORT + integer, public :: IC_KORS_PUSA + integer, public :: IC_KORS_SEOI + integer, public :: IC_KORS_SOUT + integer, public :: IC_MALA_KUAL + integer, public :: IC_MALA_PENM + integer, public :: IC_MALA_SASA + integer, public :: IC_PAKI_KARA + integer, public :: IC_PAKI_NMWP + integer, public :: IC_PAKI_PUNJ + integer, public :: IC_PAKI_SIND + integer, public :: IC_PHIL_BVMI + integer, public :: IC_PHIL_LUZO + integer, public :: IC_PHIL_MANI + integer, public :: IC_RUSS_ASIA + integer, public :: IC_RUSS_EURO + integer, public :: IC_THAI_BANG + integer, public :: IC_THAI_CVAL + integer, public :: IC_THAI_NEPL + integer, public :: IC_THAI_NHIG + integer, public :: IC_THAI_SPEN + integer, public :: IC_IRAN_REST + integer, public :: IC_IRAN_TEHR + contains - subroutine Country_Init() + subroutine init_Country() ! Set the country details. Note that time-zones for some areas are either ! difficult (e.g. Russia should be 3 to 12) or not relevant (e.g. sea areas, @@ -354,8 +454,8 @@ subroutine Country_Init() ! First define all countries as undefined do iland=1,NLAND - Country(iland) = cc( "N/A" , iland ,F, 17 , 0 , "Not_defined " ) - enddo + Country(iland) = cc( "N/A" ,'-', iland ,F, 17 , 0 , "Not_defined " ) + end do !The value of IC_XX is the index in Country array. Can in principle change between two runs or versions. !The emission_code is the country code used in the emission file. @@ -366,680 +466,974 @@ subroutine Country_Init() ix=0 ix=ix+1 IC_AL=ix -Country( IC_AL ) = cc( "AL " , 1 ,F, 1, 1 , "Albania " ) +Country( IC_AL ) = cc( "AL ",'ALBA', 1 ,F, 1, 1 , "Albania " ) ix=ix+1 IC_AT=ix -Country( IC_AT ) = cc( "AT " , 2 ,F, 2, 1 , "Austria " ) +Country( IC_AT ) = cc( "AT ",'AUST', 2 ,F, 2, 1 , "Austria " ) ix=ix+1 IC_BE=ix -Country( IC_BE ) = cc( "BE " , 3 ,F, 3, 1 , "Belgium " ) +Country( IC_BE ) = cc( "BE ",'BELG', 3 ,F, 3, 1 , "Belgium " ) ix=ix+1 IC_BG=ix -Country( IC_BG ) = cc( "BG " , 4 ,F, 4, 2 , "Bulgaria " ) +Country( IC_BG ) = cc( "BG ",'BULG', 4 ,F, 4, 2 , "Bulgaria " ) ix=ix+1 IC_FCS=ix -Country( IC_FCS ) = cc( "FCS " , 5 ,F, 5, 1 , "Former Czechoslovakia " ) +Country( IC_FCS ) = cc( "FCS ",'-', 5 ,F, 5, 1 , "Former Czechoslovakia " ) ix=ix+1 IC_DK=ix -Country( IC_DK ) = cc( "DK " , 6 ,F, 6, 1 , "Denmark " ) +Country( IC_DK ) = cc( "DK ",'DENM', 6 ,F, 6, 1 , "Denmark " ) ix=ix+1 IC_FI=ix -Country( IC_FI ) = cc( "FI " , 7 ,F, 7, 2 , "Finland " ) +Country( IC_FI ) = cc( "FI ",'FINL', 7 ,F, 7, 2 , "Finland " ) ix=ix+1 IC_FR=ix -Country( IC_FR ) = cc( "FR " , 8 ,F, 8, 1 , "France " ) +Country( IC_FR ) = cc( "FR ",'FRAN', 8 ,F, 8, 1 , "France " ) ix=ix+1 IC_GDR=ix -Country( IC_GDR) = cc( "GDR" , 9 ,F, 9, 1 , "Former East Germany " ) +Country( IC_GDR) = cc( "GDR",'-', 9 ,F, 9, 1 , "Former East Germany " ) ix=ix+1 IC_FRG=ix -Country( IC_FRG) = cc( "FRG" , 10 ,F, 10, 1 , "Former Fed. Rep. of Germany " ) +Country( IC_FRG) = cc( "FRG",'-', 10 ,F, 10, 1 , "Former Fed. Rep. of Germany " ) ix=ix+1 IC_GR=ix -Country( IC_GR ) = cc( "GR " , 11 ,F, 11, 2 , "Greece " ) +Country( IC_GR ) = cc( "GR ",'GREE', 11 ,F, 11, 2 , "Greece " ) ix=ix+1 IC_HU=ix -Country( IC_HU ) = cc( "HU " , 12 ,F, 12, 1 , "Hungary " ) +Country( IC_HU ) = cc( "HU ",'HUNG', 12 ,F, 12, 1 , "Hungary " ) ix=ix+1 IC_IS=ix -Country( IC_IS ) = cc( "IS " , 13 ,F, 13, 0 , "Iceland " ) +Country( IC_IS ) = cc( "IS ",'ICEL', 13 ,F, 13, 0 , "Iceland " ) ix=ix+1 IC_IE=ix -Country( IC_IE ) = cc( "IE " , 14 ,F, 14, 0 , "Ireland " ) +Country( IC_IE ) = cc( "IE ",'IREL', 14 ,F, 14, 0 , "Ireland " ) ix=ix+1 IC_IT=ix -Country( IC_IT ) = cc( "IT " , 15 ,F, 15, 1 , "Italy " ) +Country( IC_IT ) = cc( "IT ",'ITAL', 15 ,F, 15, 1 , "Italy " ) ix=ix+1 IC_LU=ix -Country( IC_LU ) = cc( "LU " , 16 ,F, 16, 1 , "Luxembourg " ) +Country( IC_LU ) = cc( "LU ",'LUXE', 16 ,F, 16, 1 , "Luxembourg " ) ix=ix+1 IC_NL=ix -Country( IC_NL ) = cc( "NL " , 17 ,F, 17, 1 , "Netherlands " ) +Country( IC_NL ) = cc( "NL ",'NETH', 17 ,F, 17, 1 , "Netherlands " ) ix=ix+1 IC_NO=ix -Country( IC_NO ) = cc( "NO " , 18 ,F, 18, 1 , "Norway " ) +Country( IC_NO ) = cc( "NO ",'NORW', 18 ,F, 18, 1 , "Norway " ) ix=ix+1 IC_PL=ix -Country( IC_PL ) = cc( "PL " , 19 ,F, 19, 1 , "Poland " ) +Country( IC_PL ) = cc( "PL ",'POLA', 19 ,F, 19, 1 , "Poland " ) ix=ix+1 IC_PT=ix -Country( IC_PT ) = cc( "PT " , 20 ,F, 20, 0 , "Portugal " ) +Country( IC_PT ) = cc( "PT ",'PORT', 20 ,F, 20, 0 , "Portugal " ) ix=ix+1 IC_RO=ix -Country( IC_RO ) = cc( "RO " , 21 ,F, 21, 2 , "Romania " ) +Country( IC_RO ) = cc( "RO ",'ROMA', 21 ,F, 21, 2 , "Romania " ) ix=ix+1 IC_ES =ix -Country( IC_ES ) = cc( "ES " , 22 ,F, 22, 1 , "Spain " ) +Country( IC_ES ) = cc( "ES ",'SPAI', 22 ,F, 22, 1 , "Spain " ) ix=ix+1 IC_SE=ix -Country( IC_SE ) = cc( "SE " , 23 ,F, 23, 1 , "Sweden " ) +Country( IC_SE ) = cc( "SE ",'SWED', 23 ,F, 23, 1 , "Sweden " ) ix=ix+1 IC_CH=ix -Country( IC_CH ) = cc( "CH " , 24 ,F, 24, 1 , "Switzerland " ) +Country( IC_CH ) = cc( "CH ",'SWIT', 24 ,F, 24, 1 , "Switzerland " ) ix=ix+1 IC_TR=ix -Country( IC_TR ) = cc( "TR " , 25 ,F, 25, 2 , "Turkey " ) +Country( IC_TR ) = cc( "TR ",'TURK', 25 ,F, 25, 2 , "Turkey " ) ix=ix+1 IC_SU=ix -Country( IC_SU ) = cc( "SU " , 26 ,F, 26, -100 , "Former USSR " ) +Country( IC_SU ) = cc( "SU ",'-', 26 ,F, 26, -100 , "Former USSR " ) ix=ix+1 IC_GB=ix -Country( IC_GB ) = cc( "GB " , 27 ,F, 27, 0 , "United Kingdom " ) +Country( IC_GB ) = cc( "GB " ,'UNKI', 27 ,F, 27, 0 , "United Kingdom " ) ix=ix+1 IC_VUL=ix -Country( IC_VUL) = cc( "VUL" , 28 ,F, 28, 1 , "Volcanoes " ) +Country( IC_VUL) = cc( "VUL" ,'-', 28 ,F, 28, 1 , "Volcanoes " ) ix=ix+1 IC_REM=ix -Country( IC_REM) = cc( "REM" , 29 ,F, 29, 1 , "Remaining land areas " ) +Country( IC_REM) = cc( "REM" ,'-', 29 ,F, 29, 1 , "Remaining land areas " ) !NB: -!Fix needed for following sea-areas (BAS,NOS,ATL,MED,BLS)in GEA runs done in Emissions_ml +!Fix needed for following sea-areas (BAS,'-',NOS,ATL,MED,BLS)in GEA runs done in Emissions_ml !if ( DomainName == "HIRHAM" .and. IIFULLDOM == 182 ) then ! Special fix for HIRHAM/GEA !if ( SEAFIX_GEA_NEEDED ) then ! Special fix for HIRHAM/GEA ix=ix+1 IC_BAS=ix -Country( IC_BAS) = cc( "BAS" , 30 ,T, 30, 1 , "The Baltic Sea " ) +Country( IC_BAS) = cc( "BAS" ,'-', 30 ,T, 30, 1 , "The Baltic Sea " ) ix=ix+1 IC_NOS=ix -Country( IC_NOS) = cc( "NOS" , 31 ,T, 31, 1 , "The North Sea " ) +Country( IC_NOS) = cc( "NOS" ,'-', 31 ,T, 31, 1 , "The North Sea " ) ix=ix+1 IC_ATL=ix -Country( IC_ATL) = cc( "ATL" , 32 ,T, 32, -100 , "Remaining NE Atlantic Ocean " ) +Country( IC_ATL) = cc( "ATL" ,'-', 32 ,T, 32, -100 , "Remaining NE Atlantic Ocean " ) ix=ix+1 IC_MED=ix -Country( IC_MED) = cc( "MED" , 33 ,T, 33, 1 , "The Mediterranean Sea " ) +Country( IC_MED) = cc( "MED" ,'-', 33 ,T, 33, 1 , "The Mediterranean Sea " ) ix=ix+1 IC_BLS=ix -Country( IC_BLS) = cc( "BLS" , 34 ,T, 34, 2 , "The Black Sea " ) +Country( IC_BLS) = cc( "BLS" ,'-', 34 ,T, 34, 2 , "The Black Sea " ) !end if ! HIRHAM/GEA fix ix=ix+1 IC_NAT=ix -Country( IC_NAT) = cc( "NAT" , 35 ,F, 35, -100 , "Natural marine sources " ) +Country( IC_NAT) = cc( "NAT",'-', 35 ,F, 35, -100 , "Natural marine sources " ) ix=ix+1 IC_RUO=ix -Country( IC_RUO) = cc( "RUO" , 36 ,F, 36, 4 , "Kola/Karelia " ) +Country( IC_RUO) = cc( "RUO",'KOLK', 36 ,F, 36, 4 , "Kola/Karelia " ) ix=ix+1 IC_RUP=ix -Country( IC_RUP) = cc( "RUP" , 37 ,F, 37, 4 , "St.Petersburg/Novgorod-Pskov " ) +! Not sure about GAINS code: +Country( IC_RUP) = cc( "RUP",'RUSS', 37 ,F, 37, 4 , "St.Petersburg/Novgorod-Pskov " ) ix=ix+1 IC_RUA=ix -Country( IC_RUA) = cc( "RUA" , 38 ,F, 38, 3 , "Kaliningrad " ) +Country( IC_RUA) = cc( "RUA",'KALI', 38 ,F, 38, 3 , "Kaliningrad " ) ix=ix+1 IC_BY=ix -Country( IC_BY ) = cc( "BY " , 39 ,F, 39, 3 , "Belarus " ) +Country( IC_BY ) = cc( "BY ",'BELA', 39 ,F, 39, 3 , "Belarus " ) ix=ix+1 IC_UA=ix -Country( IC_UA ) = cc( "UA " , 40 ,F, 40, 2 , "Ukraine " ) +Country( IC_UA ) = cc( "UA ",'UKRA', 40 ,F, 40, 2 , "Ukraine " ) ix=ix+1 IC_MD=ix -Country( IC_MD ) = cc( "MD " , 41 ,F, 41, 2 , "Moldova, Republic of " ) +Country( IC_MD ) = cc( "MD ",'MOLD', 41 ,F, 41, 2 , "Moldova, Republic of " ) ix=ix+1 IC_RUR=ix -Country( IC_RUR) = cc( "RUR" , 42 ,F, 42, 4 , "Rest of Russia " ) +!Could also be REMR for GAINS +Country( IC_RUR) = cc( "RUR",'RUSS', 42 ,F, 42, 4 , "Rest of Russia " ) ix=ix+1 IC_EE=ix -Country( IC_EE ) = cc( "EE " , 43 ,F, 43, 2 , "Estonia " ) +Country( IC_EE ) = cc( "EE ",'ESTO', 43 ,F, 43, 2 , "Estonia " ) ix=ix+1 IC_LV=ix -Country( IC_LV ) = cc( "LV " , 44 ,F, 44, 2 , "Latvia " ) +Country( IC_LV ) = cc( "LV ",'LATV', 44 ,F, 44, 2 , "Latvia " ) ix=ix+1 IC_LT=ix -Country( IC_LT ) = cc( "LT " , 45 ,F, 45, 2 , "Lithuania " ) +Country( IC_LT ) = cc( "LT ",'LITH', 45 ,F, 45, 2 , "Lithuania " ) ix=ix+1 IC_CZ=ix -Country( IC_CZ ) = cc( "CZ " , 46 ,F, 46, 1 , "Czech " ) +Country( IC_CZ ) = cc( "CZ ",'CZRE', 46 ,F, 46, 1 , "Czech " ) ix=ix+1 IC_SK=ix -Country( IC_SK ) = cc( "SK " , 47 ,F, 47, 1 , "Slovakia " ) +Country( IC_SK ) = cc( "SK ",'SKRE', 47 ,F, 47, 1 , "Slovakia " ) ix=ix+1 IC_SI=ix -Country( IC_SI ) = cc( "SI " , 48 ,F, 48, 1 , "Slovenia " ) +Country( IC_SI ) = cc( "SI ",'SLOV', 48 ,F, 48, 1 , "Slovenia " ) ix=ix+1 IC_HR=ix -Country( IC_HR ) = cc( "HR " , 49 ,F, 49, 1 , "Croatia " ) +Country( IC_HR ) = cc( "HR ",'CROA', 49 ,F, 49, 1 , "Croatia " ) ix=ix+1 IC_BA=ix -Country( IC_BA ) = cc( "BA " , 50 ,F, 50, 1 , "Bosnia and Herzegovina " ) +Country( IC_BA ) = cc( "BA ",'BOHE', 50 ,F, 50, 1 , "Bosnia and Herzegovina " ) ix=ix+1 IC_CS=ix -Country( IC_CS ) = cc( "CS " , 51 ,F, 51, 1 , "Serbia and Montenegro " ) +Country( IC_CS ) = cc( "CS ",'SEMO', 51 ,F, 51, 1 , "Serbia and Montenegro " ) ix=ix+1 IC_MK=ix -Country( IC_MK ) = cc( "MK " , 52 ,F, 52, 1 , "Macedonia, The F.Yugo.Rep. of " ) +Country( IC_MK ) = cc( "MK ",'MACE', 52 ,F, 52, 1 , "Macedonia, The F.Yugo.Rep. of " ) ix=ix+1 IC_KZ=ix -Country( IC_KZ ) = cc( "KZ " , 53 ,F, 53, -100 , "Kazakstan " ) +Country( IC_KZ ) = cc( "KZ ",'KAZA', 53 ,F, 53, -100 , "Kazakstan " ) ix=ix+1 IC_GE=ix -Country( IC_GE ) = cc( "GE " , 54 ,F, 54, 4 , "Georgia " ) +Country( IC_GE ) = cc( "GE ",'GEOR', 54 ,F, 54, 4 , "Georgia " ) ix=ix+1 IC_CY=ix -Country( IC_CY ) = cc( "CY " , 55 ,F, 55, 2 , "Cyprus " ) +Country( IC_CY ) = cc( "CY ",'CYPR', 55 ,F, 55, 2 , "Cyprus " ) ix=ix+1 IC_AM =ix -Country( IC_AM ) = cc( "AM " , 56 ,F, 56, 4 , "Armenia " ) +Country( IC_AM ) = cc( "AM ",'ARME', 56 ,F, 56, 4 , "Armenia " ) ix=ix+1 IC_MT=ix -Country( IC_MT ) = cc( "MT " , 57 ,F, 57, 1 , "Malta " ) +Country( IC_MT ) = cc( "MT ",'MALT', 57 ,F, 57, 1 , "Malta " ) ix=ix+1 IC_ASI=ix -Country( IC_ASI) = cc( "ASI" , 58 ,F, 58, -100 , "Other Asian areas " ) +Country( IC_ASI) = cc( "ASI" ,'-', 58 ,F, 58, -100 , "Other Asian areas " ) ix=ix+1 IC_LI=ix -Country( IC_LI ) = cc( "LI " , 59 ,F, 59, 1 , "Lichtenstein " ) +Country( IC_LI ) = cc( "LI " ,'-', 59 ,F, 59, 1 , "Lichtenstein " ) ix=ix+1 IC_DE=ix -Country( IC_DE ) = cc( "DE " , 60 ,F, 60, 1 , "Germany " ) +Country( IC_DE ) = cc( "DE ",'GERM', 60 ,F, 60, 1 , "Germany " ) ix=ix+1 IC_RU=ix -Country( IC_RU ) = cc( "RU " , 61 ,F, 61, -100 , "Russian Federation " ) +Country( IC_RU ) = cc( "RU " ,'RUSS', 61 ,F, 61, -100 , "Russian Federation " ) ix=ix+1 IC_MC=ix -Country( IC_MC ) = cc( "MC " , 62 ,F, 62, 1 , "Monaco " ) +Country( IC_MC ) = cc( "MC " ,'-', 62 ,F, 62, 1 , "Monaco " ) ix=ix+1 IC_NOA=ix -Country( IC_NOA) = cc( "NOA" , 63 ,F, 63, 1 , "North Africa " ) +Country( IC_NOA) = cc( "NOA" ,'-', 63 ,F, 63, 1 , "North Africa " ) ix=ix+1 IC_EU=ix -Country( IC_EU ) = cc( "EU " , 64 ,F, 64, 1 , "European Community " ) +Country( IC_EU ) = cc( "EU " ,'-', 64 ,F, 64, 1 , "European Community " ) ix=ix+1 IC_US=ix -Country( IC_US ) = cc( "US " , 65 ,F, 65, -100 , "USA " ) +Country( IC_US ) = cc( "US " ,'-', 65 ,F, 65, -100 , "USA " ) ix=ix+1 IC_CA=ix -Country( IC_CA ) = cc( "CA " , 66 ,F, 66, -100 , "Canada " ) +Country( IC_CA ) = cc( "CA " ,'-', 66 ,F, 66, -100 , "Canada " ) ix=ix+1 IC_DUMMY1=ix Country( IC_DUMMY1 ) & - = cc( "N/A" , 67 ,F, 67, -100 , "Not_defined " ) + = cc( "N/A" ,'-', 67 ,F, 67, -100 , "Not_defined " ) ix=ix+1 IC_KG=ix -Country( IC_KG ) = cc( "KG " , 68 ,F, 68, 6 , "Kyrgyzstan " ) +Country( IC_KG ) = cc( "KG " ,'-', 68 ,F, 68, 6 , "Kyrgyzstan " ) ix=ix+1 IC_AZ=ix -Country( IC_AZ ) = cc( "AZ " , 69 ,F, 69, 4 , "Azerbaijan " ) +Country( IC_AZ ) = cc( "AZ " ,'-', 69 ,F, 69, 4 , "Azerbaijan " ) ix=ix+1 IC_ATX=ix -Country( IC_ATX) = cc( "ATX" , 70 ,T, 32, -100 , "Atlantic outside. EMEP " ) +Country( IC_ATX) = cc( "ATX" ,'-', 70 ,T, 32, -100 , "Atlantic outside. EMEP " ) ix=ix+1 IC_RUX=ix -Country( IC_RUX) = cc( "RUX" , 71 ,F, 42, -100 , "Russian Fed. outside emep " ) +Country( IC_RUX) = cc( "RUX" ,'-', 71 ,F, 42, -100 , "Russian Fed. outside emep " ) ix=ix+1 IC_RS=ix -Country( IC_RS) = cc( "RS " , 72 ,F, 72, 1 , "Serbia " ) +Country( IC_RS) = cc( "RS " ,'-', 72 ,F, 72, 1 , "Serbia " ) ix=ix+1 IC_ME=ix -Country( IC_ME) = cc( "ME " , 73 ,F, 73, 1 , "Montenegro " ) +Country( IC_ME) = cc( "ME " ,'-', 73 ,F, 73, 1 , "Montenegro " ) ! Extended EMEP domain ix=ix+1 IC_RFE=ix -Country( IC_RFE ) = cc( "RFE" , 74 ,F, 74, -100 , "Rest of extended Russian Federation (in the extended EMEP domain)" ) +Country( IC_RFE ) = cc( "RFE" ,'-', 74 ,F, 74, -100 , "Rest of extended Russian Federation (in the extended EMEP domain)" ) ix=ix+1 IC_KZE=ix -Country( IC_KZE ) = cc( "KZE" , 75 ,F, 75, -100 , "Rest of Kazakhstan (in the extended EMEP domain) " ) +Country( IC_KZE ) = cc( "KZE" ,'-', 75 ,F, 75, -100 , "Rest of Kazakhstan (in the extended EMEP domain) " ) ix=ix+1 IC_UZ=ix -Country( IC_UZ ) = cc( "UZ" , 76 ,F, 76, -100 , "Uzbekistan (in the original EMEP domain) " ) +Country( IC_UZ ) = cc( "UZ" ,'-', 76 ,F, 76, -100 , "Uzbekistan (in the original EMEP domain) " ) ix=ix+1 IC_TM=ix -Country( IC_TM ) = cc( "TM" , 77 ,F, 77, -100 , "Turkmenistan (in the original EMEP domain) " ) +Country( IC_TM ) = cc( "TM" ,'-', 77 ,F, 77, -100 , "Turkmenistan (in the original EMEP domain) " ) ix=ix+1 IC_UZE=ix -Country( IC_UZE ) = cc( "UZE" , 78 ,F, 78, -100 , "Rest of Uzbekistan (in the extended EMEP domain) " ) +Country( IC_UZE ) = cc( "UZE" ,'-', 78 ,F, 78, -100 , "Rest of Uzbekistan (in the extended EMEP domain) " ) ix=ix+1 IC_TME=ix -Country( IC_TME ) = cc( "TME" , 79 ,F, 79, -100 , "Rest of Turkmenistan (in the extended EMEP domain) " ) +Country( IC_TME ) = cc( "TME" ,'-', 79 ,F, 79, -100 , "Rest of Turkmenistan (in the extended EMEP domain) " ) ix=ix+1 IC_CAS=ix -Country( IC_CAS ) = cc( "CAS" , 80 ,F, 80, -100 , "Caspian Sea (in the original EMEP domain) " ) +Country( IC_CAS ) = cc( "CAS" ,'-', 80 ,F, 80, -100 , "Caspian Sea (in the original EMEP domain) " ) ix=ix+1 IC_TJ=ix -Country( IC_TJ ) = cc( "TJ" , 81 ,F, 81, -100 ,"Tajikistan (in the extended EMEP domain) " ) +Country( IC_TJ ) = cc( "TJ" ,'-', 81 ,F, 81, -100 ,"Tajikistan (in the extended EMEP domain) " ) ix=ix+1 IC_ARL=ix -Country( IC_ARL ) = cc( "ARL" , 82 ,F, 82, -100 , "Aral Lake (in the original EMEP domain) " ) +Country( IC_ARL ) = cc( "ARL" ,'-', 82 ,F, 82, -100 , "Aral Lake (in the original EMEP domain) " ) ix=ix+1 IC_ARE=ix -Country( IC_ARE ) = cc( "ARE" , 83 ,F, 83, -100 , "Rest of Aral Lake (in the extended EMEP domain) " ) +Country( IC_ARE ) = cc( "ARE" ,'-', 83 ,F, 83, -100 , "Rest of Aral Lake (in the extended EMEP domain) " ) ix=ix+1 IC_ASM=ix -Country( IC_ASM ) = cc( "ASM" , 84 ,F, 84, -100 , "Modified remaining Asian areas (in the original EMEP domain) " ) +Country( IC_ASM ) = cc( "ASM" ,'-', 84 ,F, 84, -100 , "Modified remaining Asian areas (in the original EMEP domain) " ) ix=ix+1 IC_ASE=ix -Country( IC_ASE ) = cc( "ASE" , 85 ,F, 85, -100 , "Remaining extended Asian areas (in the extended EMEP domain) " ) +Country( IC_ASE ) = cc( "ASE" ,'-', 85 ,F, 85, -100 , "Remaining extended Asian areas (in the extended EMEP domain) " ) ix=ix+1 IC_AOE=ix -Country( IC_AOE ) = cc( "AOE" , 86 ,F, 86, -100 , "Arctic Ocean (in the extended EMEP domain) " ) +Country( IC_AOE ) = cc( "AOE" ,'-', 86 ,F, 86, -100 , "Arctic Ocean (in the extended EMEP domain) " ) -! New external areas (outside the 132x159 grid), these are normally not used +! New external areas (outside the 132x159 grid),'-', these are normally not used ! a) Domains: x = 160-170 y = 1-132 and x = -16-0 y = 123-170 ix=ix+1 IC_RFX=ix -Country( IC_RFX ) = cc( "RFX" , 87 ,F, 87, -100 ,"Extended EMEP-external part of Russian Federation" ) +Country( IC_RFX ) = cc( "RFX" ,'-', 87 ,F, 87, -100 ,"Extended EMEP-external part of Russian Federation" ) ix=ix+1 IC_ASX=ix -Country( IC_ASX ) = cc( "ASX" , 88 ,F, 88, -100 ,"Extended EMEP-external part of Asia " ) +Country( IC_ASX ) = cc( "ASX" ,'-', 88 ,F, 88, -100 ,"Extended EMEP-external part of Asia " ) ix=ix+1 IC_PAX=ix -Country( IC_PAX ) = cc( "PAX" , 89 ,F, 89, -100 ,"Extended EMEP-external part of Pacific Ocean " ) +Country( IC_PAX ) = cc( "PAX" ,'-', 89 ,F, 89, -100 ,"Extended EMEP-external part of Pacific Ocean " ) ix=ix+1 IC_AOX=ix -Country( IC_AOX ) = cc( "AOX" , 90 ,F, 90, 9 ,"Extended EMEP-external part of Arctic Ocean " ) +Country( IC_AOX ) = cc( "AOX" ,'-', 90 ,F, 90, 9 ,"Extended EMEP-external part of Arctic Ocean " ) ! b) Domain x = -16-132 y = -11-0 (never used) ix=ix+1 IC_NAX=ix -Country( IC_NAX ) = cc( "NAX" , 91 ,F, 91, -100 ,"EMEP-external part of North Africa " ) +Country( IC_NAX ) = cc( "NAX" ,'-', 91 ,F, 91, -100 ,"EMEP-external part of North Africa " ) ix=ix+1 IC_KZT=ix -Country( IC_KZT ) = cc( "KZT" , 92 ,F, 92, -100 , "Kazakhstan (all)" ) +Country( IC_KZT ) = cc( "KZT" ,'-', 92 ,F, 92, -100 , "Kazakhstan (all)" ) ix=ix+1 IC_RUE=ix -Country( IC_RUE ) = cc( "RUE" , 93 ,F, 93, -100 , "Russian Federeation (all)" ) +Country( IC_RUE ) = cc( "RUE" ,'-', 93 ,F, 93, -100 , "Russian Federeation (all)" ) ix=ix+1 IC_UZT=ix -Country( IC_UZT ) = cc( "UZT" , 94 ,F, 94, -100 , "Uzbekistan (all)" ) +Country( IC_UZT ) = cc( "UZT" ,'-', 94 ,F, 94, -100 , "Uzbekistan (all)" ) ix=ix+1 IC_TMT=ix -Country( IC_TMT ) = cc( "TMT" , 95 ,F, 95, -100 , "Turkmenistan (all)" ) +Country( IC_TMT ) = cc( "TMT" ,'-', 95 ,F, 95, -100 , "Turkmenistan (all)" ) ! Biomass burning ix=ix+1 IC_BB=ix -Country( IC_BB) = cc( "BB ", 101,F, 101, -100 , "Biomass burning (wild) " ) +Country( IC_BB) = cc( "BB ",'-', 101,F, 101, -100 , "Biomass burning (wild) " ) + +! +ix=ix+1 +IC_LANDX=ix +Country( IC_LANDX) = cc( "LANDX ",'-', 199,F, 199, -100 , "not country-specific land based emissions" ) -! Sea areas split according to innside/outside 12 nautical mile zone, -! ferries/cargo ships, registred inside/outside EU +! Sea areas split according to innside/outside 12 nautical mile zone,'-', +! ferries/cargo ships,'-', registred inside/outside EU ix=ix+1 IC_BA2=ix -Country( IC_BA2 ) = cc( "BA2" ,302 ,T, 30, 1 , "Baltic EU cargo outs.12 " ) +Country( IC_BA2 ) = cc( "BA2" ,'-',302 ,T, 30, 1 , "Baltic EU cargo outs.12 " ) ix=ix+1 IC_BA3=ix -Country( IC_BA3 ) = cc( "BA3" ,303 ,T, 30, 1 , "Baltic ROW cargo outs. 12 " ) +Country( IC_BA3 ) = cc( "BA3" ,'-',303 ,T, 30, 1 , "Baltic ROW cargo outs. 12 " ) ix=ix+1 IC_BA4=ix -Country( IC_BA4 ) = cc( "BA4" ,304 ,T, 30, 1 , "Baltic EU cargo ins. 12 " ) +Country( IC_BA4 ) = cc( "BA4" ,'-',304 ,T, 30, 1 , "Baltic EU cargo ins. 12 " ) ix=ix+1 IC_BA5=ix -Country( IC_BA5 ) = cc( "BA5" ,305 ,T, 30, 1 , "Baltic ROW cargo ins. 12 " ) +Country( IC_BA5 ) = cc( "BA5" ,'-',305 ,T, 30, 1 , "Baltic ROW cargo ins. 12 " ) ix=ix+1 IC_BA6=ix -Country( IC_BA6 ) = cc( "BA6" ,306 ,T, 30, 1 , "Baltic EU ferries outs.12 " ) +Country( IC_BA6 ) = cc( "BA6" ,'-',306 ,T, 30, 1 , "Baltic EU ferries outs.12 " ) ix=ix+1 IC_BA7=ix -Country( IC_BA7 ) = cc( "BA7" ,307 ,T, 30, 1 , "Baltic ROW ferries outs. 12 " ) +Country( IC_BA7 ) = cc( "BA7" ,'-',307 ,T, 30, 1 , "Baltic ROW ferries outs. 12 " ) ix=ix+1 IC_BA8=ix -Country( IC_BA8 ) = cc( "BA8" ,308 ,T, 30, 1 , "Baltic EU ferries ins. 12 " ) +Country( IC_BA8 ) = cc( "BA8" ,'-',308 ,T, 30, 1 , "Baltic EU ferries ins. 12 " ) ix=ix+1 IC_BA9=ix -Country( IC_BA9 ) = cc( "BA9" ,309 ,T, 30, 1 , "Baltic ROW ferries ins. 12 " ) +Country( IC_BA9 ) = cc( "BA9" ,'-',309 ,T, 30, 1 , "Baltic ROW ferries ins. 12 " ) ix=ix+1 IC_NS2=ix -Country( IC_NS2 ) = cc( "NS2" ,312 ,T, 31, 1 , "N. Sea EU cargo outs.12 " ) +Country( IC_NS2 ) = cc( "NS2" ,'-',312 ,T, 31, 1 , "N. Sea EU cargo outs.12 " ) ix=ix+1 IC_NS3=ix -Country( IC_NS3 ) = cc( "NS3" ,313 ,T, 31, 1 , "N. Sea ROW cargo outs. 12 " ) +Country( IC_NS3 ) = cc( "NS3" ,'-',313 ,T, 31, 1 , "N. Sea ROW cargo outs. 12 " ) ix=ix+1 IC_NS4=ix -Country( IC_NS4 ) = cc( "NS4" ,314 ,T, 31, 1 , "N. Sea EU cargo ins. 12 " ) +Country( IC_NS4 ) = cc( "NS4" ,'-',314 ,T, 31, 1 , "N. Sea EU cargo ins. 12 " ) ix=ix+1 IC_NS5=ix -Country( IC_NS5 ) = cc( "NS5" ,315 ,T, 31, 1 , "N. Sea ROW cargo ins. 12 " ) +Country( IC_NS5 ) = cc( "NS5" ,'-',315 ,T, 31, 1 , "N. Sea ROW cargo ins. 12 " ) ix=ix+1 IC_NS6=ix -Country( IC_NS6 ) = cc( "NS6" ,316 ,T, 31, 1 , "N. Sea EU ferries outs.12 " ) +Country( IC_NS6 ) = cc( "NS6" ,'-',316 ,T, 31, 1 , "N. Sea EU ferries outs.12 " ) ix=ix+1 IC_NS7=ix -Country( IC_NS7 ) = cc( "NS7" ,317 ,T, 31, 1 , "N. Sea ROW ferries outs. 12 " ) +Country( IC_NS7 ) = cc( "NS7" ,'-',317 ,T, 31, 1 , "N. Sea ROW ferries outs. 12 " ) ix=ix+1 IC_NS8=ix -Country( IC_NS8 ) = cc( "NS8" ,318 ,T, 31, 1 , "N. Sea EU ferries ins. 12 " ) +Country( IC_NS8 ) = cc( "NS8" ,'-',318 ,T, 31, 1 , "N. Sea EU ferries ins. 12 " ) ix=ix+1 IC_NS9=ix -Country( IC_NS9 ) = cc( "NS9" ,319 ,T, 31, 1 , "N. Sea ROW ferries ins. 12 " ) +Country( IC_NS9 ) = cc( "NS9" ,'-',319 ,T, 31, 1 , "N. Sea ROW ferries ins. 12 " ) ix=ix+1 IC_AT2=ix -Country( IC_AT2 ) = cc( "AT2" ,322 ,T, 32, 1 , "Atlant EU cargo outs.12 " ) +Country( IC_AT2 ) = cc( "AT2" ,'-',322 ,T, 32, 1 , "Atlant EU cargo outs.12 " ) ix=ix+1 IC_AT3=ix -Country( IC_AT3 ) = cc( "AT3" ,323 ,T, 32, 1 , "Atlant ROW cargo outs. 12 " ) +Country( IC_AT3 ) = cc( "AT3" ,'-',323 ,T, 32, 1 , "Atlant ROW cargo outs. 12 " ) ix=ix+1 IC_AT4=ix -Country( IC_AT4 ) = cc( "AT4" ,324 ,T, 32, 1 , "Atlant EU cargo ins. 12 " ) +Country( IC_AT4 ) = cc( "AT4" ,'-',324 ,T, 32, 1 , "Atlant EU cargo ins. 12 " ) ix=ix+1 IC_AT5=ix -Country( IC_AT5 ) = cc( "AT5" ,325 ,T, 32, 1 , "Atlant ROW cargo ins. 12 " ) +Country( IC_AT5 ) = cc( "AT5" ,'-',325 ,T, 32, 1 , "Atlant ROW cargo ins. 12 " ) ix=ix+1 IC_AT6=ix -Country( IC_AT6 ) = cc( "AT6" ,326 ,T, 32, 1 , "Atlant EU ferries outs.12 " ) +Country( IC_AT6 ) = cc( "AT6" ,'-',326 ,T, 32, 1 , "Atlant EU ferries outs.12 " ) ix=ix+1 IC_AT7=ix -Country( IC_AT7 ) = cc( "AT7" ,327 ,T, 32, 1 , "Atlant ROW ferries outs. 12 " ) +Country( IC_AT7 ) = cc( "AT7" ,'-',327 ,T, 32, 1 , "Atlant ROW ferries outs. 12 " ) ix=ix+1 IC_AT8=ix -Country( IC_AT8 ) = cc( "AT8" ,328 ,T, 32, 1 , "Atlant EU ferries ins. 12 " ) +Country( IC_AT8 ) = cc( "AT8" ,'-',328 ,T, 32, 1 , "Atlant EU ferries ins. 12 " ) ix=ix+1 IC_AT9=ix -Country( IC_AT9 ) = cc( "AT9" ,329 ,T, 32, 1 , "Atlant ROW ferries ins. 12 " ) +Country( IC_AT9 ) = cc( "AT9" ,'-',329 ,T, 32, 1 , "Atlant ROW ferries ins. 12 " ) ix=ix+1 IC_ME2=ix -Country( IC_ME2 ) = cc( "ME2" ,332 ,T, 33, 1 , "Medite EU cargo outs.12 " ) +Country( IC_ME2 ) = cc( "ME2" ,'-',332 ,T, 33, 1 , "Medite EU cargo outs.12 " ) ix=ix+1 IC_ME3=ix -Country( IC_ME3 ) = cc( "ME3" ,333 ,T, 33, 1 , "Medite ROW cargo outs. 12 " ) +Country( IC_ME3 ) = cc( "ME3" ,'-',333 ,T, 33, 1 , "Medite ROW cargo outs. 12 " ) ix=ix+1 IC_ME4=ix -Country( IC_ME4 ) = cc( "ME4" ,334 ,T, 33, 1 , "Medite EU cargo ins. 12 " ) +Country( IC_ME4 ) = cc( "ME4" ,'-',334 ,T, 33, 1 , "Medite EU cargo ins. 12 " ) ix=ix+1 IC_ME5=ix -Country( IC_ME5 ) = cc( "ME5" ,335 ,T, 33, 1 , "Medite ROW cargo ins. 12 " ) +Country( IC_ME5 ) = cc( "ME5" ,'-',335 ,T, 33, 1 , "Medite ROW cargo ins. 12 " ) ix=ix+1 IC_ME6=ix -Country( IC_ME6 ) = cc( "ME6" ,336 ,T, 33, 1 , "Medite EU ferries outs.12 " ) +Country( IC_ME6 ) = cc( "ME6" ,'-',336 ,T, 33, 1 , "Medite EU ferries outs.12 " ) ix=ix+1 IC_ME7=ix -Country( IC_ME7 ) = cc( "ME7" ,337 ,T, 33, 1 , "Medite ROW ferries outs. 12 " ) +Country( IC_ME7 ) = cc( "ME7" ,'-',337 ,T, 33, 1 , "Medite ROW ferries outs. 12 " ) ix=ix+1 IC_ME8=ix -Country( IC_ME8 ) = cc( "ME8" ,338 ,T, 33, 1 , "Medite EU ferries ins. 12 " ) +Country( IC_ME8 ) = cc( "ME8" ,'-',338 ,T, 33, 1 , "Medite EU ferries ins. 12 " ) ix=ix+1 IC_ME9=ix -Country( IC_ME9 ) = cc( "ME9" ,339 ,T, 33, 1 , "Medite ROW ferries ins. 12 " ) +Country( IC_ME9 ) = cc( "ME9" ,'-',339 ,T, 33, 1 , "Medite ROW ferries ins. 12 " ) ix=ix+1 IC_BL2=ix -Country( IC_BL2 ) = cc( "BL2" ,342 ,T, 34, 2 , "B. Sea EU cargo outs.12 " ) +Country( IC_BL2 ) = cc( "BL2" ,'-',342 ,T, 34, 2 , "B. Sea EU cargo outs.12 " ) ix=ix+1 IC_BL3=ix -Country( IC_BL3 ) = cc( "BL3" ,343 ,T, 34, 2 , "B. Sea ROW cargo outs. 12 " ) +Country( IC_BL3 ) = cc( "BL3" ,'-',343 ,T, 34, 2 , "B. Sea ROW cargo outs. 12 " ) ix=ix+1 IC_BL4=ix -Country( IC_BL4 ) = cc( "BL4" ,344 ,T, 34, 2 , "B. Sea EU cargo ins. 12 " ) +Country( IC_BL4 ) = cc( "BL4" ,'-',344 ,T, 34, 2 , "B. Sea EU cargo ins. 12 " ) ix=ix+1 IC_BL5=ix -Country( IC_BL5 ) = cc( "BL5" ,345 ,T, 34, 2 , "B. Sea ROW cargo ins. 12 " ) +Country( IC_BL5 ) = cc( "BL5" ,'-',345 ,T, 34, 2 , "B. Sea ROW cargo ins. 12 " ) ix=ix+1 IC_BL6=ix -Country( IC_BL6 ) = cc( "BL6" ,346 ,T, 34, 2 , "B. Sea EU ferries outs.12 " ) +Country( IC_BL6 ) = cc( "BL6" ,'-',346 ,T, 34, 2 , "B. Sea EU ferries outs.12 " ) ix=ix+1 IC_BL7=ix -Country( IC_BL7 ) = cc( "BL7" ,347 ,T, 34, 2 , "B. Sea ROW ferries outs. 12 " ) +Country( IC_BL7 ) = cc( "BL7" ,'-',347 ,T, 34, 2 , "B. Sea ROW ferries outs. 12 " ) ix=ix+1 IC_BL8=ix -Country( IC_BL8 ) = cc( "BL8" ,348 ,T, 34, 2 , "B. Sea EU ferries ins. 12 " ) +Country( IC_BL8 ) = cc( "BL8" ,'-',348 ,T, 34, 2 , "B. Sea EU ferries ins. 12 " ) ix=ix+1 IC_BL9=ix -Country( IC_BL9 ) = cc( "BL9" ,349 ,T, 34, 2 , "B. Sea ROW ferries ins. 12 " ) +Country( IC_BL9 ) = cc( "BL9" ,'-',349 ,T, 34, 2 , "B. Sea ROW ferries ins. 12 " ) ! NH3Emis new land code for NMR-NH3 project ix=ix+1 IC_NMR=ix -Country( IC_NMR ) = cc( "NMR" , 98 ,F, 98, 1 , "Area with temporal NMR-NH3 emissions " ) +Country( IC_NMR ) = cc( "NMR" ,'-', 98 ,F, 98, 1 , "Area with temporal NMR-NH3 emissions " ) !Extra cc for rest CityZen ix=ix+1 IC_RAA=ix -Country( IC_RAA ) = cc( "RAA" , 170 ,F, 170, -100, "Rest of Africa and Asia" ) +Country( IC_RAA ) = cc( "RAA" ,'-', 170 ,F, 170, -100, "Rest of Africa and Asia" ) ix=ix+1 IC_SEA=ix -Country( IC_SEA ) = cc( "SEA" , 171 ,F, 171, -100, "Ships" ) +Country( IC_SEA ) = cc( "SEA" ,'-', 171 ,F, 171, -100, "Ships" ) ! Extra from IIASA/ECLIPSE/ECLAIRE global ix=ix+1 IC_AFGH=ix -Country(IC_AFGH) = cc( "AFGH", 201, F,201, -100, "Afghanistan") +Country(IC_AFGH) = cc( "AFGH",'-', 201, F,201, -100, "Afghanistan") ix=ix+1 IC_ARGE=ix -Country(IC_ARGE) = cc( "ARGE", 202, F,202, -100, "Argentina") +Country(IC_ARGE) = cc( "ARGE",'-', 202, F,202, -100, "Argentina") ix=ix+1 IC_AUTR=ix -Country(IC_AUTR) = cc( "AUTR", 203, F,203, -100, "Australia") +Country(IC_AUTR) = cc( "AUTR",'-', 203, F,203, -100, "Australia") ix=ix+1 IC_BANG=ix -Country(IC_BANG) = cc( "BANG", 204, F,204, -100, "Bangladesh") +Country(IC_BANG) = cc( "BANG",'-', 204, F,204, -100, "Bangladesh") ix=ix+1 IC_BHUT=ix -Country(IC_BHUT) = cc( "BHUT", 205, F,205, -100, "Bhutan") +Country(IC_BHUT) = cc( "BHUT",'-', 205, F,205, -100, "Bhutan") ix=ix+1 IC_BRAZ=ix -Country(IC_BRAZ) = cc( "BRAZ", 206, F,206, -100, "Brazil") +Country(IC_BRAZ) = cc( "BRAZ",'-', 206, F,206, -100, "Brazil") ix=ix+1 IC_BRUN=ix -Country(IC_BRUN) = cc( "BRUN", 207, F,207, -100, "Brunei") +Country(IC_BRUN) = cc( "BRUN",'-', 207, F,207, -100, "Brunei") ix=ix+1 IC_CAMB=ix -Country(IC_CAMB) = cc( "CAMB", 208, F,208, -100, "Cambodia") +Country(IC_CAMB) = cc( "CAMB",'-', 208, F,208, -100, "Cambodia") ix=ix+1 IC_CHIL=ix -Country(IC_CHIL) = cc( "CHIL", 209, F,209, -100, "Chile") +Country(IC_CHIL) = cc( "CHIL",'-', 209, F,209, -100, "Chile") ix=ix+1 IC_CHIN=ix -Country(IC_CHIN) = cc( "CHIN", 210, F,210, -100, "China") +Country(IC_CHIN) = cc( "CHIN",'-', 210, F,210, -100, "China") ix=ix+1 IC_FSUA=ix -Country(IC_FSUA) = cc( "FSUA", 211, F,211, -100, "Former_USSR_(Asia)_Tajikistan_Turkmenistan_Uzbekistan") +Country(IC_FSUA) = cc( "FSUA",'-', 211, F,211, -100, "Former_USSR_(Asia)_Tajikistan_Turkmenistan_Uzbekistan") ix=ix+1 IC_INDI=ix -Country(IC_INDI) = cc( "INDI", 212, F,212, -100, "India") +Country(IC_INDI) = cc( "INDI",'-', 212, F,212, -100, "India") ix=ix+1 IC_INDO=ix -Country(IC_INDO) = cc( "INDO", 213, F,213, -100, "Indonesia") +Country(IC_INDO) = cc( "INDO",'-', 213, F,213, -100, "Indonesia") ix=ix+1 IC_ISRA=ix -Country(IC_ISRA) = cc( "ISRA", 214, F,214, -100, "Israel") +Country(IC_ISRA) = cc( "ISRA",'-', 214, F,214, -100, "Israel") ix=ix+1 IC_JAPA=ix -Country(IC_JAPA) = cc( "JAPA", 215, F,215, -100, "Japan") +Country(IC_JAPA) = cc( "JAPA",'-', 215, F,215, -100, "Japan") ix=ix+1 IC_LAOS=ix -Country(IC_LAOS) = cc( "LAOS", 216, F,216, -100, "Laos") +Country(IC_LAOS) = cc( "LAOS",'-', 216, F,216, -100, "Laos") ix=ix+1 IC_MALA=ix -Country(IC_MALA) = cc( "MALA", 217, F,217, -100, "Malaysia") +Country(IC_MALA) = cc( "MALA",'-', 217, F,217, -100, "Malaysia") ix=ix+1 IC_MEXI=ix -Country(IC_MEXI) = cc( "MEXI", 218, F,218, -100, "Mexico") +Country(IC_MEXI) = cc( "MEXI",'-', 218, F,218, -100, "Mexico") ix=ix+1 IC_MIDE=ix -Country(IC_MIDE) = cc( "MIDE", 219, F,219, -100, "Middle_East") +Country(IC_MIDE) = cc( "MIDE",'-', 219, F,219, -100, "Middle_East") ix=ix+1 IC_MONG=ix -Country(IC_MONG) = cc( "MONG", 220, F,220, -100, "Mongolia") +Country(IC_MONG) = cc( "MONG",'-', 220, F,220, -100, "Mongolia") ix=ix+1 IC_MYAN=ix -Country(IC_MYAN) = cc( "MYAN", 221, F,221, -100, "Myanmar") +Country(IC_MYAN) = cc( "MYAN",'-', 221, F,221, -100, "Myanmar") ix=ix+1 IC_NEPA=ix -Country(IC_NEPA) = cc( "NEPA", 222, F,222, -100, "Nepal") +Country(IC_NEPA) = cc( "NEPA",'-', 222, F,222, -100, "Nepal") ix=ix+1 IC_NZEL=ix -Country(IC_NZEL) = cc( "NZEL", 223, F,223, -100, "New_Zealand") +Country(IC_NZEL) = cc( "NZEL",'-', 223, F,223, -100, "New_Zealand") ix=ix+1 IC_NAFR=ix -Country(IC_NAFR) = cc( "NAFR", 224, F,224, -100, "North_Africa_Libya_Tunisia_Algeria_Sudan_Morocco") +Country(IC_NAFR) = cc( "NAFR",'-', 224, F,224, -100, "North_Africa_Libya_Tunisia_Algeria_Sudan_Morocco") ix=ix+1 IC_KORN=ix -Country(IC_KORN) = cc( "KORN", 225, F,225, -100, "North_Korea") +Country(IC_KORN) = cc( "KORN",'-', 225, F,225, -100, "North_Korea") ix=ix+1 IC_OAFR=ix -Country(IC_OAFR) = cc( "OAFR", 226, F,226, -100, "Other_Africa") +Country(IC_OAFR) = cc( "OAFR",'-', 226, F,226, -100, "Other_Africa") ix=ix+1 IC_OLAM=ix -Country(IC_OLAM) = cc( "OLAM", 227, F,227, -100, "Other_Latin_America") +Country(IC_OLAM) = cc( "OLAM",'-', 227, F,227, -100, "Other_Latin_America") ix=ix+1 IC_PAKI=ix -Country(IC_PAKI) = cc( "PAKI", 228, F,228, -100, "Pakistan") +Country(IC_PAKI) = cc( "PAKI",'-', 228, F,228, -100, "Pakistan") ix=ix+1 IC_PHIL=ix -Country(IC_PHIL) = cc( "PHIL", 229, F,229, -100, "Philippines") +Country(IC_PHIL) = cc( "PHIL",'-', 229, F,229, -100, "Philippines") ix=ix+1 IC_SING=ix -Country(IC_SING) = cc( "SING", 230, F,230, -100, "Singapore") +Country(IC_SING) = cc( "SING",'-', 230, F,230, -100, "Singapore") ix=ix+1 IC_SAFR=ix -Country(IC_SAFR) = cc( "SAFR", 231, F,231, -100, "South_Africa") +Country(IC_SAFR) = cc( "SAFR",'-', 231, F,231, -100, "South_Africa") ix=ix+1 IC_KORS=ix -Country(IC_KORS) = cc( "KORS", 232, F,232, -100, "South_Korea") +Country(IC_KORS) = cc( "KORS",'-', 232, F,232, -100, "South_Korea") ix=ix+1 IC_SRIL=ix -Country(IC_SRIL) = cc( "SRIL", 233, F,233, -100, "Sri_Lanka") +Country(IC_SRIL) = cc( "SRIL",'-', 233, F,233, -100, "Sri_Lanka") ix=ix+1 IC_TAIW=ix -Country(IC_TAIW) = cc( "TAIW", 234, F,234, -100, "Taiwan") +Country(IC_TAIW) = cc( "TAIW",'-', 234, F,234, -100, "Taiwan") ix=ix+1 IC_THAI=ix -Country(IC_THAI) = cc( "THAI", 235, F,235, -100, "Thailand") +Country(IC_THAI) = cc( "THAI",'-', 235, F,235, -100, "Thailand") ix=ix+1 IC_VIET=ix -Country(IC_VIET) = cc( "VIET", 236, F,236, -100, "Vietnam") +Country(IC_VIET) = cc( "VIET",'-', 236, F,236, -100, "Vietnam") ix=ix+1 IC_EGYP=ix -Country(IC_EGYP) = cc( "EGYP", 237, F,237, -100, "Egypt") +Country(IC_EGYP) = cc( "EGYP",'-', 237, F,237, -100, "Egypt") ix=ix+1 IC_HANO=ix -Country(IC_HANO) = cc( "Hanoi", 238, F, 238, -100, "Hanoi") +Country(IC_HANO) = cc( "Hanoi",'-', 238, F, 238, -100, "Hanoi") ix=ix+1 IC_NVIE=ix -Country(IC_NVIE) = cc( "NVIET", 239, F, 239, -100, "North Vietnam") +Country(IC_NVIE) = cc( "NVIET",'-', 239, F, 239, -100, "North Vietnam") ix=ix+1 -IC_RVIE=ix -Country(IC_RVIE) = cc( "RVIET", 240, F, 240, -100, "Rest of Vietnam") +IC_SVIE=ix +Country(IC_SVIE) = cc( "SVIET",'-', 240, F, 240, -100, "South Vietnam") ix=ix+1 IC_BOLV=ix -Country(IC_BOLV) = cc( "BOLV", 241, F, 241, -100, "Bolivia") +Country(IC_BOLV) = cc( "BOLV",'-', 241, F, 241, -100, "Bolivia") ix=ix+1 IC_CARB=ix -Country(IC_CARB) = cc( "CARB", 242, F, 242, -100, "Caribbean") +Country(IC_CARB) = cc( "CARB",'-', 242, F, 242, -100, "Caribbean") ix=ix+1 IC_CEAM=ix -Country(IC_CEAM) = cc( "CEAM", 243, F, 243, -100, "Central America") +Country(IC_CEAM) = cc( "CEAM",'-', 243, F, 243, -100, "Central America") ix=ix+1 IC_COLO=ix -Country(IC_COLO) = cc( "COLO", 244, F, 244, -100, "Colombia") +Country(IC_COLO) = cc( "COLO",'-', 244, F, 244, -100, "Colombia") ix=ix+1 IC_ECUA=ix -Country(IC_ECUA) = cc( "ECUA", 245, F, 245, -100, "Ecuador") +Country(IC_ECUA) = cc( "ECUA",'-', 245, F, 245, -100, "Ecuador") ix=ix+1 IC_PARA=ix -Country(IC_PARA) = cc( "PARA", 246, F, 246, -100, "Paraguay") +Country(IC_PARA) = cc( "PARA",'-', 246, F, 246, -100, "Paraguay") ix=ix+1 IC_PERU=ix -Country(IC_PERU) = cc( "PERU", 247, F, 247, -100, "Peru") +Country(IC_PERU) = cc( "PERU",'-', 247, F, 247, -100, "Peru") ix=ix+1 IC_URUG=ix -Country(IC_URUG) = cc( "URUG", 248, F, 248, -100, "Uruguay") +Country(IC_URUG) = cc( "URUG",'-', 248, F, 248, -100, "Uruguay") ix=ix+1 IC_VENE=ix -Country(IC_VENE) = cc( "VENE", 249, F, 249, -100, " Venezuela") +Country(IC_VENE) = cc( "VENE",'-', 249, F, 249, -100, " Venezuela") +ix=ix+1 +IC_IRAN=ix +Country(IC_IRAN) = cc( "IRAN",'-', 250, F, 250, -100, "Iran") +ix=ix+1 +IC_SAAR=ix +Country(IC_SAAR) = cc( "SAAR",'-', 251, F, 251, -100, "Saudi Arabia") ix=ix+1 IC_INTSHIPS=ix -Country(IC_INTSHIPS ) = cc( "INTSHIPS" ,350 ,T, 350, -100 , "International ships, RCP6" ) +Country(IC_INTSHIPS) = cc( "INTSHIPS" ,'-',350 ,T, 350, -100 , "International ships" ) +ix=ix+1 +IC_KOSO=ix +Country(IC_KOSO) = cc( "KOSO",'KOSO', 373, F, 373, -100, "Kosovo") +ix=ix+1 +IC_OCEC=ix +Country(IC_OCEC) = cc( "OCEC",'-', 393, F, 393, -100, "Oceania") !! HTAP2 regions ix=ix+1 IC_HT1000 = ix -Country(IC_HT1000 ) = cc( "HT1000" ,1000 ,T, -100, 2 , "HT 1000" ) +Country(IC_HT1000 ) = cc( "HT1000" ,'-',1000 ,T, -100, 2 , "HT 1000" ) ix=ix+1 IC_HTNATL = ix -Country(IC_HTNATL ) = cc( "N_ATL" ,1002 ,T, 32, -100 , "Int. ships, N. Atl." ) +Country(IC_HTNATL ) = cc( "N_ATL" ,'-',1002 ,T, 32, -100 , "Int. ships, N. Atl." ) ix=ix+1 IC_HTUSCA = ix -Country(IC_HTUSCA ) = cc( "USCA" ,1003 ,T, 65, -100 , "USA and Canada" ) +Country(IC_HTUSCA ) = cc( "USCA" ,'-',1003 ,T, 65, -100 , "USA and Canada" ) ix=ix+1 IC_HTEUTU = ix -Country(IC_HTEUTU ) = cc( "EU_TU" ,1004 ,T, 64, 1 , "EU and Turkey" ) +Country(IC_HTEUTU ) = cc( "EU_TU" ,'-',1004 ,T, 64, 1 , "EU and Turkey" ) ix=ix+1 IC_HTSASI = ix -Country(IC_HTSASI ) = cc( "S_ASIA_IP" ,1005 ,T, 212, -100 , "S. Asia India Pak." ) +Country(IC_HTSASI ) = cc( "S_ASIA_IP" ,'-',1005 ,T, 212, -100 , "S. Asia India Pak." ) ix=ix+1 IC_HTEASI = ix -Country(IC_HTEASI ) = cc( "CHCORJAP" ,1006 ,T, 210, -100 , "China Korea Japan" ) +Country(IC_HTEASI ) = cc( "CHCORJAP" ,'-',1006 ,T, 210, -100 , "China Korea Japan" ) ix=ix+1 IC_HTSEAS = ix -Country(IC_HTSEAS ) = cc( "TAINDOMA" ,1007 ,T, 210, -100 , "Thail. Indon. Malay" ) +Country(IC_HTSEAS ) = cc( "TAINDOMA" ,'-',1007 ,T, 210, -100 , "Thail. Indon. Malay" ) ix=ix+1 IC_HTAUST = ix -Country(IC_HTAUST ) = cc( "AUSTR" ,1008 ,T, 203, -100 , "Austr N. Zeal. ++" ) +Country(IC_HTAUST ) = cc( "AUSTR" ,'-',1008 ,T, 203, -100 , "Austr N. Zeal. ++" ) ix=ix+1 IC_HTNAFR = ix -Country(IC_HTNAFR ) = cc( "NAFRI" ,1009 ,T, 64, 1 , "N. Africa" ) +Country(IC_HTNAFR ) = cc( "NAFRI" ,'-',1009 ,T, 64, 1 , "N. Africa" ) ix=ix+1 IC_HTRAFR = ix -Country(IC_HTRAFR ) = cc( "RAFRI" ,1010 ,T, 64, 1 , "Rest Africa" ) +Country(IC_HTRAFR ) = cc( "RAFRI" ,'-',1010 ,T, 64, 1 , "Rest Africa" ) ix=ix+1 IC_HTMIDE = ix -Country(IC_HTMIDE ) = cc( "MIDEAST" ,1011 ,T, 25, 2 , "Middle East" ) +Country(IC_HTMIDE ) = cc( "MIDEAST" ,'-',1011 ,T, 25, 2 , "Middle East" ) ix=ix+1 IC_HT1012 = ix -Country(IC_HT1012 ) = cc( "HT1012" ,1012 ,T, -100, 2 , "HT 1012" ) +Country(IC_HT1012 ) = cc( "HT1012" ,'-',1012 ,T, -100, 2 , "HT 1012" ) ix=ix+1 IC_HT1013 = ix -Country(IC_HT1013 ) = cc( "HT1013" ,1013 ,T, -100, 2 , "HT 1013" ) +Country(IC_HT1013 ) = cc( "HT1013" ,'-',1013 ,T, -100, 2 , "HT 1013" ) ix=ix+1 IC_HT1014 = ix -Country(IC_HT1014 ) = cc( "HT1014" ,1014 ,T, -100, 2 , "HT 1014" ) +Country(IC_HT1014 ) = cc( "HT1014" ,'-',1014 ,T, -100, 2 , "HT 1014" ) ix=ix+1 IC_HT1015 = ix -Country(IC_HT1015 ) = cc( "HT1015" ,1015 ,T, -100, 2 , "HT 1015" ) +Country(IC_HT1015 ) = cc( "HT1015" ,'-',1015 ,T, -100, 2 , "HT 1015" ) ix=ix+1 IC_HT1016 = ix -Country(IC_HT1016 ) = cc( "HT1016" ,1016 ,T, -100, 2 , "HT 1016" ) +Country(IC_HT1016 ) = cc( "HT1016" ,'-',1016 ,T, -100, 2 , "HT 1016" ) ix=ix+1 IC_HT1017 = ix -Country(IC_HT1017 ) = cc( "HT1017" ,1017 ,T, -100, 2 , "HT 1017" ) +Country(IC_HT1017 ) = cc( "HT1017" ,'-',1017 ,T, -100, 2 , "HT 1017" ) ix=ix+1 IC_HT1018 = ix -Country(IC_HT1018 ) = cc( "HT1018" ,1018 ,T, -100, 2 , "HT 1018" ) +Country(IC_HT1018 ) = cc( "HT1018" ,'-',1018 ,T, -100, 2 , "HT 1018" ) ix=ix+1 IC_HT1019 = ix -Country(IC_HT1019 ) = cc( "HT1019" ,1019 ,T, -100, 2 , "HT 1019" ) +Country(IC_HT1019 ) = cc( "HT1019" ,'-',1019 ,T, -100, 2 , "HT 1019" ) ix=ix+1 IC_HT1020 = ix -Country(IC_HT1020 ) = cc( "HT1020" ,1020 ,T, -100, 2 , "HT 1020" ) - +Country(IC_HT1020 ) = cc( "HT1020" ,'-',1020 ,T, -100, 2 , "HT 1020" ) +!UNEP SR regions' +ix=ix+1 +IC_BANG_DHAK = ix +Country(IC_BANG_DHAK) = cc( "BANG_DHAK",'-', 252 , F, 252 ,-100, "Bangladesh:Dhaka") +ix=ix+1 +IC_BANG_REST = ix +Country(IC_BANG_REST) = cc( "BANG_REST",'-', 253 , F, 253 ,-100, "Rest_of_Bangladesh") +ix=ix+1 +IC_CHIN_ANHU = ix +Country(IC_CHIN_ANHU) = cc( "CHIN_ANHU",'-', 254 , F, 254 ,-100, "China:Anhui") +ix=ix+1 +IC_CHIN_BEIJ = ix +Country(IC_CHIN_BEIJ) = cc( "CHIN_BEIJ",'-', 255 , F, 255 ,-100, "China:Beijing") +ix=ix+1 +IC_CHIN_CHON = ix +Country(IC_CHIN_CHON) = cc( "CHIN_CHON",'-', 256 , F, 256 ,-100, "China:Chongqing") +ix=ix+1 +IC_CHIN_FUJI = ix +Country(IC_CHIN_FUJI) = cc( "CHIN_FUJI",'-', 257 , F, 257 ,-100, "China:Fujian") +ix=ix+1 +IC_CHIN_GANS = ix +Country(IC_CHIN_GANS) = cc( "CHIN_GANS",'-', 258 , F, 258 ,-100, "China:Gansu") +ix=ix+1 +IC_CHIN_GUAD = ix +Country(IC_CHIN_GUAD) = cc( "CHIN_GUAD",'-', 259 , F, 259 ,-100, "China:Guangdong") +ix=ix+1 +IC_CHIN_GUAX = ix +Country(IC_CHIN_GUAX) = cc( "CHIN_GUAX",'-', 260 , F, 260 ,-100, "China:Guangxi") +ix=ix+1 +IC_CHIN_GUIZ = ix +Country(IC_CHIN_GUIZ) = cc( "CHIN_GUIZ",'-', 261 , F, 261 ,-100, "China:Guizhou") +ix=ix+1 +IC_CHIN_HAIN = ix +Country(IC_CHIN_HAIN) = cc( "CHIN_HAIN",'-', 262 , F, 262 ,-100, "China:Hainan") +ix=ix+1 +IC_CHIN_HEBE = ix +Country(IC_CHIN_HEBE) = cc( "CHIN_HEBE",'-', 263 , F, 263 ,-100, "China:Hebei") +ix=ix+1 +IC_CHIN_HEIL = ix +Country(IC_CHIN_HEIL) = cc( "CHIN_HEIL",'-', 264 , F, 264 ,-100, "China:Heilongjiang") +ix=ix+1 +IC_CHIN_HENA = ix +Country(IC_CHIN_HENA) = cc( "CHIN_HENA",'-', 265 , F, 265 ,-100, "China:Henan") +ix=ix+1 +IC_CHIN_HONG = ix +Country(IC_CHIN_HONG) = cc( "CHIN_HONG",'-', 266 , F, 266 ,-100, "China:Hong_Kong_&_Macau") +ix=ix+1 +IC_CHIN_HUBE = ix +Country(IC_CHIN_HUBE) = cc( "CHIN_HUBE",'-', 267 , F, 267 ,-100, "China:Hubei") +ix=ix+1 +IC_CHIN_HUNA = ix +Country(IC_CHIN_HUNA) = cc( "CHIN_HUNA",'-', 268 , F, 268 ,-100, "China:Hunan") +ix=ix+1 +IC_CHIN_JILI = ix +Country(IC_CHIN_JILI) = cc( "CHIN_JILI",'-', 269 , F, 269 ,-100, "China:Jilin") +ix=ix+1 +IC_CHIN_JINU = ix +Country(IC_CHIN_JINU) = cc( "CHIN_JINU",'-', 270 , F, 270 ,-100, "China:Jiangsu") +ix=ix+1 +IC_CHIN_JINX = ix +Country(IC_CHIN_JINX) = cc( "CHIN_JINX",'-', 271 , F, 271 ,-100, "China:Jiangxi") +ix=ix+1 +IC_CHIN_LIAO = ix +Country(IC_CHIN_LIAO) = cc( "CHIN_LIAO",'-', 272 , F, 272 ,-100, "China:Liaoning") +ix=ix+1 +IC_CHIN_NEMO = ix +Country(IC_CHIN_NEMO) = cc( "CHIN_NEMO",'-', 273 , F, 273 ,-100, "China:Inner_Mongolia") +ix=ix+1 +IC_CHIN_NINX = ix +Country(IC_CHIN_NINX) = cc( "CHIN_NINX",'-', 274 , F, 274 ,-100, "China:Ningxia") +ix=ix+1 +IC_CHIN_QING = ix +Country(IC_CHIN_QING) = cc( "CHIN_QING",'-', 275 , F, 275 ,-100, "China:Qinghai") +ix=ix+1 +IC_CHIN_SHAA = ix +Country(IC_CHIN_SHAA) = cc( "CHIN_SHAA",'-', 276 , F, 276 ,-100, "China:Shaanxi") +ix=ix+1 +IC_CHIN_SHAN = ix +Country(IC_CHIN_SHAN) = cc( "CHIN_SHAN",'-', 277 , F, 277 ,-100, "China:Shanghai") +ix=ix+1 +IC_CHIN_SHND = ix +Country(IC_CHIN_SHND) = cc( "CHIN_SHND",'-', 278 , F, 278 ,-100, "China:Shandong") +ix=ix+1 +IC_CHIN_SHNX = ix +Country(IC_CHIN_SHNX) = cc( "CHIN_SHNX",'-', 279 , F, 279 ,-100, "China:Shanxi") +ix=ix+1 +IC_CHIN_SICH = ix +Country(IC_CHIN_SICH) = cc( "CHIN_SICH",'-', 280 , F, 280 ,-100, "China:Sichuan") +ix=ix+1 +IC_CHIN_TIAN = ix +Country(IC_CHIN_TIAN) = cc( "CHIN_TIAN",'-', 281 , F, 281 ,-100, "China:Tianjin") +ix=ix+1 +IC_CHIN_TIBE = ix +Country(IC_CHIN_TIBE) = cc( "CHIN_TIBE",'-', 282 , F, 282 ,-100, "China:Tibet_(Xizang)") +ix=ix+1 +IC_CHIN_XING = ix +Country(IC_CHIN_XING) = cc( "CHIN_XING",'-', 283 , F, 283 ,-100, "China:Xinjiang") +ix=ix+1 +IC_CHIN_YUNN = ix +Country(IC_CHIN_YUNN) = cc( "CHIN_YUNN",'-', 284 , F, 284 ,-100, "China:Yunnan") +ix=ix+1 +IC_CHIN_ZHEJ = ix +Country(IC_CHIN_ZHEJ) = cc( "CHIN_ZHEJ",'-', 285 , F, 285 ,-100, "China:Zhejiang") +ix=ix+1 +IC_INDI_ANPR = ix +Country(IC_INDI_ANPR) = cc( "INDI_ANPR",'-', 286 , F, 286 ,-100, "India:Andhra_Pradesh") +ix=ix+1 +IC_INDI_ASSA = ix +Country(IC_INDI_ASSA) = cc( "INDI_ASSA",'-', 287 , F, 287 ,-100, "India:Assam") +ix=ix+1 +IC_INDI_BENG = ix +Country(IC_INDI_BENG) = cc( "INDI_BENG",'-', 288 , F, 288 ,-100, "India:West_Bengal") +ix=ix+1 +IC_INDI_BIHA = ix +Country(IC_INDI_BIHA) = cc( "INDI_BIHA",'-', 289 , F, 289 ,-100, "India:Bihar") +ix=ix+1 +IC_INDI_CHHA = ix +Country(IC_INDI_CHHA) = cc( "INDI_CHHA",'-', 290 , F, 290 ,-100, "India:Chhattisgarh") +ix=ix+1 +IC_INDI_DELH = ix +Country(IC_INDI_DELH) = cc( "INDI_DELH",'-', 291 , F, 291 ,-100, "India:Delhi") +ix=ix+1 +IC_INDI_EHIM = ix +Country(IC_INDI_EHIM) = cc( "INDI_EHIM",'-', 292 , F, 292 ,-100, "India:North_East_(excl._Assam)") +ix=ix+1 +IC_INDI_GOA = ix +Country(IC_INDI_GOA) = cc( "INDI_GOA",'-', 293 , F, 293 ,-100, "India:Goa") +ix=ix+1 +IC_INDI_GUJA = ix +Country(IC_INDI_GUJA) = cc( "INDI_GUJA",'-', 294 , F, 294 ,-100, "India:Gujarat") +ix=ix+1 +IC_INDI_HARY = ix +Country(IC_INDI_HARY) = cc( "INDI_HARY",'-', 295 , F, 295 ,-100, "India:Haryana") +ix=ix+1 +IC_INDI_HIPR = ix +Country(IC_INDI_HIPR) = cc( "INDI_HIPR",'-', 296 , F, 296 ,-100, "India:Himachal_Pradesh") +ix=ix+1 +IC_INDI_JHAR = ix +Country(IC_INDI_JHAR) = cc( "INDI_JHAR",'-', 297 , F, 297 ,-100, "India:Jharkhand") +ix=ix+1 +IC_INDI_KARN = ix +Country(IC_INDI_KARN) = cc( "INDI_KARN",'-', 298 , F, 298 ,-100, "India:Karnataka") +ix=ix+1 +IC_INDI_KERA = ix +Country(IC_INDI_KERA) = cc( "INDI_KERA",'-', 299 , F, 299 ,-100, "India:Kerala") +ix=ix+1 +IC_INDI_MAHA = ix +Country(IC_INDI_MAHA) = cc( "INDI_MAHA",'-', 300 , F, 300 ,-100, "India:Maharashtra-Dadra-Nagar-Haveli-Daman-Diu") +ix=ix+1 +IC_INDI_MAPR = ix +Country(IC_INDI_MAPR) = cc( "INDI_MAPR",'-', 351 , F, 351 ,-100, "India:Madhya_Pradesh") +ix=ix+1 +IC_INDI_ORIS = ix +Country(IC_INDI_ORIS) = cc( "INDI_ORIS",'-', 352 , F, 352 ,-100, "India:Orissa") +ix=ix+1 +IC_INDI_PUNJ = ix +Country(IC_INDI_PUNJ) = cc( "INDI_PUNJ",'-', 353 , F, 353 ,-100, "India:Punjab") +ix=ix+1 +IC_INDI_RAJA = ix +Country(IC_INDI_RAJA) = cc( "INDI_RAJA",'-', 354 , F, 354 ,-100, "India:Rajasthan") +ix=ix+1 +IC_INDI_TAMI = ix +Country(IC_INDI_TAMI) = cc( "INDI_TAMI",'-', 355 , F, 355 ,-100, "India:Tamil_Nadu") +ix=ix+1 +IC_INDI_UTAN = ix +Country(IC_INDI_UTAN) = cc( "INDI_UTAN",'-', 356 , F, 356 ,-100, "India:Uttaranchal") +ix=ix+1 +IC_INDI_UTPR = ix +Country(IC_INDI_UTPR) = cc( "INDI_UTPR",'-', 357 , F, 357 ,-100, "India:Uttar_Pradesh") +ix=ix+1 +IC_INDI_WHIM = ix +Country(IC_INDI_WHIM) = cc( "INDI_WHIM",'-', 358 , F, 358 ,-100, "India:Jammu_and_Kashmir") +ix=ix+1 +IC_INDO_JAKA = ix +Country(IC_INDO_JAKA) = cc( "INDO_JAKA",'-', 359 , F, 359 ,-100, "Indonesia:Jakarta") +ix=ix+1 +IC_INDO_JAVA = ix +Country(IC_INDO_JAVA) = cc( "INDO_JAVA",'-', 360 , F, 360 ,-100, "Indonesia:Java") +ix=ix+1 +IC_INDO_REST = ix +Country(IC_INDO_REST) = cc( "INDO_REST",'-', 361 , F, 361 ,-100, "Indonesia:Rest_of_Indonesia") +ix=ix+1 +IC_INDO_SUMA = ix +Country(IC_INDO_SUMA) = cc( "INDO_SUMA",'-', 362 , F, 362 ,-100, "Indonesia:Sumatra") +ix=ix+1 +IC_JAPA_CHSH = ix +Country(IC_JAPA_CHSH) = cc( "JAPA_CHSH",'-', 363 , F, 363 ,-100, "Japan:Chugoku-Shikoku") +ix=ix+1 +IC_JAPA_CHUB = ix +Country(IC_JAPA_CHUB) = cc( "JAPA_CHUB",'-', 364 , F, 364 ,-100, "Japan:Chubu") +ix=ix+1 +IC_JAPA_HOTO = ix +Country(IC_JAPA_HOTO) = cc( "JAPA_HOTO",'-', 365 , F, 365 ,-100, "Japan:Hokkaido-Tohoku") +ix=ix+1 +IC_JAPA_KANT = ix +Country(IC_JAPA_KANT) = cc( "JAPA_KANT",'-', 366 , F, 366 ,-100, "Japan:Kanto") +ix=ix+1 +IC_JAPA_KINK = ix +Country(IC_JAPA_KINK) = cc( "JAPA_KINK",'-', 367 , F, 367 ,-100, "Japan:Kinki") +ix=ix+1 +IC_JAPA_KYOK = ix +Country(IC_JAPA_KYOK) = cc( "JAPA_KYOK",'-', 368 , F, 368 ,-100, "Japan:Kyushu-Okinawa") +ix=ix+1 +IC_KORS_NORT = ix +Country(IC_KORS_NORT) = cc( "KORS_NORT",'-', 369 , F, 369 ,-100, "South_Korea:North") +ix=ix+1 +IC_KORS_PUSA = ix +Country(IC_KORS_PUSA) = cc( "KORS_PUSA",'-', 370 , F, 370 ,-100, "South_Korea:Pusan") +ix=ix+1 +IC_KORS_SEOI = ix +Country(IC_KORS_SEOI) = cc( "KORS_SEOI",'-', 371 , F, 371 ,-100, "South_Korea:Seoul-Inchon") +ix=ix+1 +IC_KORS_SOUT = ix +Country(IC_KORS_SOUT) = cc( "KORS_SOUT",'-', 372 , F, 372 ,-100, "South_Korea:South") +ix=ix+1 +IC_MALA_KUAL = ix +Country(IC_MALA_KUAL) = cc( "MALA_KUAL",'-', 374 , F, 374 ,-100, "Malaysia:Kuala_Lumpur") +ix=ix+1 +IC_MALA_PENM = ix +Country(IC_MALA_PENM) = cc( "MALA_PENM",'-', 375 , F, 375 ,-100, "Malaysia:Peninsular_Malaysia") +ix=ix+1 +IC_MALA_SASA = ix +Country(IC_MALA_SASA) = cc( "MALA_SASA",'-', 376 , F, 376 ,-100, "Malaysia:Sarawak-Sabah") +ix=ix+1 +IC_PAKI_KARA = ix +Country(IC_PAKI_KARA) = cc( "PAKI_KARA",'-', 377 , F, 377 ,-100, "Pakistan:Karachi") +ix=ix+1 +IC_PAKI_NMWP = ix +Country(IC_PAKI_NMWP) = cc( "PAKI_NMWP",'-', 378 , F, 378 ,-100, "Pakistan:NW_Frontier_Provinces-Baluchistan") +ix=ix+1 +IC_PAKI_PUNJ = ix +Country(IC_PAKI_PUNJ) = cc( "PAKI_PUNJ",'-', 379 , F, 379 ,-100, "Pakistan:Punjab") +ix=ix+1 +IC_PAKI_SIND = ix +Country(IC_PAKI_SIND) = cc( "PAKI_SIND",'-', 380 , F, 380 ,-100, "Pakistan:Sind") +ix=ix+1 +IC_PHIL_BVMI = ix +Country(IC_PHIL_BVMI) = cc( "PHIL_BVMI",'-', 381 , F, 381 ,-100, "Philipinnes:Bicol-Visayas-Mindanao") +ix=ix+1 +IC_PHIL_LUZO = ix +Country(IC_PHIL_LUZO) = cc( "PHIL_LUZO",'-', 382 , F, 382 ,-100, "Philipinnes:Luzon") +ix=ix+1 +IC_PHIL_MANI = ix +Country(IC_PHIL_MANI) = cc( "PHIL_MANI",'-', 383 , F, 383 ,-100, "Philipinnes:Metropolitan_Manila") +ix=ix+1 +IC_RUSS_ASIA = ix +Country(IC_RUSS_ASIA) = cc( "RUSS_ASIA",'-', 384 , F, 384 ,-100, "Russia:Asian_part") +ix=ix+1 +IC_RUSS_EURO = ix +Country(IC_RUSS_EURO) = cc( "RUSS_EURO",'RUSS', 385 , F, 385 ,-100, "Russia:European_part") +ix=ix+1 +IC_THAI_BANG = ix +Country(IC_THAI_BANG) = cc( "THAI_BANG",'-', 386 , F, 386 ,-100, "Thailand:Bangkok_Metropolitan_Region") +ix=ix+1 +IC_THAI_CVAL = ix +Country(IC_THAI_CVAL) = cc( "THAI_CVAL",'-', 387 , F, 387 ,-100, "Thailand:Central_Valley") +ix=ix+1 +IC_THAI_NEPL = ix +Country(IC_THAI_NEPL) = cc( "THAI_NEPL",'-', 388 , F, 388 ,-100, "Thailand:NE_Plateau") +ix=ix+1 +IC_THAI_NHIG = ix +Country(IC_THAI_NHIG) = cc( "THAI_NHIG",'-', 389 , F, 389 ,-100, "Thailand:N_Highlands") +ix=ix+1 +IC_THAI_SPEN = ix +Country(IC_THAI_SPEN) = cc( "THAI_SPEN",'-', 390 , F, 390 ,-100, "Thailand:S_Peninsula") +ix=ix+1 +IC_IRAN_REST = ix +Country(IC_IRAN_REST) = cc( "IRAN_REST",'-', 391 , F, 391 ,-100, "Iran:Rest_of_Iran") +ix=ix+1 +IC_IRAN_TEHR = ix +Country(IC_IRAN_TEHR) = cc( "IRAN_TEHR",'-', 392 , F, 392 ,-100, "Iran:Teheran") NLAND=ix !actual number of countries defined - end subroutine Country_Init + end subroutine init_Country - subroutine Country_test() + subroutine self_test() integer :: ic print *, "COUNTRY TEST ===================================" - call Country_Init() + call init_Country() print *, "COUNTRY TEST NLAND = ", NLAND do ic = 1, NLAND - print '(a,i3,2x,a5,i5)', "IC ", ic, Country(ic)%code, Country(ic)%icode + print '(a,i3,2x,a,i5,2x,a)', "IC ", ic, Country(ic)%code, & + Country(ic)%icode, Country(ic)%gains end do - end subroutine Country_test - + end subroutine self_test end module Country_ml +!TSTEMX program testr +!TSTEMX use Country_ml +!TSTEMX call init_Country() ! sets country details +!TSTEMX call self_test() ! just to test numbering +!TSTEMX end program testr diff --git a/DO3SE_ml.f90 b/DO3SE_ml.f90 index 746ec09..bf2d5cb 100644 --- a/DO3SE_ml.f90 +++ b/DO3SE_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -62,8 +62,8 @@ module DO3SE_ml !****** Data to be read from Phenology_inputs.dat: type, public :: do3se_type - character(len=15) :: code - character(len=15) :: name + character(len=30) :: code + character(len=30) :: name real:: g_max ! max. value conductance g_s real:: f_min ! min. value Conductance, factor real:: f_phen_a ! f_phen a (very start of season diff --git a/DefPhotolysis_ml.f90 b/DefPhotolysis_ml.f90 index 95161e7..056b33d 100644 --- a/DefPhotolysis_ml.f90 +++ b/DefPhotolysis_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -102,7 +102,6 @@ subroutine readdiss(newseason) integer :: k & ! help index ,izn & ! integer zenith angle - ,info & ! used for broadcast ,nr & ! numbering of photolytic reactions ,la ! counting every 10 deg. latitude real myz @@ -116,7 +115,7 @@ subroutine readdiss(newseason) allocate(dj(NPHODIS,KCHEMTOP:KMAX_MID,HORIZON,NLAT)) allocate(djcl1(NPHODIS,KCHEMTOP:KMAX_MID,HORIZON)) allocate(djcl3(NPHODIS,KCHEMTOP:KMAX_MID,HORIZON)) - endif + end if ! Open, read and broadcast clear sky rates !--------------- @@ -124,7 +123,7 @@ subroutine readdiss(newseason) write(fname1,fmt='(''jclear'',i2.2,''.dat'')') newseason call open_file(IO_DJ,"r",fname1,needed=.true.) call CheckStop(ios,"DefPhotolysis: ios error in jclear ") - endif + end if ! Format of input data from Phodis - careful with "17" and NPHODIS @@ -141,8 +140,8 @@ subroutine readdiss(newseason) do k = 2,KMAX_MID-KMAX20+2 do nr=1,NPHODIS dj(nr,k,izn,la)=dj(nr,KCHEMTOP,izn,la) - enddo - enddo + end do + end do do k = KMAX_MID-KMAX20+3,KMAX_MID !TEMPORARY FIX do k = KCHEMTOP+1,KMAX_MID read(IO_DJ,999) myz,(dj(nr,k,izn,la),nr=1,NPHODIS) @@ -150,7 +149,7 @@ subroutine readdiss(newseason) end do ! izn end do ! la close(IO_DJ) - endif ! me = 0 + end if ! me = 0 CALL MPI_BCAST(dj ,8*NPHODIS*(KMAX_MID-KCHEMTOP+1)*HORIZON*NLAT,MPI_BYTE,0,MPI_COMM_CALC,IERROR) @@ -164,7 +163,7 @@ subroutine readdiss(newseason) write(fname2,fmt='(''jcl1km'',i2.2,''.dat'')') newseason call open_file(IO_DJ,"r",fname2,needed=.true.) call CheckStop(ios,"DefPhotolysis: ios error in jcl1km ") - endif + end if if(me == 0)then @@ -176,8 +175,8 @@ subroutine readdiss(newseason) do k = 2,KMAX_MID-KMAX20+2 do nr=1,NPHODIS djcl1(nr,K,izn)=djcl1(nr,KCHEMTOP,izn) - enddo - enddo + end do + end do do k = KMAX_MID-KMAX20+3,KMAX_MID !TEMPORARY FIX do k = KCHEMTOP+1,KMAX_MID read(IO_DJ,999) myz,(djcl1(nr,k,izn),nr=1,NPHODIS) @@ -188,11 +187,11 @@ subroutine readdiss(newseason) do k = KCHEMTOP,KMAX_MID do nr=1,NPHODIS djcl1(nr,k,izn)=djcl1(nr,k,izn)/dj(nr,k,izn,3)-1.0 - enddo ! nr + end do ! nr end do ! k end do ! izn close(IO_DJ) - endif ! me = 0 + end if ! me = 0 CALL MPI_BCAST(djcl1 ,8*NPHODIS*(KMAX_MID-KCHEMTOP+1)*HORIZON,MPI_BYTE,0,MPI_COMM_CALC,IERROR) @@ -206,7 +205,7 @@ subroutine readdiss(newseason) write(fname3,fmt='(''jcl3km'',i2.2,''.dat'')') newseason call open_file(IO_DJ,"r",fname3,needed=.true.) call CheckStop(ios,"DefPhotolysis: ios error in jcl3km ") - endif + end if if(me == 0)then @@ -218,8 +217,8 @@ subroutine readdiss(newseason) do k = 2,KMAX_MID-KMAX20+2 do nr=1,NPHODIS djcl3(nr,K,izn)=djcl3(nr,KCHEMTOP,izn) - enddo - enddo + end do + end do do k = KMAX_MID-KMAX20+3,KMAX_MID !TEMPORARY FIX do k = KCHEMTOP+1,KMAX_MID read(IO_DJ,999) myz,(djcl3(nr,k,izn),nr=1,NPHODIS) @@ -230,10 +229,10 @@ subroutine readdiss(newseason) do k = KCHEMTOP,KMAX_MID do nr=1,NPHODIS djcl3(nr,k,izn)=djcl3(nr,k,izn)/dj(nr,k,izn,3)-1. - enddo ! nr + end do ! nr end do ! k end do ! izn - endif ! me = 0 + end if ! me = 0 CALL MPI_BCAST(djcl3 ,8*NPHODIS*(KMAX_MID-KCHEMTOP+1)*HORIZON,MPI_BYTE,0,MPI_COMM_CALC,IERROR) @@ -306,7 +305,7 @@ subroutine setup_phot(i,j,errcode) print *,'top,base' errcode = 17 return - endif + end if iclcat = 1 if(z_bnd(i,j,top)-z_bnd(i,j,base) > 1.5e3) iclcat = 2 @@ -323,16 +322,16 @@ subroutine setup_phot(i,j,errcode) do k = KCHEMTOP,KMAX_MID do n=1,NRCPHOT rcphot(n,k) = dj(n,k,Grid%izen,la) - enddo - enddo + end do + end do else if(iclcat == 1)then clear = cc3dmax(i,j,KMAX_MID) do k = KCHEMTOP,KMAX_MID do n=1,NRCPHOT rcphot(n,k) = (1. + & clear*djcl1(n,k,Grid%izen)) * dj(n,k,Grid%izen,la) - enddo ! n - enddo ! k + end do ! n + end do ! k else @@ -341,9 +340,9 @@ subroutine setup_phot(i,j,errcode) do n=1,NRCPHOT rcphot(n,k) = (1. + & clear*djcl3(n,k,Grid%izen))*dj(n,k,Grid%izen,la) - enddo - enddo - endif + end do + end do + end if if ( DEBUG_DJ ) then sum_rcphot = sum_rcphot + & diff --git a/DerivedFields_ml.f90 b/DerivedFields_ml.f90 index 90e1667..fd3e402 100644 --- a/DerivedFields_ml.f90 +++ b/DerivedFields_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -33,8 +33,8 @@ module DerivedFields_ml private integer, public, parameter :: & - MAXDEF_DERIV2D = 250 & ! Max. No. 2D derived fields to be defined - ,MAXDEF_DERIV3D = 17 ! Max. No. 3D derived fields to be defined + MAXDEF_DERIV2D = 488 & ! Max. No. 2D derived fields to be defined + ,MAXDEF_DERIV3D = 230 ! Max. No. 3D derived fields to be defined ! We put definitions of **all** possible variables in def_2d, def_3d diff --git a/Derived_ml.f90 b/Derived_ml.f90 index ded3a27..e76be28 100644 --- a/Derived_ml.f90 +++ b/Derived_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -63,9 +63,9 @@ module Derived_ml def_2d, def_3d, f_2d, f_3d, d_2d, d_3d use EcoSystem_ml, only: DepEcoSystem, NDEF_ECOSYSTEMS, & EcoSystemFrac,FULL_ECOGRID -use EmisDef_ml, only: EMIS_FILE, O_DMS, loc_frac +use EmisDef_ml, only: NSECTORS, EMIS_FILE, O_DMS, O_NH3, loc_frac, Nneighbors& + ,SumSnapEmis, SumSecEmis, SumSplitEmis, SecEmisOut, NEMIS_FILE use EmisGet_ml, only: nrcemis,iqrc2itot -use Emissions_ml, only: SumSnapEmis, SumSplitEmis use GridValues_ml, only: debug_li, debug_lj, debug_proc, A_mid, B_mid, & dA,dB,xm2, GRIDWIDTH_M, GridArea_m2,xm_i,xm_j,glon,glat use Io_Progs_ml, only: datewrite @@ -76,21 +76,21 @@ module Derived_ml use ModelConstants_ml, only: & KMAX_MID,KMAX_BND & ! => z dimension: layer number,level number ,NPROC & ! No. processors - ,dt_advec & + ,dt_advec & ,PPBINV & ! 1.0e9, for conversion of units ,PPTINV & ! 1.0e12, for conversion of units ,DEBUG & ! gives DEBUG%AOT ,AERO & ! for DpgV (was diam) - aerosol MMD (um) ,PT & - ,FORECAST & ! only dayly (and hourly) output on FORECAST mode + ,FORECAST & ! only daily (and hourly) output on FORECAST mode ,NTDAY & ! Number of 2D O3 to be saved each day (for SOMO) ,num_lev3d,lev3d & ! 3D levels on 3D output ! output types corresponding to instantaneous,year,month,day ,IOU_INST,IOU_YEAR,IOU_MON,IOU_DAY,IOU_HOUR,IOU_HOUR_INST,IOU_KEY & - ,MasterProc,SOURCE_RECEPTOR,DEBUG_COLSRC & - ,USE_AOD, USE_OCEAN_DMS, USE_uEMEP, uEMEP,startdate,enddate + ,MasterProc, SOURCE_RECEPTOR & + ,USE_AOD, USE_OCEAN_DMS, USE_OCEAN_NH3, USE_uEMEP, uEMEP, startdate,enddate -use AOD_PM_ml, only: AOD_init,aod_grp,wavelength,& ! group and +use AOD_PM_ml, only: AOD_init,aod_grp,wavelength,& ! group and wanted_wlen,wanted_ext3d ! wavelengths use MosaicOutputs_ml, only: nMosaic, MosaicOutput use NumberConstants, only: UNDEF_R @@ -104,6 +104,7 @@ module Derived_ml use TimeDate_ml, only: day_of_year,daynumber,current_date,& tdif_days use TimeDate_ExtraUtil_ml,only: to_stamp +use uEMEP_ml, only: av_uEMEP use Units_ml, only: Units_Scale,Group_Units,& to_molec_cm3 ! converts roa [kg/m3] to M [molec/cm3] implicit none @@ -176,7 +177,7 @@ module Derived_ml logical, private, save :: dbgP ! = DEBUG%DERIVED .and. debug_proc character(len=100), private :: errmsg -integer, private :: i,j,k,l,n, ivoc, iou ! Local loop variables +integer, private :: i,j,k,l,n, ivoc, iou, isec ! Local loop variables integer, private, save :: iadv_O3=-999, & ! Avoid hard codded IXADV_SPCS iadv_NO3_C=-999,iadv_EC_C_WOOD=-999,iadv_EC_C_FFUEL=-999,iadv_POM_C_FFUEL=-999 @@ -189,7 +190,7 @@ module Derived_ml !========================================================================= subroutine Init_Derived() integer :: alloc_err - dbg0 = (DEBUG%DERIVED .and. MasterProc ) + dbg0 = (DEBUG%DERIVED .and. MasterProc ) allocate(D2_O3_DAY( LIMAX, LJMAX, NTDAY)) D2_O3_DAY = 0.0 @@ -213,7 +214,7 @@ subroutine Init_Derived() allocate(nav_2d(num_deriv2d,LENOUT2D),stat=alloc_err) call CheckStop(alloc_err,"Allocation of nav_2d") nav_2d = 0 - endif + end if if(num_deriv3d > 0) then if(dbg0) write(*,*) "Allocate arrays for 3d: ", num_deriv3d allocate(f_3d(num_deriv3d),stat=alloc_err) @@ -223,7 +224,7 @@ subroutine Init_Derived() allocate(nav_3d(num_deriv3d,LENOUT3D),stat=alloc_err) call CheckStop(alloc_err,"Allocation of nav_3d") nav_3d = 0 - endif + end if ! Avoid hard codded IXADV_SPCS iadv_O3 =find_index('O3' ,species_adv(:)%name ) @@ -245,11 +246,11 @@ subroutine Init_Derived() select case(nint(AERO%DpgV(2)*1e7)) case(25);fracPM25=0.37 case(30);fracPM25=0.27 - endselect + end select if(dbg0) write(*,"(a,2g12.3,i4)") ' CFAC INIT PMFRACTION ', & fracPM25, AERO%DpgV(2), nint(1.0e7*AERO%DpgV(2)) call CheckStop( fracPM25 < 0.01, "NEED TO SET FRACPM25") -endsubroutine Init_Derived +end subroutine Init_Derived !========================================================================= subroutine AddNewDeriv( name,class,subclass,txt,unit,index,f2d,& dt_scale,scale, avg,iotype,Is3D) @@ -277,14 +278,14 @@ subroutine AddNewDeriv( name,class,subclass,txt,unit,index,f2d,& avg,iotype) call AddDeriv(inderiv,Is3D=Is3D) -endsubroutine AddNewDeriv +end subroutine AddNewDeriv !========================================================================= subroutine AddDeriv(inderiv,Is3D) type(Deriv), intent(in) :: inderiv logical, intent(in), optional :: Is3D logical :: Is3D_local - dbg0 = (DEBUG%DERIVED .and. MasterProc ) + dbg0 = (DEBUG%DERIVED .and. MasterProc ) Is3D_local = .false. if(present(Is3D)) Is3D_local = Is3D @@ -292,7 +293,7 @@ subroutine AddDeriv(inderiv,Is3D) Nadded3d = Nadded3d + 1 N = Nadded3d if(dbg0) write(*,*) "Define 3d deriv ", N, trim(inderiv%name) - call CheckStop(N>MAXDEF_DERIV3D,"Nadded3d too big!") + call CheckStop(N>MAXDEF_DERIV3D,"Nadded3d too big! Increase MAXDEF_DERIV3D in DerivedFields_ml") def_3d(N) = inderiv else Nadded2d = Nadded2d + 1 @@ -300,12 +301,12 @@ subroutine AddDeriv(inderiv,Is3D) if(dbg0)then write(*,"(a,i6)") "DEBUG AddDeriv 2d ", N call print_Deriv_type(inderiv) - endif + end if !if(dbg0) write(*,*) "DALL", inderiv - call CheckStop(N>MAXDEF_DERIV2D,"Nadded2d too big!") + call CheckStop(N>MAXDEF_DERIV2D,"Nadded2d too big! Increase MAXDEF_DERIV2D in DerivedFields_ml") def_2d(N) = inderiv - endif -endsubroutine AddDeriv + end if +end subroutine AddDeriv !========================================================================= subroutine Define_Derived() ! Set the parameters for the derived parameters, including the codes @@ -323,8 +324,8 @@ subroutine Define_Derived() character(len=11), parameter:: sub="DefDerived:" character(len=TXTLEN_IND) :: outind - integer :: ind, iadv, ishl, idebug, n, igrp, iout - + integer :: ind, iadv, ishl, idebug, n, igrp, iout, isec_poll + if(dbg0) write(6,*) " START DEFINE DERIVED " ! same mol.wt assumed for PPM25 and PPMCOARSE @@ -343,21 +344,21 @@ subroutine Define_Derived() !Deriv index, f2d, dt_scale, scale, avg? rho Inst Yr Mn Day atw ! for AOT we can use index for the threshold, usually 40 call AddNewDeriv( "AOT40_Grid", "GRIDAOT","subclass","-", "ppb h", & - 40, -99, T, 1.0/3600.0, F, 'YMD' ) + 40, -99, T, 1.0/3600.0, F, 'YM' ) !------------------------------------------------------------------------------- !Deriv(name, class, subc, txt, unit !Deriv index, f2d, dt_scale, scale, avg? rho Inst Yr Mn Day atw ! NOT YET: Scale pressure by 0.01 to get hPa call AddNewDeriv( "PSURF ","PSURF", "SURF","-", "hPa", & - -99, -99, F, 1.0, T, 'YMD' ) + -99, -99, F, 1.0, T, 'YM' ) !Added for TFMM scale runs - call AddNewDeriv( "Kz_m2s","Kz_m2s", "-","-", "m2/s", & - -99, -99, F, 1.0, T, 'YMD' ) +!A17 call AddNewDeriv( "Kz_m2s","Kz_m2s", "-","-", "m2/s", & +!A17 -99, -99, F, 1.0, T, 'Y' ) - call AddNewDeriv( "u_ref","u_ref", "-","-", "m/s", & - -99, -99, F, 1.0, T, 'YMD' ) +!A17 call AddNewDeriv( "u_ref","u_ref", "-","-", "m/s", & +!A17 -99, -99, F, 1.0, T, 'Y' ) ! call AddNewDeriv( "SoilWater_deep","SoilWater_deep", "-","-", "m", & ! -99, -99, F, 1.0, T, 'YMD' ) @@ -365,11 +366,11 @@ subroutine Define_Derived() ! -99, -99, F, 1.0, T, 'YMD' ) call AddNewDeriv( "T2m","T2m", "-","-", "deg. C", & - -99, -99, F, 1.0, T, 'YMD' ) - call AddNewDeriv( "Idirect","Idirect", "-","-", "W/m2", & - -99, -99, F, 1.0, T, 'YMD' ) - call AddNewDeriv( "Idiffuse","Idiffuse", "-","-", "W/m2", & - -99, -99, F, 1.0, T, 'YMD' ) + -99, -99, F, 1.0, T, 'YM' ) +!A17 call AddNewDeriv( "Idirect","Idirect", "-","-", "W/m2", & +!A17 -99, -99, F, 1.0, T, 'YM' ) +!A17 call AddNewDeriv( "Idiffuse","Idiffuse", "-","-", "W/m2", & +!A17 -99, -99, F, 1.0, T, 'YM' ) ! OutputFields can contain both 2d and 3d specs. ! Settings for 2D and 3D are independant. @@ -388,7 +389,7 @@ subroutine Define_Derived() class = trim(OutputFields(ind)%txt4) select case(class) case ('Z_MID','Z','Z_BND','Zlev','dZ_BND','dZ') - iadv = -1 + iadv = -1 unittxt="m" Is3D=.true. case('PM25','PM25X','PM25_rh50','PM25X_rh50','PM10_rh50',& @@ -402,27 +403,29 @@ subroutine Define_Derived() iout=find_index(outname, species_adv(:)%name ) !-- Volcanic Emission: Skipp if not found if(outname(1:3)=="ASH")then - if(MasterProc.and.DEBUG_COLSRC)& - write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(outtyp),iadv,trim(outname) + if(MasterProc.and.DEBUG%COLSRC)& + write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(outtyp),iout,trim(outname) if(iout<1)cycle - endif + end if call CheckStop(iout<0,sub//"OutputFields "//trim(outtyp)//& " not found "//trim(outname)) + call Units_Scale(outunit,iout,unitscale,unittxt) outtyp = "FLYmax6h:SPEC" - subclass = outdim ! flxx-yy: xx to yy 1000 feet + subclass = outdim ! flxxx-yyy: xxx to yyy 100 feet outname = "MAX6h_"//trim(outname)//"_"//trim(subclass) case('FLYmax6h:GROUP') ! Fly Level, 6 hourly maximum iout=find_index(outname,chemgroups(:)%name) !-- Volcanic Emission: Skipp if not found if(outname(1:3)=="ASH")then - if(MasterProc.and.DEBUG_COLSRC)& - write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(class),igrp,trim(outname) + if(MasterProc.and.DEBUG%COLSRC)& + write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(class),iout,trim(outname) if(iout<1)cycle - endif + end if call CheckStop(iout<0,sub//"OutputFields "//trim(outtyp)//& " not found "//trim(outname)) + call Units_Scale(outunit,-1,unitscale,unittxt) outtyp = "FLYmax6h:GROUP" - subclass = outdim ! flxx-yy: xx to yy 1000 feet + subclass = outdim ! flxxx-yyy: xxx to yyy 100 feet outname = "MAX6h_"//trim(outname)//"_"//trim(subclass) case('COLUMN','COLUMN:SPEC') !COL 'NO2', 'molec/cm2' ,'k20','COLUMN' ,'MISC' ,4, @@ -454,7 +457,7 @@ subroutine Define_Derived() case default call CheckStop(sub//"OutputFields%class Unsupported "//& trim(outtyp)//":"//trim(outname)//":"//trim(outdim)) - endselect + end select call CheckStop(iout<0,sub//"OutputFields%class "//trim(class)//& " not found "//trim(outname)) unitscale = 1.0 @@ -463,14 +466,14 @@ subroutine Define_Derived() if(outname(1:3)/=class(1:3))& outname = class(1:3)//"_"//trim(outname) outname = trim(outname)//"_"//trim(subclass) - Is3D = (class(1:3)=="EXT") + Is3D = (class(1:3)=="EXT") call AOD_init("Derived:"//trim(class),wlen=trim(subclass),out3d=Is3D) case default if(outdim=='3d')Is3D=.true. unitscale = 1.0 if(outunit=="ppb") unitscale = PPBINV unittxt=trim(outunit) - endselect + end select if(MasterProc)write(*,"(3a)") & "Deriv:MISC "//trim(outname),outind,trim(class) @@ -485,10 +488,10 @@ subroutine Define_Derived() iadv = find_index(outname, species_adv(:)%name ) !-- Volcanic Emission: Skipp if not found if(outname(1:3)=="ASH")then - if(MasterProc.and.DEBUG_COLSRC)& + if(MasterProc.and.DEBUG%COLSRC)& write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(outtyp),iadv,trim(outname) if(iadv<1)cycle - endif + end if call CheckStop(iadv<0,sub//"OutputFields Species not found "//trim(outname)) iout = iadv call Units_Scale(outunit,iadv,unitscale,unittxt,volunit) @@ -505,22 +508,22 @@ subroutine Define_Derived() igrp = find_index(outname, chemgroups(:)%name ) !-- Volcanic Emission: Skipp if not found if(outname(1:3)=="ASH")then - if(MasterProc.and.DEBUG_COLSRC)& - write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(outtyp),iadv,trim(outname) + if(MasterProc.and.DEBUG%COLSRC)& + write(*,"(A,':',A,1X,I0,':',A)")'ColumSource',trim(outtyp),igrp,trim(outname) if(igrp<1)cycle - endif + end if call CheckStop(igrp<0,sub//"OutputFields Group not found "//trim(outname)) iout = igrp call Units_Scale(outunit,-1,unitscale,unittxt,volunit,semivol=semivol) ! Units_Scale(iadv=-1) returns 1.0 ! group_calc gets the unit conversion factor from Group_Units - if( semivol ) subclass = 'FSOA' + if( semivol ) subclass = 'FSOA' if(debug_proc.and.DEBUG%DERIVED) write(*,"(2a)") 'FSOA GRPOM:', & trims( outname // ':' // outunit // ':' // subclass ) case default call CheckStop(sub//" Unsupported OutputFields%outtyp "//& trim(outtyp)//":"//trim(outname)//":"//trim(outdim)) - endselect + end select class="MASS";if(volunit)class="PPB" ! CHANGE PPB to VOL select case(outdim) @@ -530,10 +533,17 @@ subroutine Define_Derived() dname = "SURF_"//trim(outunit)//"_"//trim(outname) call CheckStop(find_index(dname,def_2d(:)%name)>0,& sub//"OutputFields already defined output "//trim(dname)) + case("Local_Correct") + Is3D = .false. + class = "SURF_"//trim(class) //"_"//trim(outtyp) + dname = "SURF_LF_"//trim(outunit)//"_"//trim(outname) + subclass = 'LocFrac_corrected' + call CheckStop(find_index(dname,def_2d(:)%name)>0,& + sub//"OutputFields already defined output "//trim(dname)) if(dbg0) write(*,"(a,2i4,4(1x,a),es10.2)")"ADD",& ind, iout, trim(dname),";", trim(class), outind,unitscale - + case("3d","3D","MLEV") Is3D = .true. class = "3D_"//trim(class) //"_"//trim(outtyp) @@ -547,12 +557,12 @@ subroutine Define_Derived() case default call CheckStop(sub//" Unsupported OutputFields%outdim "//& trim(outtyp)//":"//trim(outname)//":"//trim(outdim)) - endselect + end select !FSOA call AddNewDeriv(dname,class,"-","-",trim(unittxt),& call AddNewDeriv(dname,class,subclass,"-",trim(unittxt),& iout,-99,F,unitscale,T,outind,Is3D=Is3D) - endif - enddo ! OutputFields + end if + end do ! OutputFields !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< do n = 1, nOutputMisc @@ -560,7 +570,7 @@ subroutine Define_Derived() if(MasterProc) write(*,"(3(A,1X),L1)") & 'ADDMISC',trim(OutputMisc(n)%name),'Is3D',Is3D call AddDeriv(OutputMisc(n),Is3D=Is3D) - enddo + end do !------------------------------------------------------------------------------- do n = 1, nMosaic @@ -578,17 +588,18 @@ subroutine Define_Derived() do ind = 1, size(WDEP_WANTED(1:nOutputWdep)%txt1) dname = "WDEP_"//trim(WDEP_WANTED(ind)%txt1) + outind = trim(WDEP_WANTED(ind)%txt4) select case(WDEP_WANTED(ind)%txt2) case("PREC") call AddNewDeriv("WDEP_PREC","PREC ","-","-", "mm", & - -1, -99, F, 1.0, F, 'YMD' ) + -1, -99, F, 1.0, F, outind) case("SPEC") iadv = find_index(WDEP_WANTED(ind)%txt1, species_adv(:)%name) call CheckStop(iadv<1, "WDEP_WANTED Species not found " // trim(dname) ) call Units_Scale(WDEP_WANTED(ind)%txt3,iadv,unitscale,unittxt) call AddNewDeriv( dname, "WDEP", "-", "-", unittxt , & - iadv, -99, F, unitscale, F, 'YMD') + iadv, -99, F, unitscale, F, outind) case("GROUP") igrp = find_index(dname, chemgroups(:)%name) call CheckStop(igrp<1, "WDEP_WANTED Group not found " // trim(dname) ) @@ -597,12 +608,12 @@ subroutine Define_Derived() ! Init_WetDep gets the unit conversion factors from Group_Scale. call Units_Scale(WDEP_WANTED(ind)%txt3,-1,unitscale,unittxt) call AddNewDeriv( dname, "WDEP ","-","-", unittxt , & - igrp, -99, F, 1.0, F, 'YMD') + igrp, -99, F, 1.0, F, outind) case default call CheckStop("Unknown WDEP_WANTED type " // trim(WDEP_WANTED(ind)%txt2) ) - endselect + end select if(MasterProc) write(*,*)"Wet deposition output: ",trim(dname)," ",trim(unittxt) - enddo + end do !Emissions: ! We use mg/m2 outputs for consistency with depositions @@ -619,8 +630,8 @@ subroutine Define_Derived() if(EMIS_BioNat(ind)(1:5)=="ASH_L")cycle ! skip ASH_LxxByy for AshInversion dname = "Emis_mgm2_BioNat" // trim(EMIS_BioNat(ind) ) call AddNewDeriv( dname, "NatEmis", "-", "-", "mg/m2", & - ind , -99, T , 1.0e6, F, 'YMD' ) - enddo + ind , -99, T , 1.0e6, F, 'YM' ) + end do ! SNAP emissions called every hour, given in kg/m2/s, but added to ! d_2d every advection step, so get kg/m2. @@ -630,39 +641,37 @@ subroutine Define_Derived() do ind = 1, size(EMIS_FILE) dname = "Emis_mgm2_" // trim(EMIS_FILE(ind)) call AddNewDeriv( dname, "SnapEmis", "-", "-", "mg/m2", & - ind , -99, T, 1.0e6, F, 'YMD' ) - enddo ! ind + ind , -99, T, 1.0e6, F, 'YM' ) + end do ! ind + + isec_poll = 0 + do i = 1, NEMIS_FILE + if(SecEmisOut(i))then + do isec=1,NSECTORS + write(dname,"(A,I0,A)")"Emis_mgm2_sec",isec,trim(EMIS_FILE(i)) + call AddNewDeriv( dname, "SecEmis", "-", "-", "mg/m2", & + isec_poll , -99, T, 1.0e6, F, 'YM' ) + isec_poll = isec_poll + 1 + end do + endif + end do if(USE_OCEAN_DMS)then dname = "Emis_mgm2_DMS" call AddNewDeriv( dname, "Emis_mgm2_DMS", "-", "-", "mg/m2", & - ind , -99, T, 1.0, F, 'YMD' ) - endif - if(USE_uEMEP)then - dname = "Local_Pollutant" - call AddNewDeriv( dname, "Local_Pollutant", "-", "-", "mg/m2", & - -99 , -99, F, 1.0, T, 'YMD' ) - dname = "Total_Pollutant" - call AddNewDeriv( dname, "Total_Pollutant", "-", "-", "mg/m2", & - -99 , -99, F, 1.0, T, 'YMD' ) - dname = "Local_Fraction"!NB must be AFTER "Local_Pollutant" and "Total_Pollutant" - call AddNewDeriv( dname, "Local_Fraction", "-", "-", "", & - -99 , -99, F, 1.0, F, 'YMD' ) - dname = "Local_Pollutant3D" - call AddNewDeriv( dname, "Local_Pollutant3D", "-", "-", "mg/m2", & - -99 , -99, F, 1.0, T, 'YM' , .true.) - dname = "Total_Pollutant3D" - call AddNewDeriv( dname, "Total_Pollutant3D", "-", "-", "mg/m2", & - -99 , -99, F, 1.0, T, 'YM' , .true.) - dname = "Local_Fraction3D"!NB must be AFTER "Local_Pollutant" and "Total_Pollutant" - call AddNewDeriv( dname, "Local_Fraction3D", "-", "-", "", & - -99 , -99, F, 1.0, F, 'YM', .true.) - endif + ind , -99, T, 1.0, F, 'YM' ) + end if + if(USE_OCEAN_NH3)then + dname = "Emis_mgm2_Ocean_NH3" + call AddNewDeriv( dname, "Emis_mgm2_Ocean_NH3", "-", "-", "mg/m2", & + ind , -99, T, 1.0, F, 'YM' ) + end if + !Splitted total emissions (inclusive Natural) do ind=1,nrcemis dname = "EmisSplit_mgm2_"//trim(species(iqrc2itot(ind))%name) call AddNewDeriv(dname, "EmisSplit_mgm2", "-", "-", "mg/m2", & - ind , -99, T, 1.0e6, F, 'YMD' ) - enddo + ind , -99, T, 1.0e6, F, 'YM' ) + end do if(find_index("SURF_PM25water",def_2d(:)%name)<1)& call AddNewDeriv("SURF_PM25water", "PM25water", "-", "-","ug/m3", & @@ -711,12 +720,12 @@ subroutine Define_Derived() if(find_index("D3_Zlev",def_3d(:)%name)<1)& call AddNewDeriv("D3_Zlev", "Z_BND", "-", "-", "m", & -99 , -99, F, 1.0, T, 'YMD', Is3D ) - + case ("wind_speed_3D") call AddNewDeriv("wind_speed_3D", "wind_speed_3D", "-", "-", "m", & -99 , -99, F, 1.0, T, 'YM', Is3D ) - endselect - enddo + end select + end do ! Get indices of wanted fields in larger def_xx arrays: do i = 1, num_deriv2d @@ -734,9 +743,9 @@ subroutine Define_Derived() print *,"OOOPS N,N :", num_deriv2d, Nadded2d print "(a,i4,a)",("Had def_2d: ",idebug,& trim(def_2d(idebug)%name),idebug = 1, Nadded2d) - call CheckStop(sub//"OOPS STOPPED" // trim( wanted_deriv2d(i) ) ) - endif - enddo + call CheckStop(sub//"OOPS1 STOPPED" // trim( wanted_deriv2d(i) ) ) + end if + end do do i = 1, num_deriv3d if(dbg0) print *,"CHECK 3d", num_deriv3d, i, trim(wanted_deriv3d(i)) @@ -754,8 +763,8 @@ subroutine Define_Derived() print "(a,i4,a)",("Had def_3d: ",idebug,& trim(def_3d(idebug)%name),idebug = 1, Nadded3d) call CheckStop(sub//"OOPS STOPPED" // trim( wanted_deriv3d(i) ) ) - endif - enddo + end if + end do !Initialise to zero if (num_deriv2d > 0) d_2d(:,:,:,:) = 0.0 @@ -769,14 +778,14 @@ subroutine Define_Derived() do i=1,num_deriv2d if(iou_list(iou))exit iou_list(iou)=(index(f_2d(i)%iotype,IOU_KEY(iou))>0) - enddo + end do do i=1,num_deriv3d if(iou_list(iou))exit iou_list(iou)=(index(f_3d(i)%iotype,IOU_KEY(iou))>0) - enddo - enddo + end do + end do - if(SOURCE_RECEPTOR)& ! We include daily and monthly also + if(SOURCE_RECEPTOR)& ! We include daily and monthly also iou_list(IOU_DAY+1:)=.false. ! for SOURCE_RECEPTOR mode which makes ! it easy for debugging @@ -785,12 +794,12 @@ subroutine Define_Derived() case( : 27);iou_list(:IOU_DAY-1)=.false. ! Only dayly & hourly outputs case( 28:180);iou_list(:IOU_MON-1)=.false. ! .. and monthly case(181: ); ! .. and full-run - endselect - endif + end select + end if if(dbgP) write(*,"(A,': ',10(I2,A2,L2,:,','))")"Wanted IOUs",& (iou,IOU_KEY(iou),iou_list(iou),iou=IOU_MIN,IOU_MAX) -endsubroutine Define_Derived +end subroutine Define_Derived !========================================================================= function wanted_iou(iou,iotype,only_iou) result(wanted) integer, intent(in) :: iou @@ -801,11 +810,11 @@ function wanted_iou(iou,iotype,only_iou) result(wanted) if(wanted)wanted=iou_list(iou) ! any output requires iou? if(wanted.and.present(iotype))then wanted=(index(iotype,IOU_KEY(iou))>0) ! iotype contains IOU_KEY(iou)? - endif + end if if(wanted.and.present(only_iou))then wanted=(iou==only_iou) ! is only_iou? - endif -endfunction wanted_iou + end if +end function wanted_iou !========================================================================= subroutine Setups() integer :: n @@ -833,17 +842,17 @@ subroutine Setups() nvoc = nvoc + 1 voc_index(nvoc) = n voc_carbon(nvoc) = species( NSPEC_SHL+n )%carbons - endif - enddo + end if + end do !==================================================================== !if (DEBUG .and. MasterProc )then if ( MasterProc )then write(6,*) "Derived VOC setup returns ", nvoc, "vocs" write(6,"(a12,/,(20i3))") "indices ", voc_index(1:nvoc) write(6,"(a12,/,(20i3))") "carbons ", voc_carbon(1:nvoc) - endif - endif -endsubroutine Setups + end if + end if +end subroutine Setups !========================================================================= subroutine Derived(dt,End_of_Day,ONLY_IOU) !*** DESCRIPTION @@ -863,7 +872,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) real :: thour ! Time of day (GMT) real :: timefrac ! dt as fraction of hour (3600/dt) real :: dayfrac ! fraction of day elapsed (in middle of dt) - real :: af, xtot, fl0, fl1 + real :: af, fl0, fl1 real, save :: km2_grid integer :: ntime ! 1...NTDAYS integer :: klow ! lowest extent of column data @@ -880,14 +889,14 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ind2d_pmfine=-999 ,ind3d_pmfine=-999, & ind2d_pmwater=-999,ind3d_pmwater=-999, & ind2d_pm10=-999 ,ind3d_pm10=-999 - - integer :: imet_tmp, iix,ix,index + + integer :: imet_tmp, index real, pointer, dimension(:,:,:) :: met_p => null() logical, allocatable, dimension(:) :: ingrp integer :: wlen,ispc,kmax - integer,save :: n_Local_Pollutant, n_Total_Pollutant,& - n_Local_Pollutant3D, n_Total_Pollutant3D + integer :: isec_poll,isec,iisec,ipoll + real :: default_frac,tot_frac,loc_frac_corr timefrac = dt/3600.0 thour = current_date%hour+current_date%seconds/3600.0 @@ -943,38 +952,48 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) !DS May 2015 ! Meteo fields are available through their names and a pointer, either - ! from the read-in NWP fields (met%) or the derived met fields + ! from the read-in NWP fields (met%) or the derived met fields ! (metderiv%), see MetFields_ml. We thus use the required name and see ! if we can find it in either met% or metderiv% - imet_tmp = find_index(subclass, met(:)%name ) ! subclass has meteo name from MetFields + imet_tmp = find_index(subclass, met(:)%name ) ! subclass has meteo name from MetFields if( imet_tmp > 0 ) then - met_p => met(imet_tmp)%field(:,:,:,1) + !Note: must write bounds explicitly for "special2d" to work + met_p => met(imet_tmp)%field(1:limax,1:ljmax,1:1,1) else imet_tmp = find_index(subclass, derivmet(:)%name ) - if( imet_tmp > 0 ) met_p => derivmet(imet_tmp)%field(:,:,:,1) + if( imet_tmp > 0 ) met_p => derivmet(imet_tmp)%field(1:limax,1:ljmax,1:1,1) end if if( imet_tmp > 0 ) then kmax=1 if(met(imet_tmp)%dim==3)kmax=KMAX_MID!take lowest level if( MasterProc.and.first_call) write(*,*) "MET2D"//trim(name), & - imet_tmp, met_p(2,2,kmax) + imet_tmp, met_p(1,1,kmax),loc(met(imet_tmp)%field(1,1,1,1)) forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = met_p(i,j,kmax) end forall - + met_p => null() else ! Not found! - if( first_call) then - if( MasterProc) write(*,*) "MET2D NOT FOUND"//trim(name)//":"//trim(subclass) - forall ( i=1:limax, j=1:ljmax ) - d_2d( n, i,j,IOU_INST) = 0.0 ! UNDEF_R - end forall - end if - end if - + !make derived fields: + select case ( subclass ) + case ("inv_u10") + forall ( i=1:limax, j=1:ljmax ) + d_2d( n, i,j,IOU_INST) = 1.0/(0.2+ws_10m(i,j,1)) + end forall + + case default + if( first_call) then + if( MasterProc) write(*,*) "MET2D NOT FOUND"//trim(name)//":"//trim(subclass) + forall ( i=1:limax, j=1:ljmax ) + d_2d( n, i,j,IOU_INST) = 0.0 ! UNDEF_R + end forall + end if + end select + end if + ! The following can be deleted once testing of MET2D is finished... case ( "xm_i" ) forall ( i=1:limax, j=1:ljmax ) @@ -1095,15 +1114,122 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) end if case ( "SURF_PPB_SPEC" ) - forall ( i=1:limax, j=1:ljmax ) - d_2d( n, i,j,IOU_INST) = xn_adv(index,i,j,KMAX_MID) & - * cfac(index,i,j) - end forall + if(subclass=='LocFrac_corrected')then + do ipoll=1,uEMEP%Npoll + do i=1,uEMEP%poll(ipoll)%Nix + if(index==uEMEP%poll(ipoll)%ix(i))goto 44 + enddo + enddo + if(me==0)write(*,*)'WARNING, no local fractions found for ',trim(class),' index ',index + 44 continue + if(me==0.and. first_call)then + write(*,*)'local fractions found for ',trim(class),& + ' index ',index,' name ',trim(species_adv(index)%name),& + ' locfrac pollutant ',trim(uEMEP%poll(ipoll)%emis) + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + write(*,*)'local correction for sector',isec,' pollutant ',trim(species_adv(index)%name) + enddo + + endif + do j=1,ljmax + do i=1,limax + default_frac=0.0!local, but any sector that is not explicit + tot_frac=0.0!all local (any sector) + loc_frac_corr=0.0 + !isec is sector (number between 1 and 11) + !iisec is index over available sectors + !isec_poll is an internal uEMEP index that is a combination of sector and pollutant indices + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + if(isec/=0)then + default_frac = default_frac - loc_frac(isec_poll,0,0,i,j,KMAX_MID) + tot_frac = tot_frac + loc_frac(isec_poll,0,0,i,j,KMAX_MID) + endif + if(isec==0)default_frac = default_frac + loc_frac(isec_poll,0,0,i,j,KMAX_MID) + enddo + default_frac=max(0.0,default_frac)!in case "sec=0" not available + tot_frac = tot_frac + default_frac + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + if(isec/=0)then + loc_frac_corr=loc_frac_corr+loc_frac(isec_poll,0,0,i,j,KMAX_MID)*2!*LocEmisFac(isec) + endif + enddo + loc_frac_corr=loc_frac_corr+default_frac*2!*LocEmisFac_default + loc_frac_corr=loc_frac_corr+(1-tot_frac)!No correction for pollutants from other sources + + d_2d( n, i,j,IOU_INST) = xn_adv(index,i,j,KMAX_MID) & + * cfac(index,i,j) * loc_frac_corr + enddo + enddo + else + forall ( i=1:limax, j=1:ljmax ) + d_2d( n, i,j,IOU_INST) = xn_adv(index,i,j,KMAX_MID) & + * cfac(index,i,j) + end forall + endif if ( dbgP ) call write_debugadv(n,index, 1.0, "PPB OUTS") - + case ( "SURF_MASS_SPEC" ) ! Here we need density - forall ( i=1:limax, j=1:ljmax ) + if(subclass=='LocFrac_corrected')then + do ipoll=1,uEMEP%Npoll + do i=1,uEMEP%poll(ipoll)%Nix + if(index==uEMEP%poll(ipoll)%ix(i))goto 45 + enddo + enddo + if(me==0)write(*,*)'WARNING, no local fractions found for ',trim(class),' index ',index + 45 continue + if(me==0.and. first_call)then + write(*,*)'local fractions found for ',trim(class),' index ',index,& + ' name ',trim(species_adv(index)%name),& + ' locfrac pollutant ',trim(uEMEP%poll(ipoll)%emis) + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + write(*,*)'local correction for sector',isec,' pollutant ',trim(species_adv(index)%name) + enddo + + endif + do j=1,ljmax + do i=1,limax + default_frac=0.0!local, but any sector that is not explicit + tot_frac=0.0!all local (any sector) + loc_frac_corr=0.0 + !isec is sector (number between 1 and 11) + !iisec is index over available sectors + !isec_poll is an internal uEMEP index that is a combination of sector and pollutant indices + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + if(isec/=0)then + default_frac = default_frac - loc_frac(isec_poll,0,0,i,j,KMAX_MID) + tot_frac = tot_frac + loc_frac(isec_poll,0,0,i,j,KMAX_MID) + endif + if(isec==0)default_frac = default_frac + loc_frac(isec_poll,0,0,i,j,KMAX_MID) + enddo + default_frac=max(0.0,default_frac)!in case "sec=0" not available + tot_frac = tot_frac + default_frac + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=uEMEP%poll(ipoll)%sec_poll_ishift+iisec + isec=uEMEP%poll(ipoll)%sector(iisec) + if(isec/=0)then + loc_frac_corr=loc_frac_corr+loc_frac(isec_poll,0,0,i,j,KMAX_MID)*2!*LocEmisFac(isec) + endif + enddo + loc_frac_corr=loc_frac_corr+default_frac*2!*LocEmisFac_default + loc_frac_corr=loc_frac_corr+(1-tot_frac)!No correction for pollutants from other sources + + d_2d( n, i,j,IOU_INST) = xn_adv(index,i,j,KMAX_MID) & + * cfac(index,i,j) * density(i,j)* loc_frac_corr + enddo + enddo + else + forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = xn_adv(index,i,j,KMAX_MID) & * cfac(index,i,j) * density(i,j) end forall @@ -1119,6 +1245,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ! 'SHLSHLmcc'//trim( species(index)%name), thour, & ! xn_shl(index,debug_li,debug_lj,KMAX_MID), density(debug_li,debug_lj), to_molec_cm3 ! + endif ! WARNING CLASS PPB just means volume based.. case ( "SURF_PPB_SHL" ) ! short-lived. Follows pattern of MAXSHL below if ( f_2d(n)%unit == "ppb" ) then ! NOT ENABLED SO FAR ! @@ -1128,7 +1255,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) end forall else forall ( i=1:limax, j=1:ljmax ) - d_2d( n, i,j,IOU_INST) = xn_shl(index,i,j,KMAX_MID) + d_2d( n, i,j,IOU_INST) = xn_shl(index,i,j,KMAX_MID) end forall end if @@ -1146,7 +1273,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(f_2d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind2d_pmfine <1,"Missing PMFINE output for "//trim(class)) call CheckStop(iadv_NO3_C <1,"Unknown specie NO3_C") - endif + end if forall(i=1:limax,j=1:ljmax) & d_2d(n,i,j,IOU_INST) = d_2d(ind2d_pmfine,i,j,IOU_INST) + & @@ -1160,7 +1287,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(ind2d_pmfine <1,"Missing PMFINE output for "//trim(class)) call CheckStop(ind2d_pmwater<1,"Missing PM25water output for "//trim(class)) call CheckStop(iadv_NO3_C <1,"Unknown specie NO3_C") - endif + end if forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = d_2d(ind2d_pmfine ,i,j,IOU_INST) & @@ -1177,18 +1304,18 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) d_2d([ind2d_pmwater,ind2d_pmfine,n],i,j,IOU_INST), & fracPM25 * xn_adv(iadv_NO3_C,i,j,KMAX_MID) * ug_NO3_C & * cfac(iadv_NO3_C,i,j) * density(i,j) - endif + end if case("PM25X") ! Need to add PMFINE + fraction NO3_c if(first_call)then call CheckStop(f_2d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind2d_pmfine <1,"Missing PMFINE output for "//trim(class)) - endif + end if if(any([iadv_NO3_C,iadv_EC_C_WOOD,iadv_EC_C_FFUEL,iadv_POM_C_FFUEL]<1))then if(first_call.and.MasterProc) write(*,*) & "WARNING: Derived - not all "//trim(class)//" species present. Skipping" cycle !! Skip this case - endif + end if ! All this size class has the same cfac. forall ( i=1:limax, j=1:ljmax ) @@ -1206,12 +1333,12 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(f_2d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind2d_pmfine <1,"Missing PMFINE output for "//trim(class)) call CheckStop(ind2d_pmwater<1,"Missing PM25water output for "//trim(class)) - endif + end if if(any([iadv_NO3_C,iadv_EC_C_WOOD,iadv_EC_C_FFUEL,iadv_POM_C_FFUEL]<1))then if(first_call.and.MasterProc) write(*,*) & "WARNING: Derived - not all "//trim(class)//" species present. Skipping" cycle !! Skip this case - endif + end if forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = d_2d(ind2d_pmfine ,i,j,IOU_INST) & @@ -1229,7 +1356,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(f_2d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind2d_pm10 <1,"Missing PM10 output for "//trim(class)) call CheckStop(ind2d_pmwater<1,"Missing PM25water output for "//trim(class)) - endif + end if forall(i=1:limax,j=1:ljmax) & d_2d(n,i,j,IOU_INST) = d_2d(ind2d_pm10 ,i,j,IOU_INST) & @@ -1242,21 +1369,21 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(wlen<1,& "Unknown AOD wavelength "//trim(f_2d(n)%subclass)) call CheckStop(.not.wanted_wlen(wlen),& - "Unwanted AOD wavelength "//trim(f_2d(n)%subclass)) - endif - + "Unwanted AOD wavelength "//trim(f_2d(n)%subclass)) + end if + ngrp = size(aod_grp) allocate(ingrp(ngrp)) select case(class) case("AOD:GROUP") igrp = f_2d(n)%index do i=1,ngrp - ingrp(i)=any(aod_grp(i)==chemgroups(igrp)%ptr(:)) - enddo + ingrp(i)=any(aod_grp(i)==chemgroups(igrp)%specs(:)) + end do case("AOD:SPEC") ispc = f_2d(n)%index ingrp(:)=(aod_grp(:)==(ispc+NSPEC_SHL)) - endselect + end select forall ( i=1:limax, j=1:ljmax )& d_2d( n, i,j,IOU_INST) = SUM(AOD(:,i,j,wlen),MASK=ingrp) deallocate(ingrp) @@ -1288,8 +1415,8 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) .or.current_date%month <= 9 )then d_2d(n,:,:,IOU_YEAR ) = d_2d(n,:,:,IOU_YEAR ) + d_2d(n,:,:,IOU_DAY) nav_2d(n,IOU_YEAR) = nav_2d(n,IOU_YEAR) + 1 - endif - endif + end if + end if case ( "MAXSHL" ) ! Daily maxima - short-lived @@ -1322,8 +1449,8 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) .or.current_date%month <= 9 )then d_2d(n,:,:,IOU_YEAR ) = d_2d(n,:,:,IOU_YEAR ) + d_2d(n,:,:,IOU_DAY) nav_2d(n,IOU_YEAR) = nav_2d(n,IOU_YEAR) + 1 - endif - endif + end if + end if case ( "VOC", "TVOC" ) @@ -1366,7 +1493,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ! if(current_date%month>=4.and.current_date%month<=9)then d_2d(n,:,:,IOU_YEAR ) = d_2d(n,:,:,IOU_YEAR ) + d_2d(n,:,:,IOU_DAY) !NB overwritten anyway D2_O3_DAY = 0. - endif + end if case("PREC","WDEP","DDEP","VG","Rs","Rns","Gns","Mosaic","POD","SPOD","AOT") ! Nothing to do - all set in My_DryDep @@ -1374,10 +1501,10 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ! n, trim(f_2d(n)%name), d_2d(n,debug_li,debug_lj,IOU_INST) case('FLYmax6h','FLYmax6h:SPEC') ! Fly Level, 6 hourly maximum - ! fl00-20: 0 to 20 kfeet, fl20-35: 20 to 35 kfeet, fl35-50: 35 to 50 kfeet - read(subclass,"(a2,i2,a1,i2)") txt2, k, txt2, l - fl0=k*304.8 ! 1e3 [feet] to [m] - fl1=l*304.8 ! 1e3 [feet] to [m] + ! fl000-200: 0 to 20 kfeet, fl200-350: 20 to 35 kfeet, fl350-500: 35 to 50 kfeet + read(subclass,"(a2,i3,a1,i3)") txt2, k, txt2, l + fl0=k*30.48 ! [100 feet] to [m] + fl1=l*30.48 ! [100 feet] to [m] call Units_Scale(f_2d(n)%unit,index,af,needroa=needroa) ! only want needroa if(needroa)then tmpwork=maxval(xn_adv(index,:,:,:)*roa(:,:,:,1),dim=3,& @@ -1385,14 +1512,14 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) else tmpwork=maxval(xn_adv(index,:,:,:),dim=3,& mask=z_mid>=fl0.and.z_mid<=fl1) - endif + end if forall(i=1:limax,j=1:ljmax)& ! use IOU_YEAR as a buffer d_2d(n,i,j,IOU_YEAR)=max(d_2d(n,i,j,IOU_YEAR),tmpwork(i,j)) case('FLYmax6h:GROUP') ! Fly Level, 6 hourly maximum - ! fl00-02: 0 to 2 kfeet, fl02-35: 2 to 35 kfeet, fl35-50: 35 to 50 kfeet - read(subclass,"(a2,i2,a1,i2)") txt2, k, txt2, l - fl0=k*304.8 ! 1e3 [feet] to [m] - fl1=l*304.8 ! 1e3 [feet] to [m] + ! fl000-200: 0 to 20 kfeet, fl200-350: 20 to 35 kfeet, fl350-500: 35 to 50 kfeet + read(subclass,"(a2,i3,a1,i3)") txt2, k, txt2, l + fl0=k*30.48 ! [100 feet] to [m] + fl1=l*30.48 ! [100 feet] to [m] if(dbgP)print *,trim(subclass),fl0,fl1 do k=1,KMAX_MID mask2d(:,:)=(z_mid(:,:,k)>=fl0.and.z_mid(:,:,k)<=fl1) @@ -1401,9 +1528,15 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call group_calc(tmpwork(:,:),roa(:,:,k,1),f_2d(n)%unit,k,index) forall(i=1:limax,j=1:ljmax,mask2d(i,j))& ! use IOU_YEAR as a buffer d_2d(n,i,j,IOU_YEAR)=max(d_2d(n,i,j,IOU_YEAR),tmpwork(i,j)) - enddo + end do case ("COLUMN","COLUMN:SPEC") ! unit conversion factor stored in f_2d(n)%scale - read(f_2d(n)%subclass,"(a1,i2)") txt2, klow ! Connvert e.g. k20 to klow=20 + klow = KMAX_MID + 1 ! initialize too large + if (f_2d(n)%subclass == "kmax") then + klow = KMAX_MID + else + read(f_2d(n)%subclass,"(a1,i2)") txt2, klow ! Connvert e.g. k20 to klow=20 + end if + call CheckStop(klow>KMAX_MID, "column definition too large: "// f_2d(n)%subclass) do j = 1, ljmax do i = 1, limax k = 1 @@ -1419,11 +1552,11 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) trim(f_2d(n)%name), n, index, k, " => ", & roa(i,j,k,1), z_bnd(i,j,k)-z_bnd(i,j,k+1), & xn_adv(index,i,j,k),tmpwork(i,j) - enddo ! k + end do ! k d_2d(n,i,j,IOU_INST) = tmpwork(i,j) ! unit conversion ! is completed elsewere by *f_2d(n)%scale - enddo !i - enddo !j + end do !i + end do !j if(dbgP) write(*,"(a18,es12.3)") & "COLUMN:SPEC d2_2d",d_2d(n,debug_li,debug_lj,IOU_INST)*f_2d(n)%scale @@ -1432,14 +1565,20 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(igrp<1,"NEG GRP "//trim(f_2d(n)%name)) call CheckStop(igrp>size(chemgroups(:)%name), & "Outside GRP "//trim(f_2d(n)%name)) - read(f_2d(n)%subclass,"(a1,i2)") txt2, klow ! Connvert e.g. k20 to klow=20 + klow = KMAX_MID + 1 ! initialize too large + if (f_2d(n)%subclass == "kmax") then + klow = KMAX_MID + else + read(f_2d(n)%subclass,"(a1,i2)") txt2, klow ! Connvert e.g. k20 to klow=20 + end if + call CheckStop(klow>KMAX_MID, "column definition too large: "// f_2d(n)%subclass) d_2d(n,:,:,IOU_INST) = 0.0 do k=1,klow call group_calc(tmpwork(:,:),roa(:,:,k,1),f_2d(n)%unit,k,igrp) forall(i=1:limax,j=1:ljmax) & d_2d(n,i,j,IOU_INST) = d_2d(n,i,j,IOU_INST) & + tmpwork(i,j)*(z_bnd(i,j,k)-z_bnd(i,j,k+1)) ! unit conversion in group_calc - enddo + end do if(dbgP) write(*,"(a18,es12.3)") & "COLUMN:GROUP d2_2d",d_2d(n,debug_li,debug_lj,IOU_INST)*f_2d(n)%scale @@ -1485,54 +1624,25 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call datewrite("SnapEmis-in-Derived, still kg/m2/s", n, & !f_2d(n)%Index,& (/ SumSnapEmis( debug_li,debug_lj, f_2d(n)%Index ) /) ) + case ( "SecEmis" ) !emissions in mg/m2 per sector + + isec=mod(f_2d(n)%Index,NSECTORS)+1 + isec_poll=f_2d(n)%Index/NSECTORS + 1 + forall ( i=1:limax, j=1:ljmax ) + d_2d(n,i,j,IOU_INST) = SumSecEmis( i,j, isec,isec_poll) + end forall + case ( "Emis_mgm2_DMS" ) ! DMS forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = O_DMS%map(i,j) end forall - case("Local_Pollutant") ! for uEMEP, under development - do j=1,ljmax - do i=1,limax - xtot=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,kmax_mid)*species_adv(ix)%molwt)& - *(dA(kmax_mid)+dB(kmax_mid)*ps(i,j,1))/ATWAIR/GRAV - enddo - d_2d( n, i,j,IOU_INST) = loc_frac(i,j,kmax_mid,1)*xtot - enddo - enddo - n_Local_Pollutant=n - - case("Total_Pollutant") ! for uEMEP, under development - do j=1,ljmax - do i=1,limax - xtot=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,kmax_mid)*species_adv(ix)%molwt)& - *(dA(kmax_mid)+dB(kmax_mid)*ps(i,j,1))/ATWAIR/GRAV - enddo - d_2d( n, i,j,IOU_INST) = xtot - enddo - enddo - n_Total_Pollutant=n - - case("Local_Fraction") ! for uEMEP, under development - forall(i=1:limax,j=1:ljmax) - d_2d(n,i,j,IOU_INST) = 0.0 - d_2d(n,i,j,IOU_HOUR) = d_2d(n_Local_Pollutant,i,j,IOU_HOUR)/& - (d_2d(n_Total_Pollutant,i,j,IOU_HOUR)+1.E-30) - d_2d(n,i,j,IOU_DAY ) = d_2d(n_Local_Pollutant,i,j,IOU_DAY)/& - (d_2d(n_Total_Pollutant,i,j,IOU_DAY)+1.E-30) - d_2d(n,i,j,IOU_MON ) = d_2d(n_Local_Pollutant,i,j,IOU_MON)/& - (d_2d(n_Total_Pollutant,i,j,IOU_MON)+1.E-30) - d_2d(n,i,j,IOU_YEAR) = d_2d(n_Local_Pollutant,i,j,IOU_YEAR)/& - (d_2d(n_Total_Pollutant,i,j,IOU_YEAR)+1.E-30) - endforall - - - case ( "EmisSplit_mgm2" ) ! Splitted total emissions (Inclusive natural) + case ( "Emis_mgm2_Ocean_NH3" ) ! Ocean_NH3 + forall ( i=1:limax, j=1:ljmax ) + d_2d( n, i,j,IOU_INST) = O_NH3%map(i,j) + end forall + + case ( "EmisSplit_mgm2" ) ! Splitted total emissions (Inclusive natural) forall ( i=1:limax, j=1:ljmax ) d_2d( n, i,j,IOU_INST) = SumSplitEmis(i,j,f_2d(n)%Index) end forall @@ -1548,24 +1658,24 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(igrp<1,"NEG GRP "//trim(f_2d(n)%name)) call CheckStop(igrp>size(chemgroups(:)%name), & "Outside GRP "//trim(f_2d(n)%name)) - ngrp = size(chemgroups(igrp)%ptr) + ngrp = size(chemgroups(igrp)%specs) if(chemgroups(igrp)%name == "PMFINE" .and. ind2d_pmfine<0) then ind2d_pmfine = n if(MasterProc) write(*,"(a,2i4,2a15)") "FOUND FINE FRACTION ",& n, ind2d_pmfine, trim(chemgroups(igrp)%name), trim(f_2d(n)%name) - endif + end if if(chemgroups(igrp)%name == "PM10" .and. ind2d_pm10<0) then ind2d_pm10 = n if(MasterProc) write(*,"(a,2i4,2a15)") "FOUND PM10 FRACTION ",& n, ind2d_pm10, trim(chemgroups(igrp)%name), trim(f_2d(n)%name) - endif + end if if(dbg0) then write(*,"(a,3i5,2(1x,a))")"CASEGRP:"//trim(f_2d(n)%name), n, igrp,& ngrp, trim(class), trim(subclass) ! FSOA igrp=109, ngrp=10 - write(*,"(a,88i4)") "CASEGRP:", chemgroups(igrp)%ptr + write(*,"(a,88i4)") "CASEGRP:", chemgroups(igrp)%specs write(*,*) "CASEGRPunit ", trim(f_2d(n)%unit) - endif + end if call group_calc(d_2d(n,:,:,IOU_INST),density,f_2d(n)%unit,0,igrp,& semivol=(f_2d(n)%subclass=='FSOA')) @@ -1576,7 +1686,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) if(n==ind2d_pm10 ) & write(*,"(a,i4,es12.3)") "PM10 FRACTION:" ,n,d_2d(n,i,j,IOU_INST) write(*,*) "CASErho ", density(i,j) - endif + end if case("USET") if(dbgP) write(*,"(a18,i4,a12,a4,es12.3)")"USET d_2d",& @@ -1597,7 +1707,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call My_DerivFunc( d_2d(n,:,:,IOU_INST), class ) ! , density ) - endselect + end select !*** add to daily, monthly and yearly average, and increment counters select case(f_2d(n)%class) @@ -1606,7 +1716,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) d_2d(n,:,:,IOU_INST) = d_2d(n,:,:,IOU_YEAR) ! use IOU_YEAR as a buffer d_2d(n,:,:,IOU_HOUR) = d_2d(n,:,:,IOU_YEAR) if(mod(current_date%hour,6)==0)& ! reset buffer - d_2d(n,:,:,IOU_YEAR)=0.0 + d_2d(n,:,:,IOU_YEAR)=0.0 case("MAXADV","MAXSHL","SOMO") ! MAXADV and MAXSHL and SOMO needn't be summed here. ! These d_2d ( MAXADV, MAXSHL, SOMO) are set elsewhere @@ -1620,10 +1730,10 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) if(.not.wanted_iou(iou,f_2d(n)%iotype,ONLY_IOU))cycle d_2d(n,:,:,iou) = d_2d(n,:,:,iou) + d_2d(n,:,:,IOU_INST)*af if(f_2d(n)%avg) nav_2d(n,iou) = nav_2d(n,iou) + 1 - enddo - endselect + end do + end select - enddo ! num_deriv2d + end do ! num_deriv2d !****** 3-D fields ************************** @@ -1642,13 +1752,13 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) else forall( i=1:limax, j=1:ljmax, k=1:KMAX_MID )& inv_air_density3D(i,j,k) = 1.0/( roa(i,j,k,1) * to_molec_cm3 ) - endif + end if select case (class) case ( "MET3D" ) - imet_tmp = find_index(f_3d(n)%subclass, met(:)%name ) ! subclass has meteo name from MetFields + imet_tmp = find_index(f_3d(n)%subclass, met(:)%name ) ! subclass has meteo name from MetFields if(imet_tmp>0) then if(met(imet_tmp)%dim==3)then if( MasterProc.and.first_call) write(*,*) "MET3D"//trim(f_3d(n)%name), & @@ -1657,11 +1767,22 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) d_3d(n,i,j,k,IOU_INST)=met(imet_tmp)%field(i,j,lev3d(k),1) elseif(MasterProc.and.first_call)then write(*,*) "Warning: requested 2D field with MET3D: ",trim(f_3d(n)%name) - endif + end if elseif(first_call)then - if(MasterProc) write(*,*) "MET3D NOT FOUND"//trim(f_3d(n)%name)//":"//trim(f_3d(n)%subclass) - d_3d(n,:,:,:,IOU_INST)=0.0 - endif + !make derived fields: + select case ( f_3d(n)%subclass ) + case ("inv_wind_speed_3D") + forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & + d_3d(n,i,j,k,IOU_INST)=1.0/(0.2+sqrt(u_mid(i,j,lev3d(k))**2+v_mid(i,j,lev3d(k))**2)) + case("wind_speed_3D") + forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & + d_3d(n,i,j,k,IOU_INST)=sqrt(u_mid(i,j,lev3d(k))**2+v_mid(i,j,lev3d(k))**2) + + case default + if(MasterProc) write(*,*) "MET3D NOT FOUND"//trim(f_3d(n)%name)//":"//trim(f_3d(n)%subclass) + d_3d(n,:,:,:,IOU_INST)=0.0 + end select + end if ! Simple advected species: case ( "ADV" ) @@ -1671,7 +1792,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) case ( "BGN" ) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=xn_bgn(index,i,j,lev3d(k)) - + case ( "PM25water" ) !particle water forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=PM25_water(i,j,lev3d(k)) @@ -1682,7 +1803,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(f_3d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind3d_pmfine <1,"Missing PMFINE output for "//trim(class)) call CheckStop(iadv_NO3_C <1,"Unknown specie NO3_C") - endif + end if forall (i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST) = d_3d(ind3d_pmfine,i,j,k,IOU_INST) + & @@ -1696,7 +1817,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(ind3d_pmfine <1,"Missing PMFINE output for "//trim(class)) call CheckStop(ind3d_pmwater<1,"Missing PM25water output for "//trim(class)) call CheckStop(iadv_NO3_C <1,"Unknown specie NO3_C") - endif + end if forall (i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST) = d_3d(ind3d_pmfine ,i,j,k,IOU_INST) & @@ -1711,14 +1832,14 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) write(*,"(a,4es12.3)") "Adding PM25FRACTIONS:", & d_3d([ind3d_pmwater,ind3d_pmfine,n],i,j,k,IOU_INST), & ug_NO3_C * xn_adv(iadv_NO3_C,i,j,l) * roa(i,j,l,1) - endif + end if case("PM10_wet") ! Need to add PMFINE + fraction NO3_c if(first_call)then call CheckStop(f_3d(n)%unit(1:2)/="ug","Wrong unit for "//trim(class)) call CheckStop(ind3d_pm10 <1,"Missing PM10 output for "//trim(class)) call CheckStop(ind3d_pmwater<1,"Missing PM25water output for "//trim(class)) - endif + end if forall (i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST) = d_3d(ind3d_pm10 ,i,j,k,IOU_INST) & @@ -1727,11 +1848,11 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) case ("XKSIG00", "XKSIG12" ) !hf hmix Kz_m2s forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=Kz_m2s(i,j,lev3d(k)) - + case ("TH" ) ! Pot. temp (needed for cross sections) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=th(i,j,lev3d(k),1) - + case ("T" ) ! Absolute Temperature forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=th(i,j,lev3d(k),1)& @@ -1771,7 +1892,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=xn_adv(index,i,j,lev3d(k)) - if(dbgP) call write_debugadv(n,index, 1.0, "3D PPB OUTS") + if(dbgP) call write_debugadv(n,index, 1.0, "3D PPB OUTS",IS3D=.true.) case ( "3D_PPB_SHL" ) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & @@ -1781,34 +1902,34 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=xn_adv(index,i,j,lev3d(k))*roa(i,j,lev3d(k),1) - if(dbgP) call write_debugadv(n,index, 1.0, "3D UG OUTS") + if(dbgP) call write_debugadv(n,index, 1.0, "3D UG OUTS",IS3D=.true.) - case ( "3D_MASS_GROUP" ) ! + case ( "3D_MASS_GROUP","3D_PPB_GROUP" ) ! igrp = f_3d(n)%index call CheckStop(igrp<1,"NEG GRP "//trim(f_3d(n)%name)) call CheckStop(igrp>size(chemgroups(:)%name), & - "Outside GRP "//trim(f_3d(n)%name)) - ngrp = size(chemgroups(igrp)%ptr) + "Outside GRP "//trim(f_3d(n)%name)) + ngrp = size(chemgroups(igrp)%specs) if(chemgroups(igrp)%name == "PMFINE" .and. ind3d_pmfine<0) then ind3d_pmfine = n if(MasterProc) write(*,"(a,2i4,2a15)") "FOUND FINE 3d FRACTION ",& n, ind3d_pmfine, trim(chemgroups(igrp)%name), trim(f_3d(n)%name) - endif + end if if(chemgroups(igrp)%name == "PM10" .and. ind3d_pm10<0) then ind3d_pm10 = n if(MasterProc) write(*,"(a,2i4,2a15)") "FOUND PM10 3d FRACTION ",& n, ind3d_pm10, trim(chemgroups(igrp)%name), trim(f_3d(n)%name) - endif + end if if(dbg0) then write(*,*) "3DCASEGRP ", n, igrp, ngrp, trim(class) write(*,*) "3DCASENAM ", trim(f_3d(n)%name) - write(*,*) "3DCASEGRP:", chemgroups(igrp)%ptr + write(*,*) "3DCASEGRP:", chemgroups(igrp)%specs write(*,*) "3DCASEunit", trim(f_3d(n)%unit) - endif + end if do k=1,num_lev3d call group_calc(d_3d(n,:,:,k,IOU_INST),roa(:,:,lev3d(k),1),& f_3d(n)%unit,lev3d(k),igrp) - enddo + end do if(DEBUG%DERIVED.and.debug_proc)then i= debug_li; j=debug_lj; k=1; l=lev3d(k) @@ -1817,7 +1938,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) if(n==ind3d_pm10 ) & write(*,"(a,i4,es12.3)") "PM10 3d FRACTION:" ,n,d_3d(n,i,j,k,IOU_INST) write(*,*) "CASErho ", roa(i,j,l,1) - endif + end if case ( "Kz" ) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & @@ -1846,8 +1967,8 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) call CheckStop(wlen<1,& "Unknown EXT wavelength "//trim(f_3d(n)%subclass)) call CheckStop(.not.(wanted_wlen(wlen).and.wanted_ext3d),& - "Unwanted EXT wavelength "//trim(f_3d(n)%subclass)) - endif + "Unwanted EXT wavelength "//trim(f_3d(n)%subclass)) + end if ngrp = size(aod_grp) allocate(ingrp(ngrp)) @@ -1855,64 +1976,16 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) case("EXT:GROUP") igrp = f_3d(n)%index do i=1,ngrp - ingrp(i)=any(aod_grp(i)==chemgroups(igrp)%ptr(:)) - enddo + ingrp(i)=any(aod_grp(i)==chemgroups(igrp)%specs(:)) + end do case("EXT:SPEC") ispc = f_3d(n)%index ingrp(:)=(aod_grp(:)==(ispc+NSPEC_SHL)) - endselect + end select forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=SUM(Extin_coeff(:,i,j,lev3d(k),wlen),MASK=ingrp) deallocate(ingrp) - case("Local_Pollutant3D") ! for uEMEP, under development - do l=1,num_lev3d - k=lev3d(l) - do j=1,ljmax - do i=1,limax - xtot=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*species_adv(ix)%molwt)& - *(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV*1.0E6 - enddo - d_3d(n,i,j,l,IOU_INST) = loc_frac(i,j,k,1)*xtot - enddo - enddo - enddo - n_Local_Pollutant3D=n - !write(*,*)loc_frac(5,5,kmax_mid,1),loc_frac(5,5,kmax_mid-1,1) - - case("Total_Pollutant3D") ! for uEMEP, under development - do l=1,num_lev3d - k=lev3d(l) - do j=1,ljmax - do i=1,limax - xtot=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*species_adv(ix)%molwt)& - *(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV*1.0E6 - enddo - d_3d(n,i,j,l,IOU_INST) = xtot - enddo - enddo - enddo - n_Total_Pollutant3D=n - - case("Local_Fraction3D") ! for uEMEP, under development - forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) - d_3d(n,i,j,k,IOU_INST) = 0.0 - d_3d(n,i,j,k,IOU_HOUR) = d_3d(n_Local_Pollutant3D,i,j,k,IOU_HOUR)/& - (d_3d(n_Total_Pollutant3D,i,j,k,IOU_HOUR)+1.E-30) - d_3d(n,i,j,k,IOU_DAY ) = d_3d(n_Local_Pollutant3D,i,j,k,IOU_DAY)/& - (d_3d(n_Total_Pollutant3D,i,j,k,IOU_DAY)+1.E-30) - d_3d(n,i,j,k,IOU_MON ) = d_3d(n_Local_Pollutant3D,i,j,k,IOU_MON)/& - (d_3d(n_Total_Pollutant3D,i,j,k,IOU_MON)+1.E-30) - d_3d(n,i,j,k,IOU_YEAR) = d_3d(n_Local_Pollutant3D,i,j,k,IOU_YEAR)/& - (d_3d(n_Total_Pollutant3D,i,j,k,IOU_YEAR)+1.E-30) - endforall - case("USET") if(dbgP) write(*,"(a18,i4,a12,a4,es12.3)")"USET d_3d",& n, f_3d(n)%name, " is ", d_3d(n,debug_li,debug_lj,num_lev3d,IOU_INST) @@ -1923,7 +1996,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) write(unit=errmsg,fmt=*) "Derived 3D class NOT FOUND", n, index, & trim(f_3d(n)%name),trim(f_3d(n)%class) call CheckStop( errmsg ) - endselect + end select !*** add to monthly and yearly average, and increment counters select case(f_3d(n)%class) @@ -1941,7 +2014,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) if(.not.wanted_iou(iou,f_3d(n)%iotype,ONLY_IOU))cycle d_3d(n,:,:,:,iou) = d_3d(n,:,:,:,iou) + d_3d(n,:,:,:,IOU_INST) if(f_3d(n)%avg) nav_3d(n,iou) = nav_3d(n,iou) + 1 - enddo + end do if( dbgP ) then write(*,fmt="(a20,a9,i4,f8.3,2es12.3)") "END_OF_DAY MAX3D", & @@ -1950,11 +2023,11 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) d_3d(n,debug_li,debug_lj,KMAX_MID,IOU_INST ) write(*,"(a20,i4,2x,6i6)") "END_OF_DAY NAV ", & n, (nav_3d(n,i), i=1,LENOUT3D) - endif - + end if + d_3d(n,:,:,:,IOU_INST ) = 0.0 !! Reset d_3d - - endif ! End_of_Day + + end if ! End_of_Day case default af = 1.0 ! accumulation factor @@ -1962,14 +2035,20 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ! only accumulate outputs if they are wanted (will be written out) do iou=1,LENOUT3D - if(iou==IOU_INST)cycle + if(iou==IOU_INST)cycle if(.not.wanted_iou(iou,f_3d(n)%iotype,ONLY_IOU))cycle d_3d(n,:,:,:,iou) = d_3d(n,:,:,:,iou) + d_3d(n,:,:,:,IOU_INST)*af if(f_3d(n)%avg) nav_3d(n,iou) = nav_3d(n,iou) + 1 - enddo + end do + + end select + end do + + !the uemep fields do not fit in the general d_3d arrays. Use ad hoc routine + if(USE_uEMEP .and. .not. present(ONLY_IOU))then + call av_uEMEP(dt,End_of_Day) + endif - endselect - enddo first_call = .false. end subroutine Derived !========================================================================= @@ -2004,9 +2083,9 @@ subroutine DerivedProds(text,dt) forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=d_3d(n,i,j,k,IOU_INST)& -xn_adv(index,i,j,lev3d(k)) - endselect - enddo -endsubroutine DerivedProds + end select + end do +end subroutine DerivedProds !========================================================================= subroutine ResetDerived(period) integer, intent(in) :: period ! Either IOU_DAY or IOU_MON @@ -2014,14 +2093,14 @@ subroutine ResetDerived(period) if(num_deriv2d>0 .and. period<=LENOUT2D) then nav_2d (:,period) = 0 d_2d(:,:,:,period) = 0.0 - endif + end if if(num_deriv3d>0 .and. period<=LENOUT3D) then nav_3d (:,period) = 0 d_3d(:,:,:,:,period) = 0.0 - endif + end if -endsubroutine ResetDerived +end subroutine ResetDerived !========================================================================= subroutine voc_2dcalc() !/-- Sums up voc species using the indices defined earlier in Setup_VOCs @@ -2040,8 +2119,8 @@ subroutine voc_2dcalc() +xn_adv(index,i,j,KMAX_MID) & *voc_carbon(ivoc)*cfac(index,i,j) ! multiplied by nr. of C and "reduced to surface" - enddo ! ivoc -endsubroutine voc_2dcalc + end do ! ivoc +end subroutine voc_2dcalc !========================================================================= subroutine voc_3dcalc() !/-- as for voc_2dcalc @@ -2054,9 +2133,9 @@ subroutine voc_3dcalc() d_3d(n,i,j,k,IOU_INST)=d_3d(n,i,j,k,IOU_INST) & +xn_adv(index,i,j,lev3d(k))& *voc_carbon(ivoc) - enddo ! ivoc + end do ! ivoc - endsubroutine voc_3dcalc + end subroutine voc_3dcalc !========================================================================= subroutine group_calc( g2d, density, unit, ik, igrp,semivol) @@ -2085,7 +2164,7 @@ subroutine group_calc( g2d, density, unit, ik, igrp,semivol) semivol_wanted=.false. if(present(semivol)) semivol_wanted = semivol - + if(DEBUG%DERIVED .and.debug_proc) & write(*,"(a,L1,3i4,2a16,L2)") "DEBUG GROUP-PM-N",debug_proc,me,ik, kk, & trim(chemgroups(igrp)%name), trim(unit), semivol_wanted @@ -2099,17 +2178,17 @@ subroutine group_calc( g2d, density, unit, ik, igrp,semivol) ! write(*,"(a,2i4)") "DEBUG GROUP-FSOA", size(gspec), size(gunit_conv) ! write(*,*) "DEBUG GROUP-FSOA-GSPEC", gspec ! write(*,*) "DEBUG GROUP-FSOA-GUNIT", gunit_conv - endif + end if do j=1,ljmax do i = 1, limax g2d(i,j) = 0.0 do nspec = 1, size(gspec) - iadv = gspec(nspec) + iadv = gspec(nspec) itot = iadv + NSPEC_SHL fac = 1.0 - ! With SOA modelling some compounds are semivolatile and others + ! With SOA modelling some compounds are semivolatile and others ! non-volatile. If in a group XXX which asks for ugPM the latter's ! mass is correct. If semivolatile, we need to calculate the PM ! fraction and just add this. @@ -2131,18 +2210,18 @@ subroutine group_calc( g2d, density, unit, ik, igrp,semivol) trim(species(itot)%name) g2d(i,j) = g2d(i,j) + xn_adv(iadv,i,j,kk) * gunit_conv(nspec) * fac - enddo ! nspec + end do ! nspec if( first_semivol_call .and. semivol_wanted) first_semivol_call = .false. first_call = .false. - enddo ! i - enddo ! j - + end do ! i + end do ! j + if(needroa)& forall(i=1:limax,j=1:ljmax) & g2d(i,j) = g2d(i,j) * density(i,j) deallocate(gspec,gunit_conv) -endsubroutine group_calc +end subroutine group_calc !========================================================================= subroutine somo_calc( n, iX, debug_flag ) !/-- Calculates SOMO (8hours) values for input threshold. @@ -2165,13 +2244,13 @@ subroutine somo_calc( n, iX, debug_flag ) sum8h=0. do nh=1,N8h sum8h = sum8h + D2_O3_DAY( i , j , nh) - enddo + end do o3=sum8h do nh=N8h+1,NTDAY sum8h =sum8h-D2_O3_DAY( i , j , nh-N8h)+D2_O3_DAY( i , j , nh) o3=max(o3,sum8h) if(n<0)write(*,*)o3 !pw fake for compiler!! - enddo + end do !divide by N8h to find 8h mean o3=o3*N8h_inv @@ -2185,21 +2264,34 @@ subroutine somo_calc( n, iX, debug_flag ) ! d_2d values will be accumulated in Derived_ml d_2d(n, i,j,IOU_DAY ) = o3 - enddo - enddo -endsubroutine somo_calc + end do + end do +end subroutine somo_calc !========================================================================= -subroutine write_debugadv(n,index,rho,txt) +subroutine write_debugadv(n,index,rho,txt,Is3D) integer, intent(in) :: n, index real, intent(in) :: rho character(len=*) :: txt + logical, intent(in), optional :: Is3D + logical :: Is3D_local - write(*,"(2a,2i4,2a,4f12.3)") "PROCESS " , trim(txt) , n, index & - ,trim(f_2d(n)%name),trim(f_2d(n)%unit) & - ,d_2d(n,debug_li,debug_lj,IOU_INST)*PPBINV & - ,xn_adv(index,debug_li,debug_lj,KMAX_MID)*PPBINV & - ,rho, cfac(index,debug_li,debug_lj) -endsubroutine write_debugadv + Is3D_local = .false. + if(present(Is3D)) Is3D_local = Is3D + if(Is3D_local)then + k=1; l=lev3d(k) + write(*,"(2a,2i4,2(1x,a),4f12.3)") "PROCESS " , trim(txt) , n, index & + ,trim(f_3d(n)%name),trim(f_3d(n)%unit) & + ,d_3d(n,debug_li,debug_lj,k,IOU_INST)*f_3d(n)%scale & + ,xn_adv(index,debug_li,debug_lj,l)*f_3d(n)%scale & + ,rho, cfac(index,debug_li,debug_lj) + else + write(*,"(2a,2i4,2(1x,a),4f12.3)") "PROCESS " , trim(txt) , n, index & + ,trim(f_2d(n)%name),trim(f_2d(n)%unit) & + ,d_2d(n,debug_li,debug_lj,IOU_INST)*f_2d(n)%scale & + ,xn_adv(index,debug_li,debug_lj,KMAX_MID)*f_2d(n)%scale & + ,rho, cfac(index,debug_li,debug_lj) + end if +end subroutine write_debugadv !========================================================================= subroutine write_debug(n,index,txt) integer, intent(in) :: n, index @@ -2207,6 +2299,6 @@ subroutine write_debug(n,index,txt) write(*,"(2a,2i4,a,4g12.3)") "DERIV: GEN " , txt , n, index & ,trim(f_2d(n)%name),d_2d(n,debug_li,debug_lj,IOU_INST) -endsubroutine write_debug +end subroutine write_debug !========================================================================= -endmodule Derived_ml +end module Derived_ml diff --git a/DryDep_ml.f90 b/DryDep_ml.f90 index a24c7e8..78c13a9 100644 --- a/DryDep_ml.f90 +++ b/DryDep_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -99,8 +99,8 @@ module DryDep_ml Setup_StoFlux, Calc_StoFlux ! subs use SubMet_ml, only: Sub use TimeDate_ml, only: daynumber, current_date -use Wesely_ml ! ... Init_GasCoeff, DRx, Rb_Cor, ... -use ESX_ml, only: Init_ESX, Run_ESX +use GasParticleCoeffs_ml ! ... Init_GasCoeff, DRx, Rb_Cor, ... +!FUTURE use ESX_ml, only: Init_ESX, Run_ESX implicit none private @@ -131,7 +131,7 @@ module DryDep_ml logical, public, parameter :: COMPENSATION_PT = .false. !*************************************************************************** -! Specifies which of the possible species (from Wesely's list) +! Specifies which of the possible species (from DryDepDefs list) ! are required in the current air pollution model !*************************************************************************** ! .... Define the mapping between the advected species and @@ -164,11 +164,11 @@ subroutine init_drydep if ( my_first_call ) then call Init_DepMap() ! Maps CDDEP to IXADV - call Init_GasCoeff() ! Sets Wesely coeffs. + call Init_GasCoeff() ! Sets DryDepDefs coeffs. - if (USES%ESX) then - call Init_ESX() - end if +!FUTURE if (USES%ESX) then +!FUTURE call Init_ESX() +!FUTURE end if nadv = 0 do n = 1, NDRYDEP_ADV @@ -285,13 +285,13 @@ subroutine DryDep(i,j) real :: no3nh4ratio ! Crude NH4/NO3 for Vds ammonium real :: c_hveg, Ra_diff, surf_ppb ! for O3 fluxes and Fst where needed - real :: c_hveg3m, o3_45m !TESTS ONLY - real :: tmpv0, tmpv1, tmpv2 ! testing 1-exp + real :: c_hveg3m, o3_45m ! TESTS ONLY + real :: tmpv0 ! testing 1-exp ! temporary for POD/SPOD logical, parameter :: SPOD_OUT = .false. ! MAKES HUGE FILES. Not for routine use! logical, save :: first_spod = .true. character(len=20), save :: fname - integer :: nglob, itst + integer :: nglob !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Extra outputs sometime used. Important that this !! line is kept at the end of the variable definitions and the start of real @@ -496,7 +496,7 @@ subroutine DryDep(i,j) if ( n > NDRYDEP_GASES ) then ! particles - nae = AERO_SIZE(n) ! See Wesely_ml + nae = AERO_SIZE(n) ! See GasParticleCoeffs_ml if ( LandType(iL)%is_forest ) then @@ -566,7 +566,7 @@ subroutine DryDep(i,j) Vg_3m (n) = 1. / ( L%Ra_3m + Rb(n) + Rsur(n) ) - endif + end if ! Surrogate for NO2 compensation point approach, ! assuming c.p.=4 ppb (ca. 1.0e11 #/cm3): @@ -600,7 +600,7 @@ subroutine DryDep(i,j) Sub(0)%Gsto(n) = Sub(0)%Gsto(n) + L%coverage * Gsto(n) if( dbghh.and.n==2 ) call datewrite("CmpSto", iL, & (/ Sub(iL)%Gsto(n) / Sub(iL)%Gsur(n) /) ) - endif + end if end do !species loop Sumcover = Sumcover + L%coverage @@ -741,7 +741,7 @@ subroutine DryDep(i,j) else DepLoss(nadv) = vg_fac( ncalc ) * xn_2d( ntot,K2) cfac(nadv, i,j) = gradient_fac( ncalc ) - endif + end if end if if ( DepLoss(nadv) < 0.0 .or. DepLoss(nadv)>xn_2d(ntot,K2) ) then @@ -870,8 +870,8 @@ subroutine DryDep(i,j) do n = 1, NDRYDEP_ADV nadv = DDepMap(n)%ind totddep( nadv ) = totddep (nadv) + DepLoss(nadv)*convfac - enddo - endif + end do + end if convfac2 = convfac * xm2(i,j) * inv_gridarea @@ -881,9 +881,9 @@ subroutine DryDep(i,j) DepAdv2Calc, fluxfrac_adv, Deploss ) - if (USES%ESX) then - call Run_ESX() - end if +!FUTURE if (USES%ESX) then +!FUTURE call Run_ESX() +!FUTURE end if !---------------------------------------------------------------- diff --git a/DustProd_ml.f90 b/DustProd_ml.f90 index 6448850..845ac4c 100644 --- a/DustProd_ml.f90 +++ b/DustProd_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -84,8 +84,8 @@ module DustProd_ml public :: WindDust - real, private, save :: kg2molecDU, m_to_nDU, frac_fine, frac_coar, & - soil_dns_dry, help_ustar_th + real, private, save :: kg2molecDU, frac_fine, frac_coar, & + help_ustar_th real, parameter :: soil_dens = 2650.0 ! [kg/m3] logical, private, save :: my_first_call = .true. logical, private, save :: dust_found @@ -112,24 +112,17 @@ subroutine WindDust (i,j,debug_flag) integer, intent(in) :: i,j ! coordinates of column logical, intent(in) :: debug_flag - integer, parameter :: Ndust = 2, & ! number of size classes - DU_F = 1, DU_C = 2 integer, parameter :: LU_DESERT = 13 ! REMOVE HARD-CODE real , parameter :: Ro_water = 1000.0 - real, parameter, dimension(Ndust) :: & - dsoil = (/ 1.5, 6.7/) & ! diameter of dust particles [mkm] - ,mfrac = (/0.05, 0.45/) ! mass fraction of the total mass - real, parameter:: D_opt = 75.e-6, & ! [m] - Dm_soil = 210.0e-6, & ! [m] MMD of the coarsest soil (100) - Z0s = Dm_soil/30.0 , & ! [m] Smooth roughness length MaB95 p.16426, + real, parameter:: Dm_soil = 210.0e-6, & ! [m] MMD of the coarsest soil (100) + Z0s = Dm_soil/30.0 ! [m] Smooth roughness length MaB95 p.16426, ! MaB97 p.4392, GMB98 p.6207 - !z0 = 0.5e-3, & !(for desert..) 1.e-4 saltation roughness length - z10 = 10.0 ! Z=10m + real :: Mflux = 0.0 real :: cover, z0, vh2o_sat, gr_h2o, v_h2o, ustar_moist_cor & - , gwc_thr, dust_lim, soil_dns_dry, ustar_z0_cor, u10 & - , u10g_2, u10_gust, alfa, ustar_th, uratio, ustar, clay & + , gwc_thr, dust_lim, soil_dns_dry, ustar_z0_cor & + , alfa, ustar_th, uratio, ustar, clay & , frac_fin, frac_coa, flx_hrz_slt, flx_vrt_dst logical :: arable, dust_prod = .false., debug @@ -231,7 +224,7 @@ subroutine WindDust (i,j,debug_flag) if (daynumber < LandCover(i,j)%SGS(ilu) .or. & daynumber > LandCover(i,j)%EGS(ilu) ) & arable = .true. - endif + end if !/.. Dust erosion from Crops (Arable) and Desert (Mediterr.Scrubs lu==11 ???) !/.. Creates problems on e.g. Greenland, as Bare land is included in Desert @@ -284,7 +277,7 @@ subroutine WindDust (i,j,debug_flag) else !use a threshold consistent with the one IFS uses gwc_thr=pwp(i,j) - endif + end if if (foundSoilWater) then ! Soil Moisture in met data @@ -329,7 +322,7 @@ subroutine WindDust (i,j,debug_flag) !__ Put also gwc_thr (=pwp) in same unit if(SoilWaterSource == "IFS")then gwc_thr=gwc_thr* Ro_water/soil_dns_dry - endif + end if ! Soil water correction if (gr_h2o > gwc_thr) & @@ -342,7 +335,7 @@ subroutine WindDust (i,j,debug_flag) write(6,'(a,3f15.5)') 'DUST: SW/VolW/GrW/ ',SoilWater(i,j,1),v_h2o,gr_h2o write(6,'(a,3f15.5)') 'DUST: SW COMPS ',SoilWater(i,j,1), fc(i,j), pwp(i,j) write(6,'(a,2f10.4)') 'DUST >> U*_moist_corr >>',gwc_thr, ustar_moist_cor - endif + end if else !.. No SoilWater in met.input; Moisture correction for U*t will be 1. @@ -353,9 +346,9 @@ subroutine WindDust (i,j,debug_flag) if( debug ) then write(6,'(a,f8.2,2f12.4)') 'DUST ++ No SoilWater in meteorology++' write(6,'(a,f10.4)') 'DUST: >> U*_moist_corr >>', ustar_moist_cor - endif + end if - endif + end if ! =================================== @@ -374,7 +367,7 @@ subroutine WindDust (i,j,debug_flag) dust_lim = 0.05 alfa = 1.3e-5 ! alfa = 1.5e-5 ! As for TFMM spring 2005 - endif + end if !// limit emissions in the Spanish desert grid (covered with greenhouses??) ! if ( (i_glob(i) == 102.0 .and. j_glob(j) == 18.0) ) & @@ -388,7 +381,7 @@ subroutine WindDust (i,j,debug_flag) z0 = max (0.1 * LandCover(i,j)%hveg(ilu), 0.001) dust_lim = 0.02 alfa = 1.0e-5 !1.e-5 - endif + end if ! else ! --------- temp/root crops ------ ! z0 = max (0.1 * landuse_hveg(i,j,ilu), 0.001) @@ -440,7 +433,7 @@ subroutine WindDust (i,j,debug_flag) ! u10_gust = sqrt(u10*u10 + 1.44 *Grid%wstar*Grid%wstar) ! else ! u10_gust = u10 -! endif +! end if ! ! ustar = KARMAN/log(10.0/z0) * & ! sqrt(u10_gust*u10_gust + 1.44 *Grid%wstar*Grid%wstar) @@ -455,7 +448,7 @@ subroutine WindDust (i,j,debug_flag) write(6,'(3es12.3)') ustar_th, ustar_moist_cor, ustar_z0_cor write(6,'(a35,f8.3,3(a10,f6.3))') 'FINALLY U*_th= ',ustar_th,' U*=',ustar, & ' U*NWP=',Grid%ustar,' U*sub=',Sub(lu)%ustar - endif + end if ! >>>>> Check for saltation to occur [Whi79 p.4648(19), MaB97 p.16422(28)] @@ -502,14 +495,14 @@ subroutine WindDust (i,j,debug_flag) ustar,ustar_th, dust_lim, alfa write(6,'(a15,f10.3,2es12.3)') 'FLUXES:',uratio, flx_hrz_slt*1000.0, & flx_hrz_slt*dust_lim*alfa *1000.0 - endif + end if !TEST to limit the dust production ! if (lu == LU_DESERT) then ! flx_hrz_slt = min(10.e-3, flx_hrz_slt* dust_lim ) ! else ! flx_hrz_slt = min(2.e-3, flx_hrz_slt* dust_lim ) -! endif +! end if ! flx_vrt_dst = flx_vrt_dst + flx_hrz_slt * alfa * cover !// Vertical dust flux [kg/m2/s], scaled with area fraction and @@ -519,7 +512,7 @@ subroutine WindDust (i,j,debug_flag) flx_vrt_dst = flx_vrt_dst + min(1.e-7, flx_hrz_slt * alfa * dust_lim) else flx_vrt_dst = flx_vrt_dst + min(1.e-8, flx_hrz_slt * alfa * dust_lim) - endif + end if flx_vrt_dst = flx_vrt_dst * cover @@ -530,23 +523,23 @@ subroutine WindDust (i,j,debug_flag) write(6,'(a35,es12.3/)') ' Vertical Flux => ', Mflux write(6,'(a35,es12.3,i4,f8.3)') 'DUST Flux => ', flx_vrt_dst, lu, cover write(6,'(a15,f10.3,2es12.3)') 'FLUXES:',uratio, flx_hrz_slt*1000., flx_vrt_dst*1000. - endif + end if - endif ! U* > U*_threshold + end if ! U* > U*_threshold - endif DUST + end if DUST - enddo LUC ! landuse + end do LUC ! landuse - endif FROST - endif DRY + end if FROST + end if DRY else ! PREC dry_period(i,j) = 0 if( debug ) write(6,'(a30,i5,es12.3)') & '>> RAIN-RAIN >>', dry_period(i,j),surface_precip(i,j) - endif NO_PRECIP + end if NO_PRECIP !//__ N production [ 1/m2/s]: d3(mkm->m) * 1e-18 !TEST Nflux(n) = Mflux(n) *m_to_nDU / dsoil(n)**3 *1.e18 @@ -578,7 +571,7 @@ subroutine WindDust (i,j,debug_flag) '<< DUST OUT>>', EmisNat( inat_DUf,i,j), EmisNat( inat_DUc,i,j), & ' > TOTAL >', sum( EmisNat( dust_indices, i,j )),frac_fin, frac_coa - endif ! dust_prod + end if ! dust_prod if( debug ) write(6,*) '<< No DUST production TOTAL >>', sum( EmisNat( dust_indices, i,j )) @@ -632,7 +625,7 @@ subroutine init_dust if (DEBUG_DUST .and. MasterProc) then write(6,*) write(6,*) ' >> DUST init <<',soil_dens, inat_DUf, inat_DUc , itot_DUf, itot_DUc - endif + end if allocate(dry_period(LIMAX, LJMAX)) @@ -664,7 +657,7 @@ subroutine init_dust ! MaB95 p. 16417 (7) help_ust = 0.12*0.12 * help_ust*help_ust ! [frc] SQUARED - endif ! Re_opt < 0.03 + end if ! Re_opt < 0.03 !//__ This method minimizes the number of square root computations performed @@ -686,7 +679,7 @@ subroutine init_dust write(6,*) write(6,*) 'DUST: >> fractions <<', Nsoil, Ndust write(6,'(a,3e12.4)') 'DUST: Sigma =', (sig_soil(i),i=1,Nsoil) - endif + end if sum_soil(:) = 0.0 tot_soil = 0.0 @@ -708,8 +701,8 @@ subroutine init_dust sum_soil(idu) = sum_soil(idu) + help_diff(isoil,idu) tot_soil = tot_soil + help_diff(isoil,idu) - enddo - enddo + end do + end do frac_fine = sum_soil(1) + sum_soil(2) + sum_soil(3) frac_coar = sum_soil(4) @@ -719,9 +712,9 @@ subroutine init_dust write (6,'(a25,2f8.4,3(f8.3),2f12.3)') 'DUST: frac in bins:', & d1(idu), d2(idu), (help_diff(isoil,idu), isoil=1,3), & sum_soil(idu),sum_soil(idu)/tot_soil - enddo + end do write (6,'(a,2f8.4)') 'DUST: ** FINE / COARSE **',frac_fine, frac_coar - endif + end if end subroutine init_dust ! >=================================================================< @@ -752,7 +745,7 @@ subroutine get_dustfrac(frac_fine, frac_coarse, ustar) else frac_fine = 0.35 frac_coarse = 0.11 - endif + end if end subroutine get_dustfrac diff --git a/EQSAM_ml.f90 b/EQSAM_ml.f90 index 9a9c12b..c962f99 100644 --- a/EQSAM_ml.f90 +++ b/EQSAM_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -237,25 +237,25 @@ subroutine eqsam_v03d (SO4in, HNO3in,NO3in,NH3in,NH4in,NAin,CLin, relh,temp,pa, if((TNa + TNH4 + TPo +2.*(TCa + TMg)) .le. (2.*TSO4)) then zflag=3. - endif + end if ! SULFATE VERY RICH CASE if (NH4+Na+K+2(Ca+Mg))/SO4 < 1 if((TNa + TNH4 + TPo +2.*(TCa + TMg)) .le. TSO4) then zflag=4. - endif + end if ! SULFATE NEUTRAL CASE if((TNa + TNH4 + TPo +2.*(TCa + TMg)) .gt. (2.*TSO4)) then zflag=2. - endif + end if ! SULFATE POOR AND CATION POOR CASE if((TNa + TPo +2.*(TCa + TMg)) .gt. (2.*TSO4)) then zflag=1. - endif + end if IF ( RH .LT. RHMIN ) RH=RHMIN IF ( RH .GT. RHMAX ) RH=RHMAX @@ -289,7 +289,7 @@ subroutine eqsam_v03d (SO4in, HNO3in,NO3in,NH3in,NH4in,NAin,CLin, relh,temp,pa, w2(:)=1. do ii=1,8 if(w1(ii).le.1.e-12) w2(ii)=0. ! skip compound in RHD calculation if - enddo ! concentration is zero or rather small + end do ! concentration is zero or rather small ! GET LOWEST RHD ACCORDING TO THE CONCENTRATION DOMAIN @@ -632,7 +632,7 @@ subroutine eqsam_v03d (SO4in, HNO3in,NO3in,NH3in,NH4in,NAin,CLin, relh,temp,pa, ! KAN = rks5/(r*temp)**2 ! Keq of NH3(g)+HNO3(g)---> NH4NO3 (s) ! [mol^2/kg]/(R[m^3*atm/deg/mole]*T[K])**2 = [m^3*atm/kg] - endif + end if ! ! store aerosol species for diagnostic output: !______________________________________________________________ @@ -653,7 +653,7 @@ subroutine eqsam_v03d (SO4in, HNO3in,NO3in,NH3in,NH4in,NAin,CLin, relh,temp,pa, !//.. aerosol water aH2Oout(k) = WH2O ! aerosol Water (aq) [ug/m^3] - enddo + end do ! end subroutine eqsam_v03d diff --git a/EcoSystem_ml.f90 b/EcoSystem_ml.f90 index 649a67c..74530c0 100644 --- a/EcoSystem_ml.f90 +++ b/EcoSystem_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -82,7 +82,7 @@ subroutine Init_EcoSystems() if(iEco==FULL_ECOGRID) then name = "Area_"//trim(DEF_ECOSYSTEMS(iEco))//"_km2" unit = "km2" - endif + end if ! Deriv(name, class, subc, txt, unit ! Deriv index, f2d, dt_scale, scale, avg? Inst Yr Mn Day @@ -92,7 +92,7 @@ subroutine Init_EcoSystems() if(DEBUG .and. MasterProc) & call print_deriv_type( DepEcoSystem(iEco) ) - enddo + end do ! Define which landcovers belong to which ecosystem Is_EcoSystem(FULL_ECOGRID,:) = .true. @@ -104,6 +104,6 @@ subroutine Init_EcoSystems() EcoSystemFrac(:,:,:) = 0.0 -endsubroutine Init_EcoSystems +end subroutine Init_EcoSystems endmodule EcoSystem_ml diff --git a/EmisDef_ml.f90 b/EmisDef_ml.f90 index 8c0cda8..b3ea7ae 100644 --- a/EmisDef_ml.f90 +++ b/EmisDef_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -100,6 +100,7 @@ module EmisDef_ml SNAP_sec2hfac_map = (/1,2,3,4,5,6,7,8,9,10,11/) !values must be <= N_HFAC integer, save, target, dimension(NSECTORS_SNAP) :: & ! mapping of sector to height distribution class SNAP_sec2split_map = (/1,2,3,4,5,6,7,8,9,10,11/) !values must be <= N_SPECIATION + integer, save, dimension(NSECTORS_SNAP) ::snap2gnfr=(/1,3,2,4,13,5,6,7,10,11,-1/) !GNFR specific definitions integer, public, parameter :: & @@ -111,6 +112,8 @@ module EmisDef_ml integer, save, target, dimension(NSECTORS_GNFR) :: & ! mapping of sector to height distribution class GNFR_sec2split_map = (/1,3,2,4,6,7,8,8,8,9,10,10,5/) !values must be <= N_SPECIATION + integer, save, dimension(NSECTORS_GNFR) ::gnfr2snap=(/1,3,2,4,6,7,8,-1,-1,9,10,-1,5/) + !TEST specific definitions integer, public, parameter :: & NSECTORS_TEST = 11 ! Number of sectors defined in SNAP emissions. Do not modify @@ -158,8 +161,6 @@ module EmisDef_ml ! and disregard them ! from gridSOx - integer, public, parameter :: IQ_DMS = 35 ! code for DMS emissions - ! real, public, save, allocatable,dimension(:,:) :: sumcdfemis ! Only used fby MasterProc real, allocatable, public, save, dimension(:,:) :: cdfemis @@ -188,8 +189,40 @@ module EmisDef_ml gridrcroadd, & ! Road dust emissions gridrcroadd0 ! varies every hour +! +! The output emission matrix for the 11-SNAP data is snapemis: +! +real, public, allocatable, dimension(:,:,:,:,:), save :: & + snapemis ! main emission arrays, in kg/m2/s + real, public, allocatable, dimension(:,:,:,:), save :: & - loc_frac ! Fraction of pollutants that are produced locally in the gridcell + snapemis_flat ! main emission arrays, in kg/m2/s + +real, public, allocatable, dimension(:,:,:,:), save :: & +! Not sure if it is really necessary to keep the country info; gives rather messy code but consistent with the rest at least (and can do the seasonal scaling for Nordic countries in the code instead of as preprocessing) + roaddust_emis_pot ! main road dust emission potential arrays, in kg/m2/s (to be scaled!) + +! We store the emissions for output to d_2d files and netcdf in kg/m2/s +real, public, allocatable, dimension(:,:,:), save :: SumSnapEmis,SumSplitEmis +real, public, allocatable, dimension(:,:,:,:), save :: SumSecEmis + +!should be defined somewhere else? +real, public, allocatable, dimension(:,:,:,:,:,:), save :: & + loc_frac& ! Fraction of pollutants that are produced locally + ,loc_frac_hour_inst& !Houry local fractions + ,loc_frac_hour& !Houry average of local fractions + ,loc_frac_day& !Daily average of local fractions + ,loc_frac_month& !Monthly average of local fractions + ,loc_frac_full !Fullrun average of local fractions +real, public, allocatable, dimension(:,:,:,:), save :: & + loc_tot_hour_inst& !all contributions + ,loc_tot_hour& !Hourly average of all contributions + ,loc_tot_day& !Daily average of all contributions + ,loc_tot_month& !Monthly average of all contributions + ,loc_tot_full !Fullrun average of all contributions +real, public, allocatable, dimension(:,:,:,:), save :: & + loc_frac_1d ! Fraction of pollutants without i or j and extended (0:limax+1 or 0:ljmax+1) +integer, public, parameter:: Nneighbors = 9 !localfractions from 8 neighbors + self !Ocean variables type, public :: Ocean @@ -202,7 +235,17 @@ module EmisDef_ml type(Ocean), public, save:: O_NH3, O_DMS -real, public, save :: DMS_natso2_month=0.0, DMS_natso2_year=0.0 +!Special_ShipEmis +real, public, allocatable, dimension(:,:), save :: & + AISco, AISnox, AISsox, AISso4, AISash, AISec , AISoc + +!NB: the species indices (NO2, SO2...) may not be defined in some configurations: +! this will make the model compilation crash *also* when no ship emis are used. +integer, public, save ::NO_ix,NO2_ix,SO2_ix,SO4_ix,CO_ix,REMPPM25_ix& + ,EC_F_FFUEL_NEW_ix,EC_F_FFUEL_AGE_ix,POM_F_FFUEL_ix + +logical, public, save :: FOUND_Special_ShipEmis = .false. + !used for EEMEP real, allocatable, save, dimension(:,:,:,:) :: Emis_4D !(i,j,k,pollutant) integer, save ::N_Emis_4D=0 !number of pollutants to read @@ -235,6 +278,9 @@ module EmisDef_ml integer, public :: N_femis_lonlat !number of femis lonlat lines defined + integer, public, save :: NSecEmisOut = 0 + logical, public, save :: SecEmisOut(NEMIS_FILE) = .false. + ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ! MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD end module EmisDef_ml diff --git a/EmisGet_ml.f90 b/EmisGet_ml.f90 index 6035da7..61506ae 100644 --- a/EmisGet_ml.f90 +++ b/EmisGet_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -132,11 +132,9 @@ subroutine EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & real :: fractions(LIMAX,LJMAX,NCMAX),Reduc(NLAND) - character(len=125) ::Mask_fileName,Mask_varname - real :: Mask_ReducFactor,lonlat_fac - integer :: NMask_Code,Mask_Code(NLAND) + real :: lonlat_fac - integer ::i,j,k,n,ic,i_gridemis,found + integer ::i,j,n,ic,i_gridemis,found logical :: Cexist !yearly grid independent netcdf fraction format emissions @@ -152,7 +150,7 @@ subroutine EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & write(*,*)"GetCdfFrac: Too many emitter countries in one gridcell: ",& me,i,j,nlandcode(i,j) call StopAll("To many countries in one gridcell ") - endif + end if lonlat_fac=1.0 if(N_femis_lonlat>0)then do i_femis_lonlat=1,N_femis_lonlat @@ -161,9 +159,9 @@ subroutine EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & glon(i,j)>femis_lonmin(i_femis_lonlat).and.& glon(i,j)0)then !1) check that country is not in exclude list found=find_index(Country(ic)%code ,excl(1:nex),first_only=.true.) if(found>0)cycle!exclude - endif + end if if(Country(ic)%icode/=landcode(i,j,n))then write(*,*)"COUNTRY CODE ERROR: ",landcode(i,j,n),ic,Country(ic)%icode call StopAll("COUNTRY CODE ERROR ") - endif + end if if(ic>NLAND)then write(*,*)"COUNTRY CODE NOT RECOGNIZED OR UNDEFINED: ",landcode(i,j,n) call StopAll("COUNTRY CODE NOT RECOGNIZED ") - endif + end if !merge into existing emissions Cexist=.false. @@ -199,8 +197,8 @@ subroutine EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & Cexist=.true. exit - endif - enddo + end if + end do if(.not.Cexist)then !country not included yet. define it now: nGridEmisCodes(i,j)=nGridEmisCodes(i,j)+1 @@ -208,16 +206,16 @@ subroutine EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & write(*,*)"Too many emitter countries in one gridemiscell: ",& me,i,j,nGridEmisCodes(i,j) call StopAll("To many countries in one gridemiscell ") - endif + end if i_gridemis=nGridEmisCodes(i,j) GridEmisCodes(i,j,i_gridemis)=landcode(i,j,n) GridEmis(isec,i,j,i_gridemis,iem)=fractions(i,j,n)*cdfemis(i,j)*lonlat_fac - endif + end if sumemis_local(ic,iem)=sumemis_local(ic,iem)& +0.001*fractions(i,j,n)*cdfemis(i,j)*lonlat_fac !for diagnostics, mass balance - enddo - enddo - enddo + end do + end do + end do end subroutine EmisGetCdfFrac ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -227,11 +225,9 @@ subroutine EmisGetCdf(iem, fname, sumemis, incl,excl) real, intent(inout) ::sumemis(*) character(len=*),dimension(:), optional :: & incl, excl ! Arrays of cc to inc/exclude - integer :: i,j, ic, isec, allocerr(6), icode, status - real, dimension(NLAND) :: sumcdfemis_loc, sumcdfemis_iem - integer :: icc, ncc + integer :: i,j, ic, isec, allocerr(6), status + real, dimension(NLAND) :: sumcdfemis_loc character(len=40) :: varname, fmt - integer, save :: ncmaxfound = 0 ! Max no. countries found in grid integer, save :: ncalls=0 integer :: ncFileID, nDimensions,nVariables,nAttributes,timeDimID,varid,& xtype,ndims !TESTE testing @@ -369,9 +365,9 @@ subroutine EmisGetCdf(iem, fname, sumemis, incl,excl) glon(i,j)>femis_lonmin(i_femis_lonlat).and.& glon(i,j)0)then !1) check that country is not in exclude list found=find_index(Country(ic)%code ,excl(1:nex),first_only=.true.) if(found>0)cycle READEMIS!exclude - endif + end if lonlat_fac=1.0 if(N_femis_lonlat>0)then @@ -508,9 +504,9 @@ subroutine EmisGetASCII(iem, fname, emisname, sumemis_local, incl, nin, excl, ne glon(i,j)>femis_lonmin(i_femis_lonlat).and.& glon(i,j)MAXFEMISLONLAT, "EmisGet: increase MAXFEMISLONLAT" ) @@ -717,7 +713,7 @@ subroutine femis() ! find country number corresponding to index as written in emisfile do iland1=1,NLAND if(Country(iland1)%icode==inland) goto 544 - enddo + end do if(MasterProc) write(*,*)'COUNTRY CODE NOT RECOGNIZED',inland @@ -726,7 +722,7 @@ subroutine femis() 544 continue if(iland1/=0) iland2 = iland1 end if - endif + end if if (isec == 0 ) then ! All sectors isec1 = 1 @@ -757,10 +753,10 @@ subroutine femis() qc(ie), e_f( qc(ie) ) write(unit=6,fmt=*) "loops over ", isec1, isec2, iland1, iland2 end if ! DEBUG_GETEMIS - endif + end if end do !ie - enddo READFILE ! Loop over femis + end do READFILE ! Loop over femis close(IO_EMIS) @@ -790,7 +786,6 @@ subroutine EmisHeights() integer :: k_up real,allocatable:: emis_P_level(:) real :: P_emep,frac,sum - real, parameter:: PT_EMEP=10000.0!Pa = 100 hPa integer :: isec,k_ext,k1_ext(KMAX_BND),nemis_hprofile !emis_hprofile are read from file. @@ -835,7 +830,7 @@ subroutine EmisHeights() if(snap > N_HFAC)then if(me==0)write(*,*)N_HFAC,' sector classes defined, but found ',snap call CheckStop(snap > N_HFAC,"EmisGet: sector class out of bounds") - endif + end if if( DEBUG_GETEMIS.and.MasterProc ) write(*,*) "VER=> ",snap, tmp(1), tmp(3) emis_hprofile(1:nemis_hprofile,snap) = tmp(1:nemis_hprofile) end if @@ -871,7 +866,7 @@ subroutine EmisHeights() do k=KMAX_BND-1,KMAX_BND-nemis_hprofile,-1 k_up=k_up+1 emis_P_level(KMAX_BND-k)=A_bnd(k)+B_bnd(k)*Pref !not used - enddo + end do nemis_kprofile=nemis_hprofile allocate(emis_kprofile(nemis_kprofile,N_HFAC),stat=allocerr) emis_kprofile(1:nemis_kprofile,:)=emis_hprofile(1:nemis_hprofile,:) @@ -882,15 +877,15 @@ subroutine EmisHeights() write(*,*)'emission heights: defined from pressure levels' do k=0,nemis_hprofile write(*,*)'P emis levels : ',k,emis_P_level(k) - enddo - endif + end do + end if !stop !find highest level used nemis_kprofile = 0 do k=KMAX_BND-1,1,-1 nemis_kprofile = nemis_kprofile + 1 if(A_bnd(k)+B_bnd(k)*Pref-0.0001P_emep)then !part below k1_ext(k+1)+1 above P_emep(k+1) - frac=((A_bnd(k+1)+B_bnd(k+1)*Pref )-emis_P_level(k1_ext(k+1)+1))/(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) + frac=((A_bnd(k+1)+B_bnd(k+1)*Pref )-emis_P_level(k1_ext(k+1)+1))& + /(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) emis_kprofile(KMAX_BND-k,isec)=frac*emis_hprofile(k1_ext(k+1)+1,isec) - if(DEBUG_GETEMIS.and.MasterProc) write(*,fmt="(A,I5,6F10.2)")'adding fraction of level',& - k1_ext(k+1)+1,frac,emis_hprofile(k1_ext(k+1)+1,isec),emis_P_level(k1_ext(k+1)+1),& - (A_bnd(k+1)+B_bnd(k+1)*Pref ),emis_P_level(k1_ext(k+1)+1),(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) + if(DEBUG_GETEMIS.and.MasterProc) & + write(*,fmt="(A,I5,6F10.2)")'adding fraction of level',& + k1_ext(k+1)+1,frac,emis_hprofile(k1_ext(k+1)+1,isec),& + emis_P_level(k1_ext(k+1)+1),(A_bnd(k+1)+B_bnd(k+1)*Pref),& + emis_P_level(k1_ext(k+1)+1),(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) else !everything between P_emep(k+1) and P_emep(k) frac=((A_bnd(k+1)+B_bnd(k+1)*Pref )-P_emep)/(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) emis_kprofile(KMAX_BND-k,isec)=frac*emis_hprofile(k1_ext(k+1)+1,isec) - if(DEBUG_GETEMIS.and.MasterProc) write(*,fmt="(A,I5,6F10.2)")'adding fraction of level between P_emep(k+1) and P_emep(k)',& + if(DEBUG_GETEMIS.and.MasterProc) & + write(*,"(A,I5,6F10.2)")'adding fraction of level between P_emep(k+1) and P_emep(k)',& k1_ext(k+1)+1,frac,emis_hprofile(k1_ext(k+1)+1,isec),emis_P_level(k1_ext(k+1)+1),& (A_bnd(k+1)+B_bnd(k+1)*Pref ),P_emep,(emis_P_level(k1_ext(k+1))-emis_P_level(k1_ext(k+1)+1)) - endif + end if !add all full levels in between do k_ext=k1_ext(k+1)+2,k1_ext(k) emis_kprofile(KMAX_BND-k,isec)=emis_kprofile(KMAX_BND-k,isec)+emis_hprofile(k_ext,isec) - if(DEBUG_GETEMIS.and.MasterProc) write(*,fmt="(A,I5,6F10.2)")'adding entire level',k_ext,emis_hprofile(k_ext,isec),emis_P_level(k_ext) - enddo + if(DEBUG_GETEMIS.and.MasterProc) & + write(*,"(A,I5,6F10.2)")'adding entire level',& + k_ext,emis_hprofile(k_ext,isec),emis_P_level(k_ext) + end do !add level just below P_emep(k), if not already counted, above k1_ext(k) below P_emep; and must exist if(emis_P_level(k1_ext(k+1)+1)>P_emep.and. k1_ext(k)0.01)then if(MasterProc)then write(*,*)'WARNING emis height distribution not normalized : ',sum,(emis_kprofile(k,isec),k=1,nemis_kprofile) call StopAll( 'emis height distribution not normalized ') - endif - endif - enddo + end if + end if + end do end subroutine EmisHeights !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @@ -1006,9 +1007,6 @@ subroutine EmisSplit() integer :: itot ! Index in IX_ arrays integer :: iqrc ! index of split compound in emisfrac - integer, parameter :: NONREACTIVE = 1 ! No. columns of non-reactive species - ! enforced for read-ins. - !-- for read-ins, dimension for max possible number of columns: !-- for CRI we have 100s of VOC, hence character(len=10000) :: txtinput @@ -1062,7 +1060,7 @@ subroutine EmisSplit() write(*,fmt=*) "emis_split: no specials for:",EMIS_FILE(ie) exit IDEF_LOOP - endif + end if end if @@ -1167,7 +1165,7 @@ subroutine EmisSplit() trim(EMIS_FILE(ie))//':'//trim(txtinput) ) cycle READ_DATA end if - endif + end if n = n + 1 if (debugm ) then @@ -1229,11 +1227,11 @@ subroutine EmisSplit() "DEBUG_EMISGET splitdef UK", isec, ie, i, & iqrc, itot, trim(species(itot)%name), & tmp_emisfrac(iqrc,isec,iland) - endif - enddo ! i - enddo ! iland + end if + end do ! i + end do ! iland - enddo READ_DATA + end do READ_DATA close(IO_EMIS) call CheckStop( defaults .and. n /= N_SPLIT, & @@ -1283,11 +1281,13 @@ subroutine EmisSplit() allocate(roaddust_masscorr(NROADDUST),stat=allocerr) call CheckStop(allocerr, "Allocation error for emis_masscorr") if(MasterProc) & - write(*,fmt=*)"NOTE! WARNING! Molar mass assumed to be 200.0 for all road dust components. Emissions will be in ERROR if another value is set in the GenChem input!" + write(*,'(A)') "WARNING! Molar mass assumed to be 200.0& + & for all road dust components. Emissions will be WRONG& + & if another value is set in the GenChem input!" do ie=1,NROADDUST roaddust_masscorr(ie)=1.0/200. - enddo - endif + end do + end if end subroutine EmisSplit !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -1327,10 +1327,10 @@ subroutine RoadDustGet(iemis,emisname,IRUNBEG,JRUNBEG,GIMAX,GJMAX, & real, intent(inout), dimension(:,:) :: sumroaddust ! Emission potential sums per country !--local - integer :: i, j, isec, iland, & ! loop variables - iic,ic ! country code (read from file) - real :: tmpdust ! for reading road dust emission potential file - integer, save :: ncmaxfound = 0 ! Max no. countries found in grid + integer :: i, j, iland, & ! loop variables + iic,ic ! country code (read from file) + real :: tmpdust ! for reading road dust emission potential file + integer, save :: ncmaxfound = 0 ! Max no. countries found in grid character(len=300) :: inputline !>============================ @@ -1340,7 +1340,7 @@ subroutine RoadDustGet(iemis,emisname,IRUNBEG,JRUNBEG,GIMAX,GJMAX, & sumroaddust(:,:) = 0.0 ! initialize sums ios = 0 my_first_road = .false. - endif + end if !>============================ @@ -1359,7 +1359,7 @@ subroutine RoadDustGet(iemis,emisname,IRUNBEG,JRUNBEG,GIMAX,GJMAX, & write(*,*)'First line should be a comment line, starting with #' else write(*,*)'I read the comment line:',inputline - endif + end if READEMIS: do ! ************* Loop over emislist files ******************* @@ -1378,7 +1378,7 @@ subroutine RoadDustGet(iemis,emisname,IRUNBEG,JRUNBEG,GIMAX,GJMAX, & do ic=1,NLAND if((Country(ic)%icode==iic))& goto 654 - enddo + end do write(unit=errmsg,fmt=*) & "COUNTRY CODE NOT RECOGNIZED OR UNDEFINED ", iic call CheckStop(errmsg) diff --git a/Emissions_ml.f90 b/Emissions_ml.f90 index 6425211..c63bfe3 100644 --- a/Emissions_ml.f90 +++ b/Emissions_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -46,7 +46,6 @@ module Emissions_ml ,ISNAP_TRAF & ! snap index for road-traffic (SNAP7) ,ISEC_NAT & ! index for natural (and flat?) emissions ,ISEC_SHIP & ! index for flat emissions, e.g ship - ,IQ_DMS & ! code for DMS emissions ,NROAD_FILES & ! No. road dust emis potential files ,ROAD_FILE & ! Names of road dust emission files ,NROADDUST & ! No. road dust components @@ -55,18 +54,25 @@ module Emissions_ml ,ROADDUST_FINE_FRAC & ! fine (PM2.5) fraction of road dust emis ,ROADDUST_CLIMATE_FILE &! TEMPORARY! file for road dust climate factors ,nGridEmisCodes,GridEmisCodes,GridEmis,cdfemis& + ,snapemis,snapemis_flat,roaddust_emis_pot,SumSplitEmis,SumSnapEmis& + ,SumSecEmis,SecEmisOut,NSecEmisOut& ,nlandcode,landcode,flat_nlandcode,flat_landcode& ,road_nlandcode,road_landcode& ,gridrcemis,gridrcemis0,gridrcroadd,gridrcroadd0& - ,DMS_natso2_month, DMS_natso2_year,O_NH3, O_DMS& + ,O_NH3, O_DMS& ,Emis_4D,N_Emis_4D,Found_Emis_4D & !used for EEMEP ,KEMISTOP& ,MAXFEMISLONLAT,N_femis_lonlat,loc_frac & ,NSECTORS, N_HFAC, N_TFAC, N_SPLIT & ! No. emis sectors, height, time and split classes ,sec2tfac_map, sec2hfac_map, sec2split_map& !generic mapping of indices + ,Nneighbors & !used for uemep/loc_frac ,NSECTORS_SNAP, SNAP_sec2tfac_map, SNAP_sec2hfac_map, SNAP_sec2split_map&!SNAP specific mapping ,NSECTORS_GNFR, GNFR_sec2tfac_map, GNFR_sec2hfac_map, GNFR_sec2split_map&!GNFR specific mapping - ,NSECTORS_TEST, TEST_sec2tfac_map, TEST_sec2hfac_map, TEST_sec2split_map!TEST specific mapping + ,NSECTORS_TEST, TEST_sec2tfac_map, TEST_sec2hfac_map, TEST_sec2split_map&!TEST specific mapping + ,gnfr2snap,snap2gnfr& + ,AISco, AISnox, AISsox, AISso4, AISash, AISec , AISoc, FOUND_Special_ShipEmis& + ,NO_ix,NO2_ix,SO2_ix,SO4_ix,CO_ix,REMPPM25_ix& + ,EC_F_FFUEL_NEW_ix,EC_F_FFUEL_AGE_ix,POM_F_FFUEL_ix use EmisGet_ml, only: & EmisSplit & @@ -88,7 +94,7 @@ module Emissions_ml use GridValues_ml, only: GRIDWIDTH_M & ! size of grid (m) ,xm2 & ! map factor squared ,debug_proc,debug_li,debug_lj & - ,xmd,dA,dB,i_fdom,j_fdom,glon,glon,glat + ,xmd,dA,dB,i_fdom,j_fdom,glon,glat use Io_Nums_ml, only: IO_LOG, IO_DMS, IO_EMIS, IO_TMP use Io_Progs_ml, only: ios, open_file, datewrite, PrintLog use MetFields_ml, only: u_xmj, v_xmi, roa, ps, z_bnd, surface_precip,EtaKz ! ps in Pa, roa in kg/m3 @@ -111,7 +117,7 @@ module Emissions_ml USE_LIGHTNING_EMIS,USE_AIRCRAFT_EMIS,USE_ROADDUST, & USE_EURO_SOILNOX, USE_GLOBAL_SOILNOX, EURO_SOILNOX_DEPSCALE,&! one or the other USE_OCEAN_NH3,USE_OCEAN_DMS,FOUND_OCEAN_DMS,& - NPROC, EmisSplit_OUT,USE_uEMEP,uEMEP,SECTORS_NAME + NPROC, EmisSplit_OUT,USE_uEMEP,uEMEP,SECTORS_NAME,SecEmisOutPoll use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER& ,MPI_SUM,MPI_COMM_CALC, IERROR use NetCDF_ml, only: ReadField_CDF,ReadField_CDF_FL,ReadTimeCDF,IsCDFfractionFormat,& @@ -145,27 +151,11 @@ module Emissions_ml public :: newmonth public :: EmisSet ! Sets emission rates every hour/time-step public :: EmisOut ! Outputs emissions in ascii -public :: uemep_emis ! The main code does not need to know about the following private :: expandcclist ! expands e.g. EU28, EUMACC2 private :: consistency_check ! Safety-checks -! -! The output emission matrix for the 11-SNAP data is snapemis: -! -real, private, allocatable, dimension(:,:,:,:,:), save :: & - snapemis ! main emission arrays, in kg/m2/s - -real, private, allocatable, dimension(:,:,:,:), save :: & - snapemis_flat ! main emission arrays, in kg/m2/s - -real, private, allocatable, dimension(:,:,:,:), save :: & -! Not sure if it is really necessary to keep the country info; gives rather messy code but consistent with the rest at least (and can do the seasonal scaling for Nordic countries in the code instead of as preprocessing) - roaddust_emis_pot ! main road dust emission potential arrays, in kg/m2/s (to be scaled!) - -! We store the emissions for output to d_2d files and netcdf in kg/m2/s -real, public, allocatable, dimension(:,:,:), save :: SumSnapEmis,SumSplitEmis logical, save, private :: first_dms_read @@ -176,7 +166,7 @@ module Emissions_ml logical :: Cexist,USE_MONTHLY_GRIDEMIS=.false.!internal flag real ::TimesInDays(120),mpi_out -integer ::NTime_Read=-1,ncFileID,VarID,found, cdfstatus +integer ::NTime_Read=-1,found character(len=125) ::fileName_monthly='NOT_SET'!must be initialized with 'NOT_SET' character(len=10), private,save :: incl_monthly(size(emis_inputlist(1)%incl)),& excl_monthly(size(emis_inputlist(1)%excl)) @@ -244,8 +234,8 @@ subroutine Emissions(year) logical,save :: my_first_call=.true. ! Used for femis call logical :: fileExists ! to test emission files character(len=40) :: varname, fmt,cdf_sector_name - integer ::allocerr, i_Emis_4D - + integer ::allocerr, i_Emis_4D, iemsec + if (MasterProc) write(6,*) "Reading emissions for year", year @@ -266,16 +256,28 @@ subroutine Emissions(year) write(*,*)"Emission source number ", iemislist,"from ",sub//trim(fname) if(emis_inputlist(iemislist)%type == "sectors".or.& - emis_inputlist(iemislist)%type == "GNFRsectors")then ! Expand groups, e.g. EUMACC2 + emis_inputlist(iemislist)%type == "GNFRsectors".or.& + emis_inputlist(iemislist)%type == "SNAPsectors")then ! Expand groups, e.g. EUMACC2 call expandcclist( emis_inputlist(iemislist)%incl , n) emis_inputlist(iemislist)%Nincl = n - if(MasterProc) write(*,*) sub//trim(fname)//" INPUTLIST-INCL", n - + if(MasterProc .and. n>0) then + write(*,*) sub//trim(fname)//" INPUTLIST-INCL", n + write(*,*)'including only countries: ', (trim(emis_inputlist(iemislist)%incl(i))//' ',i=1,n) + endif call expandcclist( emis_inputlist(iemislist)%excl , n) emis_inputlist(iemislist)%Nexcl = n - if(MasterProc) write(*,*) sub//trim(fname)//" INPUTLIST-EXCL", n - + if(MasterProc .and. n>0) then + write(*,*)'excluding countries: ', (trim(emis_inputlist(iemislist)%excl(i))//' ',i=1,n) + endif + end if + if(emis_inputlist(iemislist)%pollName(1)/='NOTSET')then + do iem = 1, NEMIS_FILE + if(all(emis_inputlist(iemislist)%pollName(:)/=trim(EMIS_FILE(iem))))cycle + if(Masterproc)write(*,"(A)")'including pollutant '//trim(EMIS_FILE(iem))//' from '//trim(fname) + enddo + else + !include all pollutants endif !replace keywords @@ -297,15 +299,14 @@ subroutine Emissions(year) SECTORS_NAME=trim(cdf_sector_name) if(Masterproc)write(*,*)"Switching sector categories to ",trim(SECTORS_NAME) if(Masterproc)write(IO_LOG,*)"Switching sector categories to ",trim(SECTORS_NAME) - endif - enddo ! iemislist - endif + end if + end do ! iemislist + end if !>============================ - ! 0) set molwts, conversion factors (e.g. tonne NO2 -> tonne N), and - ! emission indices (IQSO2=.., ) + ! 0) set molwts, conversion factors (e.g. tonne NO2 -> tonne N) ! init_sectors if(SECTORS_NAME=='SNAP')then @@ -331,7 +332,7 @@ subroutine Emissions(year) sec2split_map => TEST_sec2split_map else call StopAll("Sectors not defined") - endif + end if allocate(cdfemis(LIMAX,LJMAX)) allocate(nGridEmisCodes(LIMAX,LJMAX)) @@ -360,10 +361,24 @@ subroutine Emissions(year) roaddust_emis_pot=0.0 allocate(SumSnapEmis(LIMAX,LJMAX,NEMIS_FILE)) SumSnapEmis=0.0 - if(USE_uEMEP)then - allocate(loc_frac(LIMAX,LJMAX,KMAX_MID,1)) - loc_frac=0.0 + + iemsec = 0 +! SecEmisOutPoll(1:2) = ['pm25','nox'] + do iem = 1, NEMIS_FILE + if(SecEmisOutPoll(1)/='NOTSET')then + if(all(SecEmisOutPoll(:)/=trim(EMIS_FILE(iem))))cycle + SecEmisOut(iem) = .true. + iemsec = iemsec + 1 + endif + enddo + NSecEmisOut = iemsec + if(NSecEmisOut>0)then + allocate(SumSecEmis(LIMAX,LJMAX,NSECTORS,NSecEmisOut)) + SumSecEmis=0.0 + else + allocate(SumSecEmis(1,1,1,1))!to avoid debug error messages endif + !========================= ! call Country_Init() ! In Country_ml, => NLAND, country codes and names, timezone @@ -380,7 +395,7 @@ subroutine Emissions(year) call femis() ! emission factors (femis.dat file) if(ios/=0) return my_first_call = .false. - endif + end if ! The GEA emission data, which is used for EUCAARI runs on the HIRHAM @@ -400,11 +415,11 @@ subroutine Emissions(year) case(3);ic=find_index("ATL",Country(:)%code) case(4);ic=find_index("MED",Country(:)%code) case(5);ic=find_index("BLS",Country(:)%code) - endselect + end select call CheckStop(ic<1,"Country_Init error in HIRHAM/GEA fix") Country(ic)%is_sea = .false. - enddo - endif ! HIRHAM/GEA fix + end do + end if ! HIRHAM/GEA fix !========================= call consistency_check() ! Below @@ -423,11 +438,11 @@ subroutine Emissions(year) if(USES%GRIDDED_EMIS_MONTHLY_FACTOR)then write(*,*)"Emissions using gridded monhtly timefactors " write(IO_LOG,*)"Emissions using gridded monhtly timefactors " - endif + end if !========================= call timefactors(year) ! => fac_emm, fac_edd !========================= - endif + end if !========================= call EmisSplit() ! In EmisGet_ml, => emisfrac !========================= @@ -435,7 +450,7 @@ subroutine Emissions(year) if(EmisSplit_OUT)then allocate(SumSplitEmis(LIMAX,LJMAX,nrcemis)) SumSplitEmis=0.0 - endif + end if !========================= call CheckStop(ios, "ioserror: EmisSplit") @@ -451,12 +466,6 @@ subroutine Emissions(year) if(INERIS_SNAP2) & ! INERIS do not use any base-line for SNAP2 fac_min(:,ISNAP_DOM,:) = 0. - !:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - ! c4b) Set up DMS factors here - to be used in newmonth - ! Taken from IQ_DMS=35 for SO2 nature (sector 11) - ! first_dms_read is true until first call to newmonth finished. - first_dms_read = .true. - ! 4) Read emission files ! allocate for MasterProc (me:=0) only: @@ -472,7 +481,7 @@ subroutine Emissions(year) call CheckStop(err8, "Allocation error 8 - globroadland") call CheckStop(err9, "Allocation error 9 - globroad_dust_pot") call CheckStop(err1, "Allocation error 1 - RoadDustEmis_climate_factor") - endif ! road dust + end if ! road dust ! Initialise with 0 sumemis_local(:,:)=0.0 @@ -483,15 +492,15 @@ subroutine Emissions(year) road_globland(:,:,:)=0 globroad_dust_pot(:,:,:)=0. RoadDustEmis_climate_factor(:,:)=1.0 ! default, no scaling - endif ! road dust + end if ! road dust else ! needed for DEBUG=yes compilation options if(USE_ROADDUST)then allocate(road_globnland(1,1),road_globland(1,1,1),& globroad_dust_pot(1,1,1),stat=err9) call CheckStop(err9, "Allocation error 9 - dummy roadglob") - endif ! road dust - endif + end if ! road dust + end if select case(EMIS_SOURCE) @@ -536,27 +545,38 @@ subroutine Emissions(year) write(*,*)"Uncompatible settings: you use monthly emissions and GRIDDED_EMIS_MONTHLY_FACTOR=T " !If you really want this, you can uncomment the stop call StopAll("monthly emissions and GRIDDED_EMIS_MONTHLY_FACTOR=T not allowed ") - endif + end if else !yearly grid independent netcdf fraction format emissions do iem = 1, NEMIS_FILE if(emis_inputlist(iemislist)%pollName(1)/='NOTSET')then - if(emis_inputlist(iemislist)%pollName(1)/=trim(EMIS_FILE(iem)))cycle - endif + if(all(emis_inputlist(iemislist)%pollName(:)/=trim(EMIS_FILE(iem))))cycle + if(Masterproc)write(*,"(A)")'reading '//trim(EMIS_FILE(iem))//' from '//trim(fname) + end if do isec=1,NSECTORS - write(varname,"(A,I2.2)")trim(EMIS_FILE(iem))//'_sec',isec + if(SECTORS_NAME=='GNFR'.and.emis_inputlist(iemislist)%type == "SNAPsectors")then + if(gnfr2snap(isec)<=0)cycle + write(varname,"(A,I2.2)")trim(EMIS_FILE(iem))//'_sec',gnfr2snap(isec) + if(me==0.and.iem==1)write(*,*)'WARNING, mapping snap sector ',gnfr2snap(isec),'onto gnfr',isec + else if(SECTORS_NAME=='SNAP'.and.emis_inputlist(iemislist)%type == "GNFRsectors")then + if(snap2gnfr(isec)<=0)cycle + if(me==0.and.iem==1)write(*,*)'WARNING, mapping gnfr sector ',snap2gnfr(isec),'onto snap',isec + write(varname,"(A,I2.2)")trim(EMIS_FILE(iem))//'_sec',snap2gnfr(isec) + else + write(varname,"(A,I2.2)")trim(EMIS_FILE(iem))//'_sec',isec + endif call EmisGetCdfFrac(iem, isec, fname, varname, sumemis_local, & emis_inputlist(iemislist)%incl, nin, emis_inputlist(iemislist)%excl, nex) - enddo!sectors - enddo!NEMIS_FILE + end do!sectors + end do!NEMIS_FILE !add together totals from each processor (only me=0 get results) sumemis=0.0 CALL MPI_REDUCE(sumemis_local,sumemis,& NLAND*NEMIS_FILE,MPI_REAL8,MPI_SUM,0,MPI_COMM_CALC,IERROR) - endif + end if elseif(index(emis_inputlist(iemislist)%name,"Emis_4D.nc")>0)then !under development @@ -569,23 +589,31 @@ subroutine Emissions(year) n=find_index(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D),species(:)%name) if(MasterProc)then if(n>0)then - write(*,*)'Emis_4D: will write to ',n,emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D) + write(*,*)'Emis_4D: will write to ',& + n,trim(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D)) else - write(*,*)'Emis_4D: WARNING did not find ',emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D),' among the emep species' - write(*,*)'Emis_4D: WARNING ',emis_inputlist(Found_Emis_4D)%pollName(i_Emis_4D),' is not used' - endif - endif - enddo + write(*,*)'Emis_4D: WARNING did not find ',& + trim(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D)),& + ' among the emep species' + write(*,*)'Emis_4D: WARNING ',& + trim(emis_inputlist(Found_Emis_4D)%pollName(i_Emis_4D)),& + ' is not used' + end if + end if + end do ! else if(IsCDFSnapFormat(trim(emis_inputlist(iemislist)%name)))then !This Does not work because of "POLL" - elseif(emis_inputlist(iemislist)%type == "sectors" .and. index(emis_inputlist(iemislist)%name,".nc")>1)then + elseif((emis_inputlist(iemislist)%type == "sectors".or.& + emis_inputlist(iemislist)%type == "GNFRsectors".or.& + emis_inputlist(iemislist)%type == "SNAPsectors") .and. index(emis_inputlist(iemislist)%name,".nc")>1)then !not in "fraction" format. Each land has own set of fields !Each pollutant has own file. if(MasterProc) write(*,*)sub//trim(fname)//" Processing" do iem = 1, NEMIS_FILE if(emis_inputlist(iemislist)%pollName(1)/='NOTSET')then - if(emis_inputlist(iemislist)%pollName(1)/=trim(EMIS_FILE(iem)))cycle - endif + if(all(emis_inputlist(iemislist)%pollName(:)/=trim(EMIS_FILE(iem))))cycle + if(Masterproc)write(*,*)'reading '//trim(EMIS_FILE(iem))//' from '//trim(fname) + end if fname = key2str(emis_inputlist(iemislist)%name,'POLL',EMIS_FILE(iem)) @@ -596,7 +624,7 @@ subroutine Emissions(year) if(.not.fileExists) write(*,"(a)") 'WARNING EMISFile missing! '//trim(fname) write(*,*)sub//trim(fname)//" REPLACE ",iem,trim(fname),& key2str(emis_inputlist(iemislist)%name,'POLL',EMIS_FILE(iem)) - endif + end if call CheckStop( nin>0 .and. nex > 0, & "emis_inputlists cannot have inc and exc") @@ -608,18 +636,22 @@ subroutine Emissions(year) excl=emis_inputlist(iemislist)%excl(1:nex) ) else call EmisGetCdf(iem,fname, sumemis(1,iem)) - endif + end if if(MasterProc) write(*,*) "PARTEMIS ", iem, trim(fname), sumemis(27,iem) - enddo + end do elseif(index(emis_inputlist(iemislist)%name,"grid")>0)then !ASCII format do iem = 1, NEMIS_FILE + if(emis_inputlist(iemislist)%pollName(1)/='NOTSET')then + if(all(emis_inputlist(iemislist)%pollName(:)/=trim(EMIS_FILE(iem))))cycle + if(Masterproc)write(*,*)'reading '//trim(EMIS_FILE(iem))//' from '//trim(fname) + endif fname=key2str(emis_inputlist(iemislist)%name,'POLL',EMIS_FILE(iem)) ! e.g. POLL -> sox if(MasterProc)write(*,fmt='(A)')'Reading ASCII format '//trim(fname) call EmisGetASCII(iem, fname, trim(EMIS_FILE(iem)), sumemis_local, & emis_inputlist(iemislist)%incl, nin, emis_inputlist(iemislist)%excl, nex) - enddo + end do !add together totals from each processor (only me=0 get results) sumemis=0.0 @@ -628,6 +660,7 @@ subroutine Emissions(year) elseif(emis_inputlist(iemislist)%type == "OceanNH3")then if(MasterProc)write(*,*)' using OceanNH3' + USE_OCEAN_NH3=.true. O_NH3%index=find_index("NH3",species(:)%name) call CheckStop(O_NH3%index<0,'Index for NH3 not found') NTime_Read=-1 @@ -643,7 +676,7 @@ subroutine Emissions(year) if(MasterProc)write(*,*)' found OceanNH3 monthly' else call StopAll("Yearly OceanNH3 not implemented") - endif + end if elseif (emis_inputlist(iemislist)%type == "DMS")then if(MasterProc)write(*,*)'using DMS' USE_OCEAN_DMS=.true. @@ -662,55 +695,78 @@ subroutine Emissions(year) if(MasterProc)write(*,*)' found DMS monthly' else call StopAll("Yearly DMS not implemented") - endif + end if + elseif(emis_inputlist(iemislist)%type == "Special_ShipEmis")then + !should put in a single array + allocate(AISco(LIMAX,LJMAX)) + allocate(AISnox(LIMAX,LJMAX)) + allocate(AISsox(LIMAX,LJMAX)) + allocate(AISso4(LIMAX,LJMAX)) + allocate(AISash(LIMAX,LJMAX)) + allocate(AISec(LIMAX,LJMAX)) + allocate(AISoc(LIMAX,LJMAX)) + FOUND_Special_ShipEmis = .true. + NO_ix = find_index("NO",species(:)%name) + NO2_ix = find_index("NO2",species(:)%name) + SO2_ix = find_index("SO2",species(:)%name) + SO4_ix = find_index("SO4",species(:)%name) + CO_ix = find_index("CO",species(:)%name) + REMPPM25_ix = find_index("REMPPM25",species(:)%name) + EC_F_FFUEL_NEW_ix = find_index("EC_F_FFUEL_NEW",species(:)%name) + EC_F_FFUEL_AGE_ix = find_index("EC_F_FFUEL_AGE",species(:)%name) + POM_F_FFUEL_ix = find_index("POM_F_FFUEL",species(:)%name) + + call ReadTimeCDF(trim(fname),TimesInDays,NTime_Read) + if(NTime_Read==12)emis_inputlist(iemislist)%periodicity = "monthly" + if(NTime_Read>364 .and. NTime_Read<367)emis_inputlist(iemislist)%periodicity = "daily" else if(MasterProc)write(*,*)'WARNING: did not recognize format of '//trim(emis_inputlist(iemislist)%name) call StopAll("Emissions file format not recognized ") - endif + end if if(MasterProc.and. emis_inputlist(iemislist)%periodicity == "once") then call PrintLog("Total emissions by countries for "//trim(emis_inputlist(iemislist)%name)//" (Gg)") - write(* ,"(2a4,3x,30(a12,:))")" N "," CC ",EMIS_FILE(:) - write(IO_LOG,"(2a4,3x,30(a12,:))")" N "," CC ",EMIS_FILE(:) + write(* ,"(a4,a9,3x,30(a12,:))")" CC "," ",EMIS_FILE(:) + write(IO_LOG,"(a4,a9,3x,30(a12,:))")" CC "," ",EMIS_FILE(:) sumEU(:) = 0.0 - fmt="(i4,1x,a4,3x,30(f12.2,:))" + fmt="(i4,1x,a9,3x,30(f12.2,:))" do ic = 1, NLAND ccsum = sum( sumemis(ic,:) ) icc=Country(ic)%icode if ( ccsum > 0.0 )then write(*, fmt) icc, Country(ic)%code, sumemis(ic,:) write(IO_LOG,fmt) icc, Country(ic)%code, sumemis(ic,:) - endif + end if if(find_index(Country(ic)%code,EU28(:))>0) sumEU = sumEU + sumemis(ic,:) - enddo + end do if ( sum(sumEU(:))>0.001) then write(* ,fmt) 0, "EU", sumEU(:) write(IO_LOG,fmt) 0, "EU", sumEU(:) - endif - endif + end if + end if !total of emissions from all countries and files into emsum do iem = 1, NEMIS_FILE emsum(iem)= emsum(iem)+sum(sumemis(:,iem)) - enddo + end do - enddo + end do if(MasterProc)then write(* ,"(a9,3x,30(f12.2,:))")' TOTAL : ',emsum(:) write(IO_LOG,"(a9,3x,30(f12.2,:))")' TOTAL : ',emsum(:) - endif + end if !temporary: nlandcode,landcode,snapemis will be completely removed nlandcode=nGridEmisCodes landcode=GridEmisCodes snapemis=GridEmis - !endif ! EMIS_TEST /Mixed + !end if ! EMIS_TEST /Mixed case default call CheckStop("EMIS_SOURCE not set"//trim(EMIS_SOURCE)) - endselect + end select if(USE_ROADDUST) then !Use grid-independent Netcdf input files @@ -720,7 +776,7 @@ subroutine Emissions(year) select case(iem) case(1);varname='HighwayRoadDustPM10_Jun-Feb' case(2);varname='nonHighwayRoadDustPM10_Jun-Feb' - endselect + end select roaddust_emis_pot(:,:,:,iem)=0.0 call ReadField_CDF('RoadMap.nc',varname,roaddust_emis_pot(1,1,1,iem),& nstart=1,interpol='mass_conservative',fractions_out=fractions,& @@ -731,7 +787,7 @@ subroutine Emissions(year) call ReadField_CDF('AVG_SMI_2005_2010.nc',varname,SMI,nstart=1,& interpol='conservative',needed=.true.,debug_flag=.false.) SMI_defined=.true. - endif + end if do i=1,LIMAX do j=1,LJMAX @@ -742,9 +798,9 @@ subroutine Emissions(year) do iic=road_nlandcode(i,j),1,-1 roaddust_emis_pot(i,j,iic,iem)=roaddust_emis_pot(i,j,1,iem) & *fractions(i,j,iic)*SMI_roadfactor - enddo - enddo - enddo + end do + end do + end do sumroaddust_local(:,iem)=0.0 do i=1,LIMAX do j=1,LJMAX @@ -754,22 +810,22 @@ subroutine Emissions(year) if(Country(ic)%icode/=road_landcode(i,j,iic))then write(*,*)"COUNTRY ROAD CODE ERROR: ",road_landcode(i,j,iic),ic,Country(ic)%icode call StopAll("COUNTRY CODE ERROR ") - endif + end if if(ic>NLAND)then write(*,*)"COUNTRY CODE NOT RECOGNIZED OR UNDEFINED: ",road_landcode(i,j,iic) call StopAll("COUNTRY CODE NOT RECOGNIZED ") - endif + end if sumroaddust_local(ic,iem)=sumroaddust_local(ic,iem)& +0.001*roaddust_emis_pot(i,j,iic,iem) - enddo - enddo - enddo - enddo ! iem = 1, NROAD_FILES-loop + end do + end do + end do + end do ! iem = 1, NROAD_FILES-loop sumroaddust=0.0 CALL MPI_REDUCE(sumroaddust_local,sumroaddust,NLAND*NROAD_FILES,MPI_REAL8,& MPI_SUM,0,MPI_COMM_CALC,IERROR) - endif !USE_ROADDUST + end if !USE_ROADDUST if(MasterProc) then if(USE_ROADDUST)THEN @@ -784,10 +840,10 @@ subroutine Emissions(year) icc=Country(ic)%icode write(* ,"(i4,1x,a4,3x,30(f12.2,:))")icc, Country(ic)%code, sumroaddust(ic,:) write(IO_LOG,"(i4,1x,a4,3x,30(f12.2,:))")icc, Country(ic)%code, sumroaddust(ic,:) - endif - enddo - endif ! ROAD DUST - endif + end if + end do + end if ! ROAD DUST + end if ! now all values are read, snapemis is distributed, globnland and ! globland are ready for distribution @@ -797,7 +853,7 @@ subroutine Emissions(year) call StopAll("The emislist option is not available anymore! Use Mixed instead") case("CdfFractions") ! emissions directly defined into nlandcode,landcode and snapemis - endselect + end select ! Create emislist-type files for both snap emissions and Cdf ! Useful for export to other codes, including production of @@ -813,7 +869,7 @@ subroutine Emissions(year) if((EMIS_TEST=="CdfSnap").and.EMIS_OUT) & call EmisOut("Cdf",iem,nGridEmisCodes,GridEmisCodes,GridEmis(:,:,:,:,iem)) - enddo + end do !** Conversions: ! The emission-data file are so far in units of @@ -829,8 +885,8 @@ subroutine Emissions(year) write(*,*) "Emissions sums:" do iem = 1, NEMIS_FILE write(*,"(a15,f12.2)") EMIS_FILE(iem),emsum(iem) - enddo - endif + end do + end if iemCO=find_index("co",EMIS_FILE(:)) ! save this index @@ -842,6 +898,22 @@ subroutine Emissions(year) forall (ic=1:NCMAX, j=1:ljmax, i=1:limax, isec=1:NSECTORS,iem=1:NEMIS_FILE) snapemis (isec,i,j,ic,iem) = snapemis (isec,i,j,ic,iem) * tonne_to_kgm2s * xm2(i,j) endforall + !do ic=1,NCMAX + ! do j=1,ljmax + ! do i=1,limax + ! do isec=1,NSECTORS + ! iem=6 + ! if(isec==7 .and. i_fdom(i)==51 .and. j_fdom(j)==63)then + ! !snapemis (isec,i,j,ic,iem) = snapemis (isec,i,j,ic,iem) * tonne_to_kgm2s * xm2(i,j) + ! else + ! snapemis (isec,i,j,ic,iem) = 0.0 + ! endif + ! enddo + ! enddo + ! enddo + !enddo + + forall (fic=1:FNCMAX, j=1:ljmax, i=1:limax,iem=1:NEMIS_FILE) snapemis_flat(i,j,fic,iem) = snapemis_flat(i,j,fic,iem) * tonne_to_kgm2s * xm2(i,j) @@ -857,7 +929,7 @@ subroutine Emissions(year) roaddust_emis_pot(i,j,ic,iem) = & roaddust_emis_pot(i,j,ic,iem) * tonne_to_kgm2s * xm2(i,j) endforall - endif !road dust + end if !road dust err1 = 0 if(MasterProc) then @@ -868,14 +940,14 @@ subroutine Emissions(year) call CheckStop(err7, "De-Allocation error 7 - roadglob") call CheckStop(err8, "De-Allocation error 8 - roadglob") call CheckStop(err9, "De-Allocation error 9 - roadglob") - endif + end if else ! needed for DEBUG=yes compilation options if(USE_ROADDUST)THEN deallocate(road_globnland,road_globland,globroad_dust_pot,stat=err9) call CheckStop(err9, "De-Allocation error 9 - dummy roadglob") - endif - endif + end if + end if ! now we have nrecmis and can allocate for gridrcemis: ! print *, "ALLOCATING GRIDRC", me, NRCEMIS @@ -888,8 +960,8 @@ subroutine Emissions(year) allocate(gridrcroadd0(NROADDUST,LIMAX,LJMAX),stat=err4) call CheckStop(err3, "Allocation error 3 - gridrcroadd") call CheckStop(err4, "Allocation error 4 - gridrcroadd0") - endif -endsubroutine Emissions + end if +end subroutine Emissions !----------------------------------------------------------------------! !> !! expandcclist converts e.g. EU28 to indivdual countries @@ -919,10 +991,10 @@ subroutine expandcclist(xlist, n) !if(MasterProc) print *, "NLIST DEF - ", me, i, n, xlist(i) nlist(n) = xlist(i) n=n+1 - endselect - enddo CCLIST ! i + end select + end do CCLIST ! i xlist(1:n) = nlist(1:n) ! overwrites original -endsubroutine expandcclist +end subroutine expandcclist !----------------------------------------------------------------------! subroutine consistency_check() !----------------------------------------------------------------------! @@ -932,7 +1004,7 @@ subroutine consistency_check() errormsg = "ok" if(size(EMIS_FILE)/=NEMIS_FILE) errormsg = " size EMISNAME wrong " call CheckStop(errormsg,"Failed consistency check") -endsubroutine consistency_check +end subroutine consistency_check !*********************************************************************** subroutine EmisSet(indate) ! emission re-set every time-step/hour !----------------------------------------------------------------------! @@ -989,7 +1061,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! If timezone=-100, calculate daytime based on longitude rather than timezone integer :: daytime_longitude, daytime_iland, hour_longitude, hour_iland,nstart - integer :: i_Emis_4D + integer :: i_Emis_4D, iemsec character(len=125) ::varname TYPE(timestamp) :: ts1,ts2 @@ -1016,7 +1088,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour wday=day_of_week(indate%year,indate%month,indate%day) if(wday==0)wday=7 ! Sunday -> 7 oldday = indate%day - endif + end if if(Found_Emis_4D>0)then if(.not.allocated(Emis_4D))allocate(Emis_4D(LIMAX,LJMAX,KMAX_MID,N_Emis_4D)) @@ -1033,25 +1105,26 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour if(MasterProc)write(*,*)'Emis_4D: found matching date ',i,TimesInDays(i) nstart=i exit - endif - enddo + end if + end do if(i>NTime_Read )then if(MasterProc)then write(*,*)'Emis_4D: WARNING DID NOT FIND ANY MATCHING DATE ' write(*,*)'Emis_4D: first date found ',TimesInDays(1) write(*,*)'Emis_4D: last date found ',TimesInDays(NTime_Read) write(*,*)'Emis_4D: difference to last date ',tdif_secs(ts1,ts2)/3600,' hours' - endif + end if else do i_Emis_4D=1,N_Emis_4D if(emis_inputlist(Found_Emis_4D)%pollName(i_Emis_4D)=='NOTSET')exit varname=emis_inputlist(Found_Emis_4D)%pollName(i_Emis_4D) !if(MasterProc)write(*,*)'Fetching ',trim(varname) - call GetCDF_modelgrid(varname,emis_inputlist(Found_Emis_4D)%Name,Emis_4D(1,1,1,i_Emis_4D),1,kmax_mid,nstart,1,reverse_k=.true.) - enddo - endif - endif - endif + call GetCDF_modelgrid(varname,emis_inputlist(Found_Emis_4D)%Name,& + Emis_4D(1,1,1,i_Emis_4D),1,kmax_mid,nstart,1,reverse_k=.true.) + end do + end if + end if + end if if(DEBUG_EMISTIMEFACS.and.MasterProc) & write(*,"(a,2f8.3)") " EmisSet traffic 24x7", & @@ -1064,12 +1137,13 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour hourloc = indate%hour + Country(iland)%timezone localhour(iland) = hourloc ! here from 0 to 23 if(hourloc>=7 .and. hourloc<=18) daytime(iland)=1 - enddo ! iland + end do ! iland if(hourchange) then totemadd(:) = 0. gridrcemis0(:,:,:,:) = 0.0 SumSnapEmis(:,:,:) = 0.0 + SumSecEmis(:,:,:,:) = 0.0 if(USE_ROADDUST)gridrcroadd0(:,:,:) = 0.0 !.......................................... ! Process each grid: @@ -1099,7 +1173,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour else daytime_iland=daytime(iland) hour_iland=localhour(iland) + 1 - endif + end if !if( hour_iland > 24 ) hour_iland = 1 !DSA12 wday_loc=wday if(hour_iland>24) then @@ -1107,7 +1181,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour wday_loc=wday + 1 if(wday_loc==0)wday_loc=7 ! Sunday -> 7 if(wday_loc>7 )wday_loc=1 - endif + end if call CheckStop(hour_iland<1,"ERROR: HOUR Zero in EmisSet") if(debug_tfac) then write(*,"(a,i4,2i3,i5,2i4,3x,4i3)") "EmisSet DAYS times ", daynumber, & @@ -1116,7 +1190,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour call datewrite("EmisSet DAY 24x7:", & (/ icc, iland, wday, wday_loc, hour_iland /), & (/ fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc) /) ) - endif + end if ! As each emission sector has a different diurnal profile ! and possibly speciation, we loop over each sector, adding ! the found emission rates to gridrcemis as we go. @@ -1125,7 +1199,9 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Calculate emission rates from snapemis, time-factors, ! and if appropriate any speciation fraction (NEMIS_FRAC) iqrc = 0 ! index over emisfrac + iemsec = 0 do iem = 1, NEMIS_FILE + if(SecEmisOut(iem))iemsec = iemsec + 1 tfac = timefac(iland_timefac,sec2tfac_map(isec),iem) & * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc) @@ -1152,12 +1228,13 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour isec, sec2tfac_map(isec),iland, daynumber, indate%hour, & timefac(iland_timefac,sec2tfac_map(isec),iem), t2_nwp(i,j,2)-273.15, & fac_min(iland,sec2tfac_map(isec),iem), gridfac_HDD(i,j), tfac - endif ! =============== HDD + end if ! =============== HDD s = tfac * snapemis(isec,i,j,icc,iem) ! prelim emis sum kg/m2/s SumSnapEmis(i,j,iem) = SumSnapEmis(i,j,iem) + s + if(SecEmisOut(iem))SumSecEmis(i,j,isec,iemsec) = SumSecEmis(i,j,isec,iemsec) + s do f = 1,emis_nsplit(iem) iqrc = iqrc + 1 @@ -1166,8 +1243,8 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Add up emissions in ktonne totemadd(itot) = totemadd(itot) & + tmpemis(iqrc) * dtgrid * xmd(i,j) - enddo ! f - enddo ! iem + end do ! f + end do ! iem ! Assign to height levels 1-KEMISTOP do k=KEMISTOP,KMAX_MID @@ -1182,11 +1259,11 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! VERTFAC(KMAX_BND-k,sec2hfac_map(isec)), & ! emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) !end if - enddo ! iem - enddo ! k - enddo ! isec + end do ! iem + end do ! k + end do ! isec ! ================================================== - enddo ! icc + end do ! icc !************************************ ! Then loop over flat emissions !************************************ @@ -1199,7 +1276,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour isec = ISEC_SHIP else isec = ISEC_NAT - endif + end if ! As each emission sector has a different diurnal profile ! and possibly speciation, we loop over each sector, adding @@ -1208,10 +1285,12 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Calculate emission rates from snapemis, time-factors, ! and if appropriate any speciation fraction (NEMIS_FRAC) iqrc = 0 ! index over emis + iemsec = 0 do iem = 1, NEMIS_FILE sf = snapemis_flat(i,j,ficc,iem) ! prelim emis sum kg/m2/s SumSnapEmis(i,j,iem) = SumSnapEmis(i,j,iem) + sf + if(SecEmisOut(iem))SumSecEmis(i,j,isec,iemsec) = SumSecEmis(i,j,isec,iemsec) + sf do f = 1,emis_nsplit(iem) iqrc = iqrc + 1 itot = iqrc2itot(iqrc) @@ -1219,15 +1298,15 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Add flat emissions in ktonne totemadd(itot) = totemadd(itot) & + tmpemis(iqrc) * dtgrid * xmd(i,j) - enddo ! f - enddo ! iem + end do ! f + end do ! iem ! Assign flat emissions to height levels 1-4. Note, no VERTFAC do iqrc =1, nrcemis gridrcemis0(iqrc,KMAX_MID,i,j) = gridrcemis0(iqrc,KMAX_MID,i,j) & + tmpemis(iqrc)*ehlpcom0*emis_masscorr(iqrc) - enddo ! iem + end do ! iem ! ================================================== - enddo !ficc + end do !ficc if(USE_ROADDUST)then ! Limit as in TNO-model (but Lotos/Euros has precip in mm/3h) @@ -1245,7 +1324,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! if( DEBUG_ROADDUST .and. debug_proc .and. i==DEBUG_li .and. j==DEBUG_lj )THEN ! write(*,*)"DEBUG ROADDUST! Dry! ncc=", road_nlandcode(i,j) - ! endif + ! end if ncc = road_nlandcode(i,j) ! number of countries in grid point do icc = 1, ncc @@ -1255,21 +1334,21 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour hour_iland=hour_longitude+1 else hour_iland=localhour(iland)+1 - endif + end if wday_loc = wday ! DS added here also, for fac_ehh24x7 if( hour_iland > 24 ) then hour_iland = 1 if(wday_loc==0)wday_loc=7 ! Sunday -> 7 if(wday_loc>7 )wday_loc=1 - endif + end if if(ANY(iland==(/IC_FI,IC_NO,IC_SE/)).and. & ! Nordic countries ANY(indate%month==(/3,4,5/)))then ! spring road dust tfac = fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc)*2.0 ! Doubling in Mar-May (as in TNO model) else tfac = fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc) - endif + end if do iem = 1, NROAD_FILES s = tfac * roaddust_emis_pot(i,j,icc,iem) @@ -1285,23 +1364,23 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour if(all([DEBUG_ROADDUST,debug_proc,i==debug_li,j==debug_lj]))then write(*,*)"gridrcroadfine" ,gridrcroadd0(QROADDUST_FI,i,j) write(*,*)"gridrcroadcoarse",gridrcroadd0(QROADDUST_CO,i,j) - endif - enddo ! nroad files - enddo ! icc + end if + end do ! nroad files + end do ! icc ! should pick the correct emissions (spring or rest of year) ! and add the emissions from HIGHWAYplus and NONHIGHWAYS, ! using correct fine and coarse fractions. else ! precipitation gridrcroadd0(:,i,j)=0. - endif NO_PRECIP - endif ! ROADDUST - enddo ! i - enddo ! j + end if NO_PRECIP + end if ! ROADDUST + end do ! i + end do ! j if(MYDEBUG.and.debug_proc) & ! emis sum kg/m2/s call datewrite("SnapSum, kg/m2/s:"//trim(EMIS_FILE(iemCO)), & (/ SumSnapEmis(debug_li,debug_lj,iemCO) /) ) - endif ! hourchange + end if ! hourchange ! We now scale gridrcemis to get emissions in molecules/cm3/s do k= KEMISTOP, KMAX_MID @@ -1311,10 +1390,10 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour !RB: This should also be done for the road dust emissions do iqrc =1, NRCEMIS gridrcemis(iqrc,k,i,j) = gridrcemis0(iqrc,k,i,j)* ehlpcom - enddo ! iqrc - enddo ! i - enddo ! j - enddo ! k + end do ! iqrc + end do ! i + end do ! j + end do ! k if(USE_ROADDUST)THEN if(DEBUG_ROADDUST.and.debug_proc) & @@ -1325,13 +1404,13 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour do iqrc =1, NROADDUST gridrcroadd(iqrc,i,j) = gridrcroadd0(iqrc,i,j)* ehlpcom * ehlpcom0 & * roaddust_masscorr(iqrc) - enddo ! iqrc - enddo ! i - enddo ! j + end do ! iqrc + end do ! i + end do ! j if(DEBUG_ROADDUST.and.debug_proc) & write(*,*)"After the unit scaling",gridrcroadd(1:2,DEBUG_li,DEBUG_lj) - endif -endsubroutine EmisSet + end if +end subroutine EmisSet !*********************************************************************** subroutine newmonth !----------------------------------------------------------------------! @@ -1347,17 +1426,12 @@ subroutine newmonth use ModelConstants_ml, only : KCHEMTOP, KMAX_MID use NetCDF_ml, only : ReadField_CDF - integer i, j,k, iyr, iemislist - integer n, flat_ncmaxfound ! Max. no. countries w/flat emissions - real :: rdemis(MAXLIMAX,MAXLJMAX) ! Emissions read from file + integer :: i, j,k, iyr, iemislist, n character(len=200) :: fname real ktonne_to_kgm2s, tonnemonth_to_kgm2s ! Units conversion - integer :: IQSO2 ! Index of sox in EMIS_FILE - integer errcode,iland - integer :: iem,ic,isec, i_gridemis + integer :: iland, iem,ic,isec, i_gridemis real :: conv logical , save :: first_call=.true. - logical :: needed_found ! For now, only the global runs use the Monthly files integer :: kstart,kend,nstart,Nyears @@ -1369,7 +1443,7 @@ subroutine newmonth character(len=125) ::fileName real :: Mask_ReducFactor integer :: NMask_Code,Mask_Code(NLAND), i_femis_lonlat - real :: lonlat_fac, dms_sum + real :: lonlat_fac, mw if(.not.allocated(airn).and.(USE_LIGHTNING_EMIS.or.USE_AIRCRAFT_EMIS))& allocate(airn(KCHEMTOP:KMAX_MID,LIMAX,LJMAX)) @@ -1403,10 +1477,10 @@ subroutine newmonth do i=1,limax airn(k,i,j)=airn(k,i,j)*conv*(roa(i,j,k,1))& /(dA(k)+dB(k)*ps(i,j,1))*xm2(i,j) - enddo - enddo - enddo - endif + end do + end do + end do + end if if(USE_EURO_SOILNOX)then ! European Soil NOx emissions if(DEBUG_SOILNOX.and.debug_proc) write(*,*)"Emissions DEBUG_SOILNOX START" @@ -1446,25 +1520,25 @@ subroutine newmonth do j=1,ljmax do i=1,limax SoilNOx(i,j)=SoilNOx(i,j)+buffer(i,j) - enddo - enddo + end do + end do if(DEBUG_SOILNOX.and.debug_proc) & write(*,"(a,2i6,es10.3,a,2es10.3)") "Averaging SOILNO inputs", & 1995+(iyr-1), nstart,SoilNOx(debug_li, debug_lj), & "max: ", maxval(buffer), maxval(SoilNOx) - enddo + end do SoilNOx=SoilNOx/Nyears - endif ! nstart test + end if ! nstart test if(DEBUG_SOILNOX.and.debug_proc) then write(*,"(a,i3,3es10.3)") "After Global SOILNO ",& me,maxval(SoilNOx),SoilNOx(debug_li,debug_lj) !write(*,"(a,i3,3es10.3)") "After Global SOILNO ", me, maxval(SoilNOx), SoilNOx(3, 3) - endif + end if else ! no soil NO if(DEBUG_SOILNOX.and.debug_proc) & write(*,*) "Emissions DEBUG_SOILNOX - none" - endif ! SOIL NO + end if ! SOIL NO !for testing, compute total soil NOx emissions within domain !convert from g/m2/day into kg/day @@ -1474,8 +1548,8 @@ subroutine newmonth do j=1,ljmax do i=1,limax SumSoilNOx=SumSoilNOx+0.001*SoilNOx(i,j)*gridwidth_m**2*xmd(i,j) - enddo - enddo + end do + end do CALL MPI_ALLREDUCE(SumSoilNOx,mpi_out,1,MPI_DOUBLE_PRECISION, & MPI_SUM,MPI_COMM_CALC,IERROR) SumSoilNOx = mpi_out @@ -1493,9 +1567,9 @@ subroutine newmonth do j=1,ljmax do i=1,limax SoilNOx(i,j)=SoilNOx(i,j)*conv*roa(i,j,k,1)/(dA(k)+dB(k)*ps(i,j,1)) - enddo - enddo - endif + end do + end do + end if ! DMS ! Units: @@ -1515,89 +1589,7 @@ subroutine newmonth write(*,*) 'Enters newmonth, mm, ktonne_to_kgm2s = ', & current_date%month,ktonne_to_kgm2s write(*,*) ' first_dms_read = ', first_dms_read - endif - !........................................................................... - ! DMS Input - land 35 - SNAP sector 11 - !........................................................................... - flat_ncmaxfound = 0 ! Max. no. countries(w/flat emissions) per grid - ! Natural SO2 emissions - IQSO2=find_index("sox",EMIS_FILE(:)) - if(IQSO2<1) then - write(*,*) " No SO2 emissions - need to skip DMS also" - return ! No need to read DMS fields - else - ! We have so2 emission so need DMS also - if(.not.first_call)then - !write some diagnostic for the past month emissions - CALL MPI_ALLREDUCE(O_DMS%sum_month, mpi_out, 1,& - MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) - O_DMS%sum_month = mpi_out - if(MasterProc)then -59 format(A,6F14.5) - write(*,*)'DMS OCEAN emissions ' - write(*,59)'SO2 from ocean DMS cdf file ',O_DMS%sum_month - write(*,59)'SO2 from natso2.dat ',DMS_natso2_month - write(*,59)'fraction new/old method',O_DMS%sum_month/DMS_natso2_month - endif - O_DMS%sum_year=O_DMS%sum_year+O_DMS%sum_month - O_DMS%sum_month=0.0 - !natso2 already allreduced - DMS_natso2_year=DMS_natso2_year+DMS_natso2_month - DMS_natso2_month=0.0 - endif - - write(fname,'(''natso2'',i2.2,''.dat'')')current_date%month - if(MasterProc)write(*,*) 'Reading DMS emissions from ',trim(fname) - needed_found=.false. - call ReadField(IO_DMS,fname,rdemis,needed_found) - - if(needed_found)then - errcode = 0 - dms_sum=0.0 - do j=1,ljmax - do i=1,limax - ! Add DMS for country code IQ_DMS=35 to snap sector 11=Nature. - ! First time we read we must add DMS to the "countries" - ! contributing within the grid square. - ! - for flat emissions: - if(first_dms_read) then - flat_nlandcode(i,j) = flat_nlandcode(i,j) + 1 - n = flat_nlandcode(i,j) - flat_landcode(i,j,n) = IQ_DMS !=Country(IC_NAT)%icode ! IQ_DMS country code index 35 - if(n>flat_ncmaxfound) then - flat_ncmaxfound = n - if (MYDEBUG) write(6,*)'DMS Increased flat_ncmaxfound to ',n - call CheckStop( n > FNCMAX, "IncreaseFNCMAX for dms") - endif - else ! We know that DMS lies last in the array, so: - n = flat_nlandcode(i,j) - call CheckStop(flat_landcode(i,j,n),IQ_DMS,"Newmonth:DMS not last!") - endif - if(.not.USE_OCEAN_DMS)then - snapemis_flat(i,j,n,IQSO2) = rdemis(i,j) * ktonne_to_kgm2s * xm2(i,j) - endif - dms_sum=dms_sum+rdemis(i,j) - enddo ! i - enddo ! j - CALL MPI_ALLREDUCE(dms_sum, mpi_out, 1,& - MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) - dms_sum=mpi_out - - DMS_natso2_month=dms_sum*nmdays(current_date%month)/nydays - - if(MasterProc) then - write(*,*)'total dms emission from ',trim(fname),dms_sum,DMS_natso2_year+DMS_natso2_month - write(*,*)' Gg this month ',DMS_natso2_month - endif - if(first_dms_read) then - if(MYDEBUG) & - write(*,*)'me ',me, ' Increased flat_ncmaxfound to ',flat_ncmaxfound - first_dms_read = .false. - endif - else!no dms file found - call PrintLog("WARNING: NO DMS emissions found",MasterProc) - endif - endif ! IQSO2>0 + end if sumemis=0.0 do iemislist = 1, size( emis_inputlist(:)%name ) @@ -1624,8 +1616,9 @@ subroutine newmonth do iem = 1,NEMIS_FILE if(emis_inputlist(iemislist)%pollName(1)/='NOTSET')then - if(emis_inputlist(iemislist)%pollName(1)/=trim(EMIS_FILE(iem)))cycle - endif + if(all(emis_inputlist(iemislist)%pollName(:)/=trim(EMIS_FILE(iem))))cycle + if(Masterproc)write(*,*)'reading '//trim(EMIS_FILE(iem))//' from '//trim(fname) + end if do isec = 1,NSECTORS !define mask (can be omitted if not sent to readfield) NMask_Code=0 @@ -1636,8 +1629,8 @@ subroutine newmonth Mask_Code(NMask_Code) = iland!codes from mask file to be reduced Mask_ReducFactor=e_fact(isec,iland,iem)!NB: will only take the last defined value! !if(MasterProc)write(*,*)'maskcode ',iland,isec,iem,Mask_ReducFactor - endif - enddo + end if + end do !example if hardcoded definitions are to be used. Here multiply country_code=18 emissions with 0.8 !Mask_ReducFactor=0.8 @@ -1665,7 +1658,7 @@ subroutine newmonth write(*,*)"To many emitter countries in one gridcell: ",& me,i,j,nlandcode(i,j) call StopAll("To many countries in one gridcell ") - endif + end if lonlat_fac=1.0 if(N_femis_lonlat>0)then do i_femis_lonlat=1,N_femis_lonlat @@ -1674,9 +1667,9 @@ subroutine newmonth glon(i,j)>femis_lonmin(i_femis_lonlat).and.& glon(i,j)0)then !1) check that country is not in exclude list found=find_index(Country(ic)%code ,excl_monthly(1:nex_monthly),first_only=.true.) if(found>0)cycle!exclude - endif + end if snapemis(isec,i,j,n,iem)=snapemis(isec,i,j,n,iem)& +fractions(i,j,n)*cdfemis(i,j)*lonlat_fac*tonnemonth_to_kgm2s*xm2(i,j) if(Country(ic)%icode/=landcode(i,j,n))then write(*,*)"COUNTRY CODE ERROR: ",landcode(i,j,n),ic,Country(ic)%icode call StopAll("COUNTRY CODE ERROR ") - endif + end if if(ic>NLAND)then write(*,*)"COUNTRY CODE NOT RECOGNIZED OR UNDEFINED: ",landcode(i,j,n) call StopAll("COUNTRY CODE NOT RECOGNIZED ") - endif + end if sumemis_local(ic,iem)=sumemis_local(ic,iem)& +0.001*snapemis(isec,i,j,n,iem)*lonlat_fac/(tonnemonth_to_kgm2s*xm2(i,j))!for diagnostics, mass balance - enddo - enddo - enddo - enddo!sectors + end do + end do + end do + end do!sectors CALL MPI_REDUCE(sumemis_local(1,iem),sumemis(1,iem),NLAND,MPI_REAL8,& MPI_SUM,0,MPI_COMM_CALC,IERROR) @@ -1732,8 +1725,8 @@ subroutine newmonth Cexist=.true. exit - endif - enddo + end if + end do if(.not.Cexist)then !country not included yet. define it now: nlandcode(i,j)=nlandcode(i,j)+1 @@ -1741,19 +1734,19 @@ subroutine newmonth write(*,*)"Too many emitter countries in one gridemiscell: ",& me,i,j,nGridEmisCodes(i,j) call StopAll("To many countries in one gridemiscell ") - endif + end if n=nlandcode(i,j) landcode(i,j,n)=GridEmisCodes(i,j,i_gridemis) snapemis(:,i,j,n,iem)=snapemis(:,i,j,n,iem)+GridEmis(:,i,j,i_gridemis,iem) - endif + end if ! sumemis_local(ic,iem)=sumemis_local(ic,iem)& ! +0.001*fractions(i,j,n)*cdfemis(i,j)!for diagnostics, mass balance - enddo - enddo - enddo - endif + end do + end do + end do + end if - enddo! iem = 1,NEMIS_FILE + end do! iem = 1,NEMIS_FILE elseif(emis_inputlist(iemislist)%type == 'OceanNH3')then if(MasterProc)write(*,*)'reading OceanNH3' @@ -1769,8 +1762,8 @@ subroutine newmonth do i=1,limax O_NH3%sum_month=O_NH3%sum_month+O_NH3%emis(i,j)& *gridwidth_m**2*xmd(i,j)*3600*24*nmdays(current_date%month) - enddo - enddo + end do + end do !sum all subdomains CALL MPI_ALLREDUCE(O_NH3%sum_month, mpi_out, 1,& MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) @@ -1793,11 +1786,35 @@ subroutine newmonth !from nanomol/l -> mol/cm3 O_DMS%emis=O_DMS%emis*1.0e-12 - else ! + elseif(emis_inputlist(iemislist)%type == "Special_ShipEmis" .and. emis_inputlist(iemislist)%periodicity == "monthly")then + nstart=current_date%month + !factor from kg/grid -> g/s/cm2 + conv = AVOG * 1.e-4 * 1.e3 & ! 1.e-4 converts from m*2 to cm*2 and + ! 1.e3 converts from kg to g + /(GRIDWIDTH_M*GRIDWIDTH_M * nmdays(current_date%month)*24.*3600.) + + !conv=RedFactorShips*conv + + !mw from Jukka-Pekka Jalkanen (e-post 16 June 2016) + mw=46.0 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'NOx',AISnox,nstart,mw,conv) + mw=28.0 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'CO',AISco,nstart,mw,conv) + mw=64.0655 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'SOx',AISsox,nstart,mw,conv) + mw=96.0655 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'SO4',AISso4,nstart,mw,conv) + mw=42.4 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'Ash',AISash,nstart,mw,conv) + mw=12.01 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'EC',AISec,nstart,mw,conv) + mw=17.32 + call ReadShipEmis(trim(emis_inputlist(iemislist)%name),'OC',AISoc,nstart,mw,conv) + else ! call StopAll("Monthly emission type not implemented "//trim(emis_inputlist(iemislist)%type)) - endif + end if - enddo !iemislist + end do !iemislist if(MasterProc)then do ic = 1, NLAND @@ -1806,11 +1823,11 @@ subroutine newmonth if(ccsum>0.0 .and. MasterProc ) then write(*,"(i5,1x,a10,3x,30(f12.2,:))")ic, Country(ic)%code, sumemis(ic,:) write(IO_LOG,"(i5,1x,a10,3x,30(f12.2,:))")ic, Country(ic)%code, sumemis(ic,:) - endif - enddo - endif + end if + end do + end if first_call=.false. -endsubroutine newmonth +end subroutine newmonth !*********************************************************************** subroutine EmisOut(label, iem,nsources,sources,emis) !----------------------------------------------------------------------! @@ -1848,7 +1865,7 @@ subroutine EmisOut(label, iem,nsources,sources,emis) open(IO_TMP,file="EmisOut"//trim(txt))!new file else open(IO_TMP,file="EmisOut"//trim(txt),access='append')!append - endif + end if EMLAND: do iland = 1, NLAND locemis = 0.0 ! print *, trim(txt)//" iland ", me, iland, maxval(emis(:,:,:,:)) @@ -1862,10 +1879,10 @@ subroutine EmisOut(label, iem,nsources,sources,emis) if(sources(i,j,icc)==iland) then locemis(i,j,: ) = emis(:, i,j,icc) if(MYDEBUG) call CheckStop(any(locemis(i,j,:)< 0.0),"NEG LOCEMIS") - endif - enddo - enddo - enddo ! j + end if + end do + end do + end do ! j if(ncc==-999)cycle!ncountry not in this subdomain ! Should never happen, but... !call CheckStop( any( lemis < 0.0 ) , "NEG LEMIS") @@ -1879,190 +1896,49 @@ subroutine EmisOut(label, iem,nsources,sources,emis) low = sum(locemis(i,j,2:NSECTORS)) write(IO_TMP,"(i3,2i4,2x,13es10.3)") iland, ii,jj, & low, high, (locemis(i,j,isec),isec=1,NSECTORS) - endif - enddo - enddo - enddo EMLAND + end if + end do + end do + end do EMLAND do isec = 1, NSECTORS lemis = locemis(:,:,isec) if(MYDEBUG.and.debug_proc) write(*,*) trim(txt)//" lemis ",me,iland,isec,maxval(lemis(:,:)) - enddo ! isec + end do ! isec - endif + end if close(IO_TMP) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR)!wait: one should write at a time - enddo + end do ! deallocate(locemis,lemis) -endsubroutine EmisOut - -subroutine uemep_emis(indate) - - implicit none - type(date), intent(in) :: indate ! Gives year..seconds - integer :: i, j, k ! coordinates, loop variables - integer :: icc, ncc ! No. of countries in grid. - integer :: ficc,fncc ! No. of countries with - integer :: iqrc ! emis indices - integer :: isec ! loop variables: emission sectors - integer :: iem ! loop variable over 1..NEMIS_FILE - integer :: itot ! index in xn() +end subroutine EmisOut - ! Save daytime value between calls, initialise to zero - integer, save, dimension(MAXNLAND) :: daytime = 0 ! 0=night, 1=day - integer, save, dimension(MAXNLAND) :: localhour = 1 ! 1-24 local hour in the different countries, ? How to handle Russia, with multiple timezones??? - integer :: hourloc ! local hour - real, dimension(NRCEMIS) :: tmpemis ! local array for emissions - real :: tfac ! time-factor (tmp variable); dt*h*h for scaling - real :: s ! source term (emis) before splitting - integer :: iland, iland_timefac ! country codes, and codes for timefac - integer :: daytime_longitude, daytime_iland, hour_longitude, hour_iland,nstart - integer ::icc_uemep - integer, save :: wday , wday_loc ! wday = day of the week 1-7 - integer ::ix,iix - real::dt_uemep, xtot, emis_uemep(KMAX_MID),emis_tot(KMAX_MID) - logical,save :: first_call=.true. +!*********************************************************************** - if(first_call)then - !init uemep -! uEMEP%emis="pm25"!one of the emission: pm25, sox, nox, voc, pmco, nh3 or co. -! uEMEP%sector=0!0 = all sectors, or choose one ector + subroutine ReadShipEMis(filename,varname,shipemis,nstart,mw,conv) + character(len=*),intent(in) ::filename,varname + real, intent(inout) ::shipemis(LIMAX,LJMAX) + real, intent(in) :: mw,conv + integer,intent(in) :: nstart + real :: invmw + integer ::i,j - iem=find_index(uEMEP%emis ,EMIS_FILE(1:NEMIS_FILE)) - call CheckStop( iem<1, "uEMEP did not find corresponding emission file: "//trim(uEMEP%emis) ) - uEMEP%Nix=emis_nsplit(iem) - call CheckStop( uEMEP%Nix>size(uEMEP%ix), "uEMEP: increase size of uEMEP%ix()!" ) - - do i=1,uEMEP%Nix - iqrc=sum(emis_nsplit(1:iem-1)) + i - itot=iqrc2itot(iqrc) - uEMEP%ix(i)=itot-NSPEC_SHL - enddo - if(MasterProc)then - write(*,*)'uEMEP sector: ',uEMEP%sector - write(*,*)'uEMEP emission file: ',uEMEP%emis - write(*,*)'uEMEP number of species in group: ',uEMEP%Nix - write(*,"(30A)")'including: ',(trim(species_adv(uEMEP%ix(i))%name),' ', i=1,uEMEP%Nix) - endif - - endif - - dt_uemep=dt_advec - - wday=day_of_week(indate%year,indate%month,indate%day) - if(wday==0)wday=7 ! Sunday -> 7 - do iland = 1, NLAND - daytime(iland) = 0 - hourloc = indate%hour + Country(iland)%timezone - localhour(iland) = hourloc ! here from 0 to 23 - if(hourloc>=7 .and. hourloc<=18) daytime(iland)=1 - enddo ! iland - - do j = lj0,lj1 - do i = li0,li1 - ncc = nlandcode(i,j) ! No. of countries in grid - fncc = flat_nlandcode(i,j) ! No. of countries with flat emissions in grid - hourloc= mod(nint(indate%hour+24*(1+glon(i,j)/360.0)),24) - hour_longitude=hourloc - daytime_longitude=0 - if(hourloc>=7 .and. hourloc<= 18) daytime_longitude=1 - !************************************************* - ! First loop over non-flat (one sector) emissions - !************************************************* - tmpemis(:)=0. - icc_uemep=0 - emis_uemep=0.0 - emis_tot=0.0 - do icc = 1, ncc+fncc - ficc=icc-ncc - ! iland = landcode(i,j,icc) ! 1=Albania, etc. - if(icc<=ncc)then - iland=find_index(landcode(i,j,icc),Country(:)%icode) !array index - else - iland=find_index(flat_landcode(i,j,ficc),Country(:)%icode) - endif - !array index of country that should be used as reference for timefactor - iland_timefac = find_index(Country(iland)%timefac_index,Country(:)%timefac_index) - - if(Country(iland)%timezone==-100)then - daytime_iland=daytime_longitude - hour_iland=hour_longitude + 1 ! add 1 to get 1..24 - else - daytime_iland=daytime(iland) - hour_iland=localhour(iland) + 1 - endif - !if( hour_iland > 24 ) hour_iland = 1 !DSA12 - wday_loc=wday - if(hour_iland>24) then - hour_iland = hour_iland - 24 - wday_loc=wday + 1 - if(wday_loc==0)wday_loc=7 ! Sunday -> 7 - if(wday_loc>7 )wday_loc=1 - endif - - do iem = 1, NEMIS_FILE - if(trim(EMIS_File(iem))/=trim(uEMEP%emis))cycle - do isec = 1, NSECTORS ! Loop over snap codes - ! Calculate emission rates from snapemis, time-factors, - ! and if appropriate any speciation fraction (NEMIS_FRAC) - iqrc = 0 ! index over emisfrac - ! kg/m2/s - - if(icc<=ncc)then - tfac = timefac(iland_timefac,sec2tfac_map(isec),iem) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc) - - !Degree days - only SNAP-2 - if(USES%DEGREEDAY_FACTORS .and. & - sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors) then - ! If INERIS_SNAP2 set, the fac_min will be zero, otherwise - ! we make use of a baseload even for SNAP2 - tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload - + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc) - endif ! =============== HDD - - s = tfac * snapemis(isec,i,j,icc,iem) - else - s = snapemis_flat(i,j,ficc,iem) - endif - - do k=KEMISTOP,KMAX_MID - emis_tot(k)=emis_tot(k)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - enddo - - if(isec==uEMEP%sector .or. uEMEP%sector==0)then - do k=KEMISTOP,KMAX_MID - emis_uemep(k)=emis_uemep(k)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - enddo - endif - - enddo ! iem + shipemis=0.0 + call ReadField_CDF(trim(filename),trim(varname),shipemis,nstart=nstart, & + interpol='mass_conservative',known_projection='longitude latitude', & + needed=.true.,debug_flag=.false.,UnDef=0.0) + if(me==0)write(*,*)'Reading ship from ',trim(filename),' ',trim(varname) + invmw=1.0/mw + do j = 1,ljmax + do i = 1, limax + shipemis(i,j) = shipemis(i,j)* conv * xm2(i,j) *invmw + + end do + end do - enddo ! isec - ! ================================================== - enddo ! icc - - do k=KEMISTOP,KMAX_MID - if(emis_tot(k)<1.E-20)cycle - !units kg/m2 - !total pollutant - xtot=0.0 - do iix=1,uEMEP%Nix - ix=uEMEP%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*species_adv(ix)%molwt)*(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV - enddo - loc_frac(i,j,k,1)=(loc_frac(i,j,k,1)*xtot+emis_uemep(k))/(xtot+emis_tot(k)+1.e-20) - enddo - - enddo ! i - enddo ! j - - first_call=.false. - -end subroutine uemep_emis + end subroutine ReadShipEMis endmodule Emissions_ml diff --git a/ExternalBICs_ml.f90 b/ExternalBICs_ml.f90 index 762ca3c..875db14 100644 --- a/ExternalBICs_ml.f90 +++ b/ExternalBICs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -73,12 +73,12 @@ module ExternalBICs_ml real :: frac=1.0 ! fraction to unimod variable logical :: wanted=.false.,found=.false. ! BC is wanted,found in file integer :: ixadv=-1 ! adv index, set from %spcname -endtype icbc +end type icbc type, private :: icbc_desc ! IC/BC description character(len=BIC_NAME_LEN) :: name="none",version="none" integer :: mapsize=-1 -endtype icbc_desc +end type icbc_desc type(icbc), dimension(:), public, pointer :: & EXTERNAL_BC=>null() ! external (non Unimod) BCs detailed description/setup @@ -110,8 +110,8 @@ subroutine Config_ExternalBICs() if(DEBUG.and.MasterProc)then write(*,*) "NAMELIST IS " write(*,NML=ExternalBICs_config) - endif -endsubroutine Config_ExternalBICs + end if +end subroutine Config_ExternalBICs subroutine set_extbic_id(idate) !----------------------------------------------------------------------------! @@ -138,7 +138,7 @@ subroutine set_extbic_id(idate) call PrintLog("No external BICs set",MasterProc) first_call = .false. return - endif + end if !--- Set BC type from idate: on first call only if(EXTERNAL_BIC_SET) return @@ -156,7 +156,7 @@ subroutine set_extbic_id(idate) EXTERNAL_BIC_VERSION='IFS_MOZ_fnyp' case(2014091800:) ! from 2014-09-18 00:00 EXTERNAL_BIC_VERSION='IFS_CMP_g4e2' - endselect + end select BC_DAYS=5 ! if BC file is not found, look for 1..5-day old files case("IFS_MOZ_f7kn","IFS_MOZ_fkya","IFS_MOZ_fnyp","IFS_CMP_g4e2") BC_DAYS=5 ! explicit MACC_ENS BC mapping version @@ -166,14 +166,14 @@ subroutine set_extbic_id(idate) EXTERNAL_BIC_VERSION='EVA_EU_AN' case(2013:) EXTERNAL_BIC_VERSION='EVA_EU_FC' - endselect + end select BC_DAYS=1 ! if BC file is not found, look for 1-day old file case("EVA_EU_AN","EVA_EU_FC") BC_DAYS=1 ! explicit MACC_EVA BC mapping version case default EXTERNAL_BIC_VERSION='use_any' BC_DAYS=0 ! do not look for old BC files - endselect + end select !--- Look for a ExternalBICs_bc with the correct %name and %version rewind(IO_NML) @@ -189,13 +189,13 @@ subroutine set_extbic_id(idate) if(EXTERNAL_BIC_SET)then EXTERNAL_BC=>map_bc(1:description%mapsize) exit READ_NML - endif - enddo READ_NML + end if + end do READ_NML if(.not.EXTERNAL_BIC_SET)then call PrintLog("No external BICs found",MasterProc) USE_EXTERNAL_BIC=.false. return - endif + end if if(DEBUG.and.MasterProc) write(*,DEBUG_FMT) "set_extbic", & date2string("BCs for YYYY-MM-DD hh type",idate),& trim(EXTERNAL_BIC_NAME)//"/"//trim(EXTERNAL_BIC_VERSION) @@ -206,16 +206,16 @@ subroutine set_extbic_id(idate) EXTERNAL_BC(n)%wanted=.false. if(MasterProc) write(*,DEBUG_FMT) "set_extbic","unknow variable",& trim(EXTERNAL_BC(n)%spcname) - endif - enddo + end if + end do if(MasterProc) & call PrintLog("External BICs set for "//EXTERNAL_BIC_NAME) EXTERNAL_BIC_SET = .true. first_call = .false. -endsubroutine set_extbic_id +end subroutine set_extbic_id subroutine set_extbic_cd(cdate) type(date) :: cdate call set_extbic_id([cdate%year,cdate%month,cdate%day,cdate%hour]) -endsubroutine set_extbic_cd +end subroutine set_extbic_cd endmodule ExternalBICs_ml diff --git a/FastJ_ml.f90 b/FastJ_ml.f90 index 67cc591..37cd262 100644 --- a/FastJ_ml.f90 +++ b/FastJ_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -197,13 +197,13 @@ ! NDXI = 6 ! ice hexag (cold) ! if (TCLD .ge. 233.15) then ! NDXI = 7 ! ice irreg -! endif +! end if ! NDXC = 1 ! do I=2,4 ! if (REFFL .gt. 0.5*(RCC(I-1)+RCC(I))) then ! NDXC = I -! endif -! enddo +! end if +! end do ! ! ! version 7.0 @@ -581,7 +581,7 @@ subroutine ACLIM_FJX (YLATD, MONTH, PPP,TTT,ZZZ,DDD,OOO, L1U) do K = 1,51 OREF2(K) = OREF(K,N,M) TREF2(K) = TREF(K,N,M) - enddo + end do ! Apportion O3 and T on supplied climatology z levels onto CTM levels +1 ! with mass (pressure) weighting, assuming constant mixing ratio and @@ -599,7 +599,7 @@ subroutine ACLIM_FJX (YLATD, MONTH, PPP,TTT,ZZZ,DDD,OOO, L1U) DLOGP = 10.d0**(-2.d0/16.d0) do K = 3,51 PSTD(K) = PSTD(K-1)*DLOGP - enddo + end do PSTD(52) = 0.d0 do L = 1,L1U F0 = 0.d0 @@ -611,19 +611,19 @@ subroutine ACLIM_FJX (YLATD, MONTH, PPP,TTT,ZZZ,DDD,OOO, L1U) XC = (PC-PB)/(PPP(L)-PPP(L+1)) F0 = F0 + OREF2(K)*XC T0 = T0 + TREF2(K)*XC - endif - enddo + end if + end do TTT(L) = T0 DDD(L) = (PPP(L)-PPP(L+1))*MASFAC OOO(L) = F0*1.d-6*DDD(L) - enddo + end do ! Calculate effective altitudes using scale height at each level ZZZ(1) = 0.d0 do L = 1,L1U-1 SCALEH = 1.3806d-19*MASFAC*TTT(L) ZZZ(L+1) = ZZZ(L) -( LOG(PPP(L+1)/PPP(L)) * SCALEH ) - enddo + end do ZZZ(L1U+1) = ZZZ(L1U) + ZZHT END SUBROUTINE ACLIM_FJX @@ -671,13 +671,13 @@ END SUBROUTINE ACLIM_FJX ! NDXI = 6 ! ice hexag (cold) ! if (TCLD .ge. 233.15) then ! NDXI = 7 ! ice irreg -! endif +! end if ! NDXC = 1 ! do I=2,4 ! if (REFFL .gt. 0.5*(RCC(I-1)+RCC(I))) then ! NDXC = I -! endif -! enddo +! end if +! end do @@ -747,7 +747,7 @@ subroutine PHOTO_JX & if (L1U .gt. JXL1_) then call EXITC(' PHOTO_JX: not enough levels in JX') - endif + end if LU = L1U - 1 L2U = LU + LU + 2 @@ -762,20 +762,20 @@ subroutine PHOTO_JX & if (SZA .gt. 98.d0)then VALJXX=0.0 goto 99 - endif + end if !---load the amtospheric column data do L = 1,L1U PPJ(L) = PPP(L) TTJ(L) = TTT(L) DDJ(L) = DDD(L) OOJ(L) = OOO(L) - enddo + end do PPJ(L1U+1) = 0.d0 !---calculate spherical weighting functions (AMF: Air Mass Factor) do L = 1,L1U+1 ZZJ(L) = ZZZ(L) - enddo + end do RFLECT = REFLB @@ -791,9 +791,9 @@ subroutine PHOTO_JX & SSA(K,L) = 0.d0 do I=1,8 SLEG(I,K,L) = 0.d0 - enddo - enddo - enddo + end do + end do + end do do L = 1,L1U @@ -805,20 +805,20 @@ subroutine PHOTO_JX & do I=2,4 if (REFFL(L) .gt. 0.5*(RCC(I-1)+RCC(I))) then NDXL = I - endif - enddo + end if + end do call OPTICL (OPTX,SSAX,SLEGX, ODL,NDXL) do K=1,5 OD(K,L) = OD(K,L) + OPTX(K) SSA(K,L) = SSA(K,L) + SSAX(K)*OPTX(K) do I=1,8 SLEG(I,K,L)=SLEG(I,K,L) + SLEGX(I,K)*SSAX(K)*OPTX(K) - enddo - enddo + end do + end do !>>>diagnostic print of cloud data: ! write(6,'(a,i3,2f8.2,f8.4,f8.2,f8.4,i4)') & ! 'Liq Cld',L,PPP(L),PPP(L+1),LWP(L),REFFL(L),ODL,NDXL - endif + end if !---Ice Water Cloud if (IWP(L) .gt. 1.d-5 .and. REFFI(L) .gt. 0.1d0) then @@ -827,19 +827,19 @@ subroutine PHOTO_JX & NDXI = 7 ! ice irreg else NDXI = 6 ! ice hexag (cold) - endif + end if call OPTICL (OPTX,SSAX,SLEGX, ODI,NDXI) do K=1,5 OD(K,L) = OD(K,L) + OPTX(K) SSA(K,L) = SSA(K,L) + SSAX(K)*OPTX(K) do I=1,8 SLEG(I,K,L)=SLEG(I,K,L) + SLEGX(I,K)*SSAX(K)*OPTX(K) - enddo - enddo + end do + end do !>>>diagnostic print of cloud data: ! write(6,'(a,i3,2f8.2,f8.4,f8.2,f8.4,i4)') & ! 'Ice Cld',L,PPP(L),PPP(L+1),IWP(L),REFFI(L),ODI,NDXI - endif + end if !---aerosols in layer: check aerosol index !---this uses data from climatology OR from current CTM (STT of aerosols) @@ -859,30 +859,30 @@ subroutine PHOTO_JX & call OPTICA (OPTX,SSAX,SLEGX, PATH,RH, NAER) else call OPTICM (OPTX,SSAX,SLEGX, PATH,RH,-NAER) - endif + end if do K=1,5 OD(K,L) = OD(K,L) + OPTX(K) SSA(K,L) = SSA(K,L) + SSAX(K)*OPTX(K) do I=1,8 SLEG(I,K,L)=SLEG(I,K,L) + SLEGX(I,K)*SSAX(K)*OPTX(K) - enddo - enddo - endif - enddo + end do + end do + end if + end do do K=1,5 if (OD(K,L) .gt. 0.d0) then SSA(K,L) = SSA(K,L)/OD(K,L) do I=1,8 SLEG(I,K,L) = SLEG(I,K,L)/OD(K,L) - enddo - endif - enddo + end do + end if + end do !---Include aerosol with cloud OD at 600 nm to determine added layers: OD600(L) = OD(4,L) - enddo + end do !---when combining with Rayleigh and O2-O3 abs, remember the SSA and !--- phase fn SLEG are weighted by OD and OD*SSA, respectively. @@ -926,16 +926,16 @@ subroutine PHOTO_JX & do I=1,8 POMEGAX(I,L,K) = SLEG(I,KMIE,L)*OD(KMIE,L) - enddo + end do POMEGAX(1,L,K) = POMEGAX(1,L,K) + 1.0d0*ODRAY POMEGAX(3,L,K) = POMEGAX(3,L,K) + 0.5d0*ODRAY do I=1,8 POMEGAX(I,L,K) = POMEGAX(I,L,K)/DTAUX(L,K) - enddo - enddo + end do + end do - endif - enddo + end if + end do !----------------------------------------------------------------------- @@ -964,7 +964,7 @@ subroutine PHOTO_JX & do L = 1,LU FFF(K,L) = FFF(K,L) + SOLF*FL(K)*AVGF(L,K) - enddo + end do FREFI = FREFI + SOLF*FL(K)*FLXD0(K)/WL(K) FREFL = FREFL + SOLF*FL(K)*FJTOP(K)/WL(K) FREFS = FREFS + SOLF*FL(K)/WL(K) @@ -982,14 +982,14 @@ subroutine PHOTO_JX & FLXJ(1) = FJFLX(1,K) - FXBOT do L=2,LU FLXJ(L) = FJFLX(L,K) - FJFLX(L-1,K) - enddo + end do FLXJ(LU+1) = FJTOP(K) - FJFLX(LU,K) !---calculate net flux deposited in each CTM layer (direct & diffuse): FFX0 = 0.d0 do L=1,L1U FFX(K,L) = FLXD(L,K) - FLXJ(L) FFX0 = FFX0 + FFX(K,L) - enddo + end do ! NB: the radiation level ABOVE the top CTM level is included in these budgets ! these are the flux budget/heating terms for the column: @@ -1013,8 +1013,8 @@ subroutine PHOTO_JX & FFXNET(K,8) = FJBOT(K) !----------------------------------------------------------------------- - endif - enddo ! end loop over wavelength K + end if + end do ! end loop over wavelength K !----------------------------------------------------------------------- FREFL = FREFL/FREFS !calculate reflected flux (energy weighted) FREFI = FREFI/FREFS @@ -1036,8 +1036,8 @@ subroutine PHOTO_JX & DTAU600(L) = DTAUX(L,W_) do I=1,8 POMG600(I,L) = POMEGAX(I,L,W_) - enddo - enddo + end do + end do call JP_ATM(PPJ,TTJ,DDJ,OOJ,ZZJ,DTAU600,POMG600,JXTRA, LU) @@ -1057,10 +1057,10 @@ subroutine PHOTO_JX & do K=NW1,NW2 if (FL(K) .gt. 1.d0) then RATIO(K) = (1.d5*FFF(K,L)/FL(K)) - endif - enddo + end if + end do write(6,'(i3,2x,18i8)') L,(RATIO(K),K=NW2,NW1,-1) - enddo + end do write(6,*) write(6,*)'fast-JX(7.0)---PHOTO_JX internal print: Net Fluxes---' @@ -1081,22 +1081,22 @@ subroutine PHOTO_JX & do L = LU,1,-1 do K=NW1,NW2 RATIO(K) = 1.d5*FFX(K,L) - enddo + end do write(6,'(i9,2x,18i8)') L,(RATIO(K),K=NW2,NW1,-1) - enddo + end do write(6,'(a)') write(6,'(a)') ' fast-JX (7.0)----J-values----' write(6,'(1x,a,72(a6,3x))') 'L= ',(TITLEJX(K), K=1,NJX) do L = LU,1,-1 write(6,'(i3,1p, 72e9.2)') L,(VALJXX(L,K),K=1,NJX) - enddo - endif + end do + end if - endif + end if 99 continue - + END SUBROUTINE PHOTO_JX @@ -1222,7 +1222,7 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & if (LU .gt. JXL_) then call EXITC (' OPMIE: JXL_ .lt. L_') - endif + end if L1U = LU + 1 L2U = 2*LU + 2 @@ -1230,11 +1230,11 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do L2 = 1,L2U,1 JADDLV(L2) = JXTRA(L2) - enddo + end do JADDTO(L2U+1) = 0 do L2 = L2U,1,-1 JADDTO(L2) = JADDTO(L2+1) + JADDLV(L2) - enddo + end do !---expanded grid now included CTM edge and mid layers plus expanded !--- grid to allow for finer delta-tau at tops of clouds. @@ -1245,21 +1245,21 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & L2LEV(1) = 1 do L2 = 2,L2U+1 L2LEV(L2) = L2LEV(L2-1) + 1 + JADDLV(L2-1) - enddo + end do !---JNDLEV(L=1:L_) = L2-index in expanded grid for CTM mid-layer L !---JNELEV(L=1:L_) = L2-index for top of layer L do L = 1,LU JNDLEV(L) = L2LEV(2*L) JNELEV(L) = L2LEV(2*L+1) - enddo + end do JNELEV(LU+1) = 0 !need to set this to top-of-atmosphere ND = 2*L2U + 2*JADDTO(1) + 1 if(ND .gt. N_) then call EXITC (' overflow of scatter arrays: ND > N_') - endif + end if !----------------begin wavelength dependent set up------------------------------ @@ -1287,7 +1287,7 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & !---Set up optical depth DTAU(L) do L = 1,L1U DTAU(L,K) = DTAUX(L,K) - enddo + end do DTAU(L1U+1,K) = 0.d0 !---Define the total scattering phase fn for each CTM layer L=1:L_+1 @@ -1296,8 +1296,8 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do L = 1,L1U do I = 1,M2_ POMEGAJ(I,L,K) = POMEGAX(I,L,K) - enddo - enddo + end do + end do !---Calculate attenuated incident beam exp(-TTAU/U0 = DTAU * AirMassFactor) !--- at the middle & edges of the CTM layers L=1:2*L1_+1 @@ -1312,12 +1312,12 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do II = 1,2*L1U+1 I = (II+1)/2 XLTAU = XLTAU + 0.5d0*DTAU(I,K)*AMF2(II,LL) - enddo + end do if (XLTAU .lt. 76.d0) then ! zero out flux at 1e-33 FTAU2(LL,K) = exp(-XLTAU) - endif - endif - enddo + end if + end if + end do !---calculate direct solar flux deposited in each CTM half-layer: L=1:L2_ !--- use FSBOT for surface flux, cannot do layer above CTM (L_+1) @@ -1325,18 +1325,18 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do LL = 1,2*L1U if (AMF2(LL,LL) .gt. 0.d0) then FLXD2(LL,K) = (FTAU2(LL+1,K) - FTAU2(LL,K))/AMF2(LL,LL) - endif - enddo + end if + end do if (AMF2(1,1) .gt. 0.d0) then FSBOT(K) = FTAU2(1,K)/AMF2(1,1) else FSBOT(K) = 0.d0 - endif + end if do LL = 2,2*L1U,2 L=LL/2 FLXD(L,K) = FLXD2(LL,K)+FLXD2(LL-1,K) - enddo + end do !---integrate solar flux depositied in CTM layers L=1:L_, cannot do top layer !--- note FLXD0 .ne. (1.d0 - FTAU(L_+1))/AMF(L_+1,L_+1) with spherical atmos @@ -1344,8 +1344,8 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & if (AMF2(2*L1U,2*L1U) .gt. 0.d0) then do L=1,L1U FLXD0(K) = FLXD0(K) + FLXD(L,K) - enddo - endif + end do + end if !------------------------------------------------------------------------ ! Take optical properties on CTM layers and convert to a photolysis @@ -1365,14 +1365,14 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & L = (L2+1)/2 DTAUJ = 0.5d0 * DTAU(L,K) TTAU(L2,K) = TTAU(L2+1,K) + DTAUJ - enddo + end do !----solar flux incident on lower boundary & Lambertian reflect factor: if (FSBOT(K) .gt. 0.d0) then ZFLUX(K) = FSBOT(K)*RFL(K)/(1.d0+RFL(K)) else ZFLUX(K) = 0.d0 - endif + end if ! Calculate scattering properties, level centres then level boundaries !>>>>>be careful of order, we are overwriting/shifting the 'POMEGAJ' upward in index @@ -1380,12 +1380,12 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & L = L2/2 do I = 1,M2_ POMEGAJ(I,L2,K) = POMEGAJ(I,L,K) - enddo - enddo + end do + end do !---lower boundary value is set (POMEGAJ(I,1)), but set upper: do I = 1,M2_ POMEGAJ(I,L2U+1,K) = POMEGAJ(I,L2U,K) - enddo + end do !---now have POMEGAJ filled at even points from L2=3:L2_-1 !---use inverse interpolation for correct tau-weighted values at edges do L2 = 3,L2U-1,2 @@ -1394,8 +1394,8 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do I = 1,M2_ POMEGAJ(I,L2,K) = (POMEGAJ(I,L2-1,K)*TAUDN + & POMEGAJ(I,L2+1,K)*TAUUP) / (TAUDN+TAUUP) - enddo - enddo + end do + end do !---at this point FTAU2(1:L2_+1) and POMEAGJ(1:8, 1:L2_+1) !--- where FTAU2(L2_+1) = 1.0 = top-of-atmos, FTAU2(1) = surface @@ -1407,8 +1407,8 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & FZ(LZ,K) = FTAU2(L2,K) do I=1,M2_ POMEGA(I,LZ,K) = POMEGAJ(I,L2,K) - enddo - enddo + end do + end do ! Now go thru the pairs of L2 levels to see if we need JADD levels do L2 = 1,L2U ! L2 = index of CTM edge- and mid-layers @@ -1423,7 +1423,7 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & FTOP(K) = FTAU2(L2+1,K) do I = 1,M2_ POMEGAB(I,K) = POMEGAJ(I,L2,K) - enddo + end do !---to fit L22 new layers between TAUBOT > TAUTOP, calculate new 1/ATAU factor !--- such that TAU(just above TAU-btm) = ATUAZ * TAUBTM < TAUBTM @@ -1443,20 +1443,20 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & FZ(LZZ,K) = 0.d0 else FZ(LZZ,K) = FBTM(K) * (FTOP(K)/FBTM(K))**ATAUA - endif - endif + end if + end if do I = 1,M2_ POMEGA(I,LZZ,K) = POMEGAB(I,K) + & ATAUA*(POMEGAJ(I,L2+1,K)-POMEGAB(I,K)) - enddo + end do TAUBTM(K) = ZTAU(LZZ,K) FBTM(K) = FZ(LZZ,K) do I = 1,M2_ POMEGAB(I,K) = POMEGA(I,LZZ,K) - enddo - enddo - endif - enddo + end do + end do + end if + end do ! Now fill in the even points with simple interpolation in scatter arrays: do LZ = 2,ND-1,2 @@ -1464,11 +1464,11 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & FZ(LZ,K) = sqrt(FZ(LZ-1,K)*FZ(LZ+1,K)) do I=1,M2_ POMEGA(I,LZ,K) = 0.5d0*(POMEGA(I,LZ-1,K)+POMEGA(I,LZ+1,K)) - enddo - enddo + end do + end do - endif - enddo ! wavelength loop! + end if + end do ! wavelength loop! !----------------------------------------------------------------------- call MIESCT(FJ,FJT,FJB,POMEGA,FZ,ZTAU,ZFLUX,RFL,U0,ND) @@ -1485,7 +1485,7 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & ! L2L = JNDLEV(L) ! LZ = ND+2 - 2*L2L ! FJACT(L,K) = 4.d0*FJ(LZ,K) + FZ(LZ,K) -! enddo +! end do !---mean intensity averaged throughout layer: do L = 1,LU @@ -1494,7 +1494,7 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & LZ1 = ND+2 - 2*JNELEV(L-1) else LZ1 = ND - endif + end if SUMJ = (4.d0*FJ(LZ0,K)+FZ(LZ0,K))*(ZTAU(LZ0+2,K)-ZTAU(LZ0,K)) & +(4.d0*FJ(LZ1,K)+FZ(LZ1,K))*(ZTAU(LZ1,K)-ZTAU(LZ1-2,K)) SUMT = ZTAU(LZ0+2,K)-ZTAU(LZ0,K) + ZTAU(LZ1,K)-ZTAU(LZ1-2,K) @@ -1502,9 +1502,9 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & do LZ = LZ0+2,LZ1-2,2 SUMJ =SUMJ+(4.d0*FJ(LZ,K)+FZ(LZ,K))*(ZTAU(LZ+2,K)-ZTAU(LZ-2,K)) SUMT =SUMT + ZTAU(LZ+2,K)-ZTAU(LZ-2,K) - enddo + end do FJACT(L,K) = SUMJ/SUMT - enddo + end do !---mean diffuse flux: 4 (not solar) at top of layer L !--- average (tau-wtd) the h's just above and below the L-edge @@ -1513,14 +1513,14 @@ subroutine OPMIE (DTAUX,POMEGAX,U0,RFL,AMF2,JXTRA, & LZ = ND+2 - 2*L2L FJFLX0 = (ZTAU(LZ+1,K)-ZTAU(LZ,K))/(ZTAU(LZ+1,K)-ZTAU(LZ-1,K)) FJFLX(L,K)=4.d0*(FJ(LZ-1,K)*FJFLX0 + FJ(LZ+1,K)*(1.d0-FJFLX0)) - enddo + end do !---diffuse fluxes reflected at top, incident at bottom FJTOP(K) = FJT(K) FJBOT(K) = FJB(K) - endif - enddo ! wavelength loop! + end if + end do ! wavelength loop! END SUBROUTINE OPMIE @@ -1557,13 +1557,13 @@ subroutine MIESCT(FJ,FJT,FJB, POMEGA,FZ,ZTAU,ZFLUX,RFL,U0,ND) call LEGND0 (EMU(I),PM0,M2_) do IM = 1,M2_ PM(I,IM) = PM0(IM) - enddo - enddo + end do + end do call LEGND0 (-U0,PM0,M2_) do IM=1,M2_ PM0(IM) = 0.25d0*PM0(IM) - enddo + end do !---BLKSLV now called with all the wavelength arrays (K=1:W_) @@ -1589,7 +1589,7 @@ subroutine LEGND0 (X,PL,N) do I = 3,N DEN = (I-1) PL(I) = PL(I-1)*X*(2.d0-1.0/DEN) - PL(I-2)*(1.d0-1.d0/DEN) - enddo + end do END SUBROUTINE LEGND0 @@ -1622,8 +1622,8 @@ subroutine BLKSLV & call GEN_ID (POMEGA(1,1,K),FZ(1,K),ZTAU(1,K),ZFLUX(K),RFL(K), & PM,PM0, B(1,1,1,K),CC(1,1,1,K),AA(1,1,1,K), & A(1,1,K),H(1,1,K),C(1,1,K), ND) - endif - enddo + end if + end do do K = 1,W_ if (FL(K) .gt. 1.0d0) then @@ -1632,8 +1632,8 @@ subroutine BLKSLV & do J = 1,M_ do I = 1,M_ E(I,J) = B(I,J,1,K) - enddo - enddo + end do + end do !---setup L & U matrices E(2,1) = E(2,1)/E(1,1) @@ -1684,10 +1684,10 @@ subroutine BLKSLV & do I = 1,M_ DD(I,J,1,K) = -E(I,1)*CC(1,J,1,K)-E(I,2)*CC(2,J,1,K) & -E(I,3)*CC(3,J,1,K)-E(I,4)*CC(4,J,1,K) - enddo + end do RR(J,1,K) = E(J,1)*H(1,1,K)+E(J,2)*H(2,1,K) & +E(J,3)*H(3,1,K)+E(J,4)*H(4,1,K) - enddo + end do !----------CONTINUE THROUGH ALL DEPTH POINTS ID=2 TO ID=ND-1 do L = 2,ND-1 @@ -1695,15 +1695,15 @@ subroutine BLKSLV & do J = 1,M_ do I = 1,M_ B(I,J,L,K) = B(I,J,L,K) + A(I,L,K)*DD(I,J,L-1,K) - enddo + end do H(J,L,K) = H(J,L,K) - A(J,L,K)*RR(J,L-1,K) - enddo + end do do J = 1,M_ do I = 1,M_ E(I,J) = B(I,J,L,K) - enddo - enddo + end do + end do !---setup L & U matrices E(2,1) = E(2,1)/E(1,1) @@ -1753,12 +1753,12 @@ subroutine BLKSLV & do J = 1,M_ do I = 1,M_ DD(I,J,L,K) = - E(I,J)*C(J,L,K) - enddo + end do RR(J,L,K) = E(J,1)*H(1,L,K)+E(J,2)*H(2,L,K) & + E(J,3)*H(3,L,K)+E(J,4)*H(4,L,K) - enddo + end do - enddo + end do !---------FINAL DEPTH POINT: L=ND L = ND @@ -1767,17 +1767,17 @@ subroutine BLKSLV & B(I,J,L,K) = B(I,J,L,K) & + AA(I,1,L,K)*DD(1,J,L-1,K) + AA(I,2,L,K)*DD(2,J,L-1,K) & + AA(I,3,L,K)*DD(3,J,L-1,K) + AA(I,4,L,K)*DD(4,J,L-1,K) - enddo + end do H(J,L,K) = H(J,L,K) & - AA(J,1,L,K)*RR(1,L-1,K) - AA(J,2,L,K)*RR(2,L-1,K) & - AA(J,3,L,K)*RR(3,L-1,K) - AA(J,4,L,K)*RR(4,L-1,K) - enddo + end do do J = 1,M_ do I = 1,M_ E(I,J) = B(I,J,L,K) - enddo - enddo + end do + end do !---setup L & U matrices E(2,1) = E(2,1)/E(1,1) @@ -1827,7 +1827,7 @@ subroutine BLKSLV & do J = 1,M_ RR(J,L,K) = E(J,1)*H(1,L,K)+E(J,2)*H(2,L,K) & +E(J,3)*H(3,L,K)+E(J,4)*H(4,L,K) - enddo + end do !-----------BACK SOLUTION do L = ND-1,1,-1 @@ -1835,18 +1835,18 @@ subroutine BLKSLV & RR(J,L,K) = RR(J,L,K) & + DD(J,1,L,K)*RR(1,L+1,K) + DD(J,2,L,K)*RR(2,L+1,K) & + DD(J,3,L,K)*RR(3,L+1,K) + DD(J,4,L,K)*RR(4,L+1,K) - enddo - enddo + end do + end do !----------mean J & H do L = 1,ND,2 FJ(L,K) = RR(1,L,K)*WT(1) + RR(2,L,K)*WT(2) & + RR(3,L,K)*WT(3) + RR(4,L,K)*WT(4) - enddo + end do do L = 2,ND,2 FJ(L,K) = RR(1,L,K)*WT(1)*EMU(1) + RR(2,L,K)*WT(2)*EMU(2) & + RR(3,L,K)*WT(3)*EMU(3) + RR(4,L,K)*WT(4)*EMU(4) - enddo + end do !---FJTOP = scaled diffuse flux out top-of-atmosphere (limit = mu0) !---FJBOT = scaled diffuse flux onto surface: @@ -1861,8 +1861,8 @@ subroutine BLKSLV & FJTOP(K) = 4.d0*SUMT FJBOT(K) = 4.d0*SUMB - SUMBX - endif - enddo + end if + end do END SUBROUTINE BLKSLV @@ -1909,7 +1909,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & + POMEGA(6,L2)*PM(I,6)*PM0(6) + POMEGA(8,L2)*PM(I,8)*PM0(8) H(I,L1) = 0.5d0*(SUM0*FZ(L1) + SUM2*FZ(L2)) A(I,L1) = 0.5d0*(SUM1*FZ(L1) + SUM3*FZ(L2)) - enddo + end do do I = 1,M_ do J = 1,I @@ -1933,8 +1933,8 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & V(J,I) = - SUM3*WT(I) B(I,J,L1) = - 0.5d0*(SUM0 + SUM2)*WT(J) B(J,I,L1) = - 0.5d0*(SUM0 + SUM2)*WT(I) - enddo - enddo + end do + end do do I = 1,M_ S(I,I) = S(I,I) + 1.0d0 @@ -1944,7 +1944,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & C(I,L1)= S(I,1)*A(1,L1)/EMU(1) + S(I,2)*A(2,L1)/EMU(2) & + S(I,3)*A(3,L1)/EMU(3) + S(I,4)*A(4,L1)/EMU(4) - enddo + end do do I = 1,M_ do J = 1,M_ @@ -1952,8 +1952,8 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & + S(J,3)*T(3,I)/EMU(3) + S(J,4)*T(4,I)/EMU(4) U(J,I) = S(J,1)*V(1,I)/EMU(1) + S(J,2)*V(2,I)/EMU(2) & + S(J,3)*V(3,I)/EMU(3) + S(J,4)*V(4,I)/EMU(4) - enddo - enddo + end do + end do !-------------upper boundary, 2nd-order, C-matrix is full (CC) DELTAU = ZTAU(L2) - ZTAU(L1) D2 = 0.25d0*DELTAU @@ -1961,15 +1961,15 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & do J = 1,M_ B(I,J,L1) = B(I,J,L1) + D2*W(I,J) CC(I,J,L1) = D2*U(I,J) - enddo + end do H(I,L1) = H(I,L1) + 2.0d0*D2*C(I,L1) A(I,L1) = 0.0d0 - enddo + end do do I = 1,M_ D1 = EMU(I)/DELTAU B(I,I,L1) = B(I,I,L1) + D1 CC(I,I,L1) = CC(I,I,L1) - D1 - enddo + end do !------------intermediate points: can be even or odd, A & C diagonal !---mid-layer h-points, Legendre terms 2,4,6,8 @@ -1981,7 +1981,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & H(I,LL) = FZ(LL)*( & POMEGA(2,LL)*PM(I,2)*PM0(2) + POMEGA(4,LL)*PM(I,4)*PM0(4) & + POMEGA(6,LL)*PM(I,6)*PM0(6) + POMEGA(8,LL)*PM(I,8)*PM0(8)) - enddo + end do do I = 1,M_ do J=1,I SUM0 = & @@ -1989,12 +1989,12 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & +POMEGA(6,LL)*PM(I,6)*PM(J,6) + POMEGA(8,LL)*PM(I,8)*PM(J,8) B(I,J,LL) = - SUM0*WT(J) B(J,I,LL) = - SUM0*WT(I) - enddo - enddo + end do + end do do I = 1,M_ B(I,I,LL) = B(I,I,LL) + 1.0d0 - enddo - enddo + end do + end do !---odd-layer j-points, Legendre terms 1,3,5,7 do LL=3,ND-2,2 @@ -2005,7 +2005,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & H(I,LL) = FZ(LL)*( & POMEGA(1,LL)*PM(I,1)*PM0(1) + POMEGA(3,LL)*PM(I,3)*PM0(3) & + POMEGA(5,LL)*PM(I,5)*PM0(5) + POMEGA(7,LL)*PM(I,7)*PM0(7)) - enddo + end do do I = 1,M_ do J=1,I SUM0 = & @@ -2013,12 +2013,12 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & +POMEGA(5,LL)*PM(I,5)*PM(J,5) + POMEGA(7,LL)*PM(I,7)*PM(J,7) B(I,J,LL) = - SUM0*WT(J) B(J,I,LL) = - SUM0*WT(I) - enddo - enddo + end do + end do do I = 1,M_ B(I,I,LL) = B(I,I,LL) + 1.0d0 - enddo - enddo + end do + end do !---------lower boundary: 2nd-order terms L1 = ND @@ -2038,7 +2038,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & + POMEGA(6,L2)*PM(I,6)*PM0(6) + POMEGA(8,L2)*PM(I,8)*PM0(8) H(I,L1) = 0.5d0*(SUM0*FZ(L1) + SUM2*FZ(L2)) A(I,L1) = 0.5d0*(SUM1*FZ(L1) + SUM3*FZ(L2)) - enddo + end do do I = 1,M_ do J = 1,I @@ -2062,8 +2062,8 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & V(J,I) = - SUM3*WT(I) B(I,J,L1) = - 0.5d0*(SUM0 + SUM2)*WT(J) B(J,I,L1) = - 0.5d0*(SUM0 + SUM2)*WT(I) - enddo - enddo + end do + end do do I = 1,M_ S(I,I) = S(I,I) + 1.0d0 @@ -2073,7 +2073,7 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & C(I,L1)= S(I,1)*A(1,L1)/EMU(1) + S(I,2)*A(2,L1)/EMU(2) & + S(I,3)*A(3,L1)/EMU(3) + S(I,4)*A(4,L1)/EMU(4) - enddo + end do do I = 1,M_ do J = 1,M_ @@ -2081,8 +2081,8 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & + S(J,3)*T(3,I)/EMU(3) + S(J,4)*T(4,I)/EMU(4) U(J,I) = S(J,1)*V(1,I)/EMU(1) + S(J,2)*V(2,I)/EMU(2) & + S(J,3)*V(3,I)/EMU(3) + S(J,4)*V(4,I)/EMU(4) - enddo - enddo + end do + end do !------------lower boundary, 2nd-order, A-matrix is full (AA) DELTAU = ZTAU(L1) - ZTAU(L2) @@ -2095,16 +2095,16 @@ subroutine GEN_ID(POMEGA,FZ,ZTAU,ZFLUX,RFL,PM,PM0 & do J = 1,M_ AA(I,J,L1) = - D2*U(I,J) B(I,J,L1) = B(I,J,L1) + D2*W(I,J) - SUM1*EMU(J)*WT(J) - enddo + end do H(I,L1) = H(I,L1) - 2.0d0*D2*C(I,L1) + SUM0*ZFLUX - enddo + end do do I = 1,M_ D1 = EMU(I)/DELTAU AA(I,I,L1) = AA(I,I,L1) + D1 B(I,I,L1) = B(I,I,L1) + D1 C(I,L1) = 0.0d0 - enddo + end do END SUBROUTINE GEN_ID @@ -2146,7 +2146,7 @@ subroutine OPTICL (OPTD,SSALB,SLEG, ODCLD,NDCLD) !---default cloud type C1, Reff = 12 microns if (NDCLD .lt. 1 .or. NDCLD .gt. 9) then NDCLD = 3 - endif + end if !--rescale OD by Qext at 600 nm (J=4) do J=1,5 @@ -2154,8 +2154,8 @@ subroutine OPTICL (OPTD,SSALB,SLEG, ODCLD,NDCLD) SSALB(J) = SCC(J,NDCLD) do I=1,8 SLEG(I,J) = PCC(I,J,NDCLD) - enddo - enddo + end do + end do END SUBROUTINE OPTICL @@ -2200,7 +2200,7 @@ subroutine OPTICA (OPTD,SSALB,SLEG, PATH,RELH,K) if (K .gt. NAA .or. K .lt. 1) then write(6,*) ' aerosol index out-of-range: K/NAA',K,NAA K = 18 - endif + end if REFF = RAA(K) RHO = DAA(K) @@ -2211,8 +2211,8 @@ subroutine OPTICA (OPTD,SSALB,SLEG, PATH,RELH,K) SSALB(J) = SAA(J,K) do I=1,8 SLEG(I,J) = PAA(I,J,K) - enddo - enddo + end do + end do END SUBROUTINE OPTICA @@ -2247,7 +2247,7 @@ subroutine OPTICM (OPTD,SSALB,SLEG, PATH,RELH,LL) if (L .lt. 1 .or. L .gt. 33) then !ccc write(6,*) ' UM aer index too large: L',L L = 1 - endif + end if !---pick nearest Relative Humidity KR = 20.d0*RELH + 1.5d0 @@ -2266,7 +2266,7 @@ subroutine OPTICM (OPTD,SSALB,SLEG, PATH,RELH,LL) SLEG(6,J) = 11.d0*GCOS**5 SLEG(7,J) = 13.d0*GCOS**6 SLEG(8,J) = 15.d0*GCOS**7 - enddo + end do END SUBROUTINE OPTICM @@ -2295,7 +2295,7 @@ subroutine JRATET(PPJ,TTJ,FFF, VALJL,LU,L_SIZE,NJXU) if (NJXU .lt. NJX) then call EXITC(' JRATET: CTM has not enough J-values dimensioned') - endif + end if do L = 1,LU !---need temperature, pressure, and density at mid-layer (for some quantum yields): TT = TTJ(L) @@ -2303,7 +2303,7 @@ subroutine JRATET(PPJ,TTJ,FFF, VALJL,LU,L_SIZE,NJXU) PP = PPJ(1) else PP = (PPJ(L)+PPJ(L+1))*0.5d0 - endif + end if DD = 7.24e18*PP/TT !---if W_=18/12, must zero bin-11/5 below 100 hPa, since O2 e-fold is too weak @@ -2313,12 +2313,12 @@ subroutine JRATET(PPJ,TTJ,FFF, VALJL,LU,L_SIZE,NJXU) FFF(11,L) = 0.d0 elseif (W_ .eq. 12) then FFF(5,L) = 0.d0 - endif - endif + end if + end if do J = 1,NJX VALJ(J) = 0.d0 - enddo + end do do K = 1,W_ call X_interp (TT,QO2TOT, TQQ(1,1),QO2(K,1), & @@ -2331,7 +2331,7 @@ subroutine JRATET(PPJ,TTJ,FFF, VALJL,LU,L_SIZE,NJXU) VALJ(1) = VALJ(1) + QO2TOT*FFF(K,L) VALJ(2) = VALJ(2) + QO3TOT*FFF(K,L) VALJ(3) = VALJ(3) + QO31D*FFF(K,L) - enddo + end do do J = 4,NJX do K = 1,W_ @@ -2342,16 +2342,16 @@ subroutine JRATET(PPJ,TTJ,FFF, VALJL,LU,L_SIZE,NJXU) else call X_interp (TT,QQQT, TQQ(1,J),QQQ(K,1,J), & TQQ(2,J),QQQ(K,2,J), TQQ(3,J),QQQ(K,3,J), LQQ(J)) - endif + end if VALJ(J) = VALJ(J) + QQQT*FFF(K,L) - enddo - enddo + end do + end do do J=1,NJX VALJL(L,J) = VALJ(J) - enddo + end do - enddo + end do END SUBROUTINE JRATET @@ -2381,8 +2381,8 @@ subroutine X_interp (TINT,XINT, T1,X1, T2,X2, T3,X3, L123) else TFACT = max(0.d0,min(1.d0,(TINT-T2)/(T3-T2) )) XINT = X2 + TFACT*(X3 - X2) - endif - endif + end if + end if END SUBROUTINE X_interp @@ -2428,7 +2428,7 @@ subroutine JP_ATM(PPJ,TTJ,DDJ,OOJ,ZZJ,DTAU6,POMEG6,JXTRA,LU) ! COLO2,COLO3,DTAU6(L),POMEG6(1,L),POMEG6(2,L)/3.d0, & ! JXTRA(L+L),JXTRA(L+L-1) - enddo + end do END SUBROUTINE JP_ATM @@ -2465,7 +2465,7 @@ subroutine JP_ATM0(PPJ,TTJ,DDJ,OOJ,ZZJ, LU) ! write(6,'(1x,i3,0p,f6.2,f10.3,f7.2,1p,4e9.2,0p,f10.4,2f8.5,2i3)') & ! L,ZKM,PPJ(L),TTJ(L),DDJ(L)/DELZ,OOJ(L)/DELZ, & ! COLO2,COLO3 - enddo + end do END SUBROUTINE JP_ATM0 @@ -2518,12 +2518,12 @@ subroutine SPHERE2(U0,RAD,ZHL,ZZHT,AMF2, L1U,LJX1U) if (L1U .gt. LSPH_) then call EXITC(' SPHERE2: temp arrays not large enough') - endif + end if RZ(1) = RAD + ZHL(1) do II = 2,L1U+1 RZ(II) = RAD + ZHL(II) - enddo + end do !---calculate heights for edges of split CTM-layers L2 = 2*L1U @@ -2531,18 +2531,18 @@ subroutine SPHERE2(U0,RAD,ZHL,ZZHT,AMF2, L1U,LJX1U) I = II/2 RZ2(II-1) = RZ(I) RZ2(II) = 0.5d0*(RZ(I)+RZ(I+1)) - enddo + end do RZ2(L2+1) = RZ(L1U+1) do II = 1,L2 RQ2(II) = (RZ2(II)/RZ2(II+1))**2 - enddo + end do !---shadow height for SZA > 90 if (U0 .lt. 0.0d0) then SHADHT = RZ2(1)/dsqrt(1.0d0 - U0**2) else SHADHT = 0.d0 - endif + end if !---up from the surface calculating the slant paths between each level !--- and the level above, and deriving the appropriate Air Mass Factor @@ -2559,7 +2559,7 @@ subroutine SPHERE2(U0,RAD,ZHL,ZZHT,AMF2, L1U,LJX1U) XL = RZ2(I+1)*XMU2 - RZ2(I)*XMU1 AMF2(I,J) = XL / (RZ2(I+1)-RZ2(I)) XMU1 = XMU2 - enddo + end do !--fix above top-of-atmos (L=L1U+1), must set DTAU(L1U+1)=0 AMF2(2*L1U+1,J) = 1.d0 ! @@ -2582,8 +2582,8 @@ subroutine SPHERE2(U0,RAD,ZHL,ZZHT,AMF2, L1U,LJX1U) XL = RZ2(II+1)*XMU1*2.0d0 AMF2(II,J) = XL/(RZ2(II+1)-RZ2(II)) goto 16 - endif - enddo + end if + end do 16 continue @@ -2658,8 +2658,8 @@ subroutine EXTRAL(DTAUX,L1X,L2X,NX,JTAUMX,ATAU,ATAU0, JXTRA) ATAUM = max(ATAU0, TTAU(L2+1)) ATAUN1 = log(TTAU(L2)/ATAUM) / ATAULN JXTRA(L2) = min(JTAUMX, max(0, int(ATAUN1 - 0.5d0))) - endif - enddo + end if + end do !---check on overflow of arrays, cut off JXTRA at lower L if too many levels JTOTL = L2X + 2 @@ -2669,10 +2669,10 @@ subroutine EXTRAL(DTAUX,L1X,L2X,NX,JTAUMX,ATAU,ATAU0, JXTRA) ! write(6,'(A,2I5,F9.2)') 'N_/L2_/L2-cutoff JXTRA:',NX,L2X,L2 do L = L2,1,-1 JXTRA(L) = 0 - enddo + end do go to 10 - endif - enddo + end if + end do 10 continue END SUBROUTINE EXTRAL @@ -2736,7 +2736,7 @@ subroutine INIT_FJX (TITLEJXX,NJXU,NJXX) if (W_.ne.8 .and. W_.ne.12 .and. W_.ne.18) then call EXITC(' INIT_JX: invalid no. wavelengths') - endif + end if ! Use channel 8 to read fastJX data files: JXUNIT = 8 @@ -2757,7 +2757,7 @@ subroutine INIT_FJX (TITLEJXX,NJXU,NJXX) NJXX = NJX do J = 1,NJX TITLEJXX(J) = TITLEJX(J) - enddo + end do ! Read in photolysis rates used in chemistry code and mapping onto FJX J's !---CTM call: read in J-values names and link to fast-JX names @@ -2864,11 +2864,11 @@ subroutine RD_XXX(NUN,NAMFIL) if (W_.eq.18 .or. TSTRAT.ne.'x') then if (TITLEJ2 .ne. TITLEJX(JJ)) then JJ = JJ+1 - + if (JJ .gt. X_) then call EXITC(' RD_XXX: X_ not large enough for Xsects read in') - endif - + end if + TITLEJX(JJ) = TITLEJ2 LQQ(JJ) = 1 SQQ(JJ) = TSTRAT @@ -2876,7 +2876,7 @@ subroutine RD_XXX(NUN,NAMFIL) TQQ(LQ,JJ) = TQQ2 do IW = 1,NWWW QQQ(IW,LQ,JJ) = QQ2(IW) - enddo + end do else LQQ(JJ) = LQQ(JJ)+1 if (LQQ(JJ) .le. 3) then @@ -2884,11 +2884,11 @@ subroutine RD_XXX(NUN,NAMFIL) TQQ(LQ,JJ) = TQQ2 do IW = 1,NWWW QQQ(IW,LQ,JJ) = QQ2(IW) - enddo - endif - endif - endif - enddo + end do + end if + end if + end if + end do 1 continue NJX = JJ @@ -2898,17 +2898,17 @@ subroutine RD_XXX(NUN,NAMFIL) if (LQQ(J) .eq. 3) then if (TQQ(2,J) .ge. TQQ(3,J)) then call EXITC ('TQQ out of order') - endif + end if if (TQQ(1,J) .ge. TQQ(2,J)) then call EXITC ('TQQ out of order') - endif - endif + end if + end if if (LQQ(J) .eq. 2) then if (TQQ(1,J) .ge. TQQ(2,J)) then call EXITC ('TQQ out of order') - endif - endif - enddo + end if + end if + end do !---check on doingpressure interp !---check on consolidating Qo2 and others into @@ -2930,12 +2930,12 @@ subroutine RD_XXX(NUN,NAMFIL) QO2(IW,K) = QO2(IW+4,K) QO3(IW,K) = QO3(IW+4,K) Q1D(IW,K) = Q1D(IW+4,K) - enddo + end do do J = 4,NJX QQQ(IW,1,J) = QQQ(IW+4,1,J) QQQ(IW,2,J) = QQQ(IW+4,2,J) - enddo - enddo + end do + end do do IW = 5,12 WL(IW) = WL(IW+6) FL(IW) = FL(IW+6) @@ -2944,12 +2944,12 @@ subroutine RD_XXX(NUN,NAMFIL) QO2(IW,K) = QO2(IW+6,K) QO3(IW,K) = QO3(IW+6,K) Q1D(IW,K) = Q1D(IW+6,K) - enddo + end do do J = 4,NJX QQQ(IW,1,J) = QQQ(IW+6,1,J) QQQ(IW,2,J) = QQQ(IW+6,2,J) - enddo - enddo + end do + end do !---TROP-QUICK (must scale solar flux for W=5) elseif (W_ .eq. 8) then ! write(6,'(a)') & @@ -2963,12 +2963,12 @@ subroutine RD_XXX(NUN,NAMFIL) QO2(IW,K) = QO2(IW+4,K) QO3(IW,K) = QO3(IW+4,K) Q1D(IW,K) = Q1D(IW+4,K) - enddo + end do do J = 4,NJX QQQ(IW,1,J) = QQQ(IW+4,1,J) QQQ(IW,2,J) = QQQ(IW+4,2,J) - enddo - enddo + end do + end do do IW = 2,8 WL(IW) = WL(IW+10) FL(IW) = FL(IW+10) @@ -2977,17 +2977,17 @@ subroutine RD_XXX(NUN,NAMFIL) QO2(IW,K) = QO2(IW+10,K) QO3(IW,K) = QO3(IW+10,K) Q1D(IW,K) = Q1D(IW+10,K) - enddo + end do do J = 4,NJX QQQ(IW,1,J) = QQQ(IW+10,1,J) QQQ(IW,2,J) = QQQ(IW+10,2,J) - enddo - enddo + end do + end do else call EXITC(' no. wavelengths wrong: W_ .ne. 8,12,18') - endif - endif + end if + end if close(NUN) @@ -2996,10 +2996,6 @@ subroutine RD_XXX(NUN,NAMFIL) 102 format(10x, 6e10.3/(10x,6e10.3)/(10x,6e10.3)) 103 format(a6,1x,f3.0,6e10.3/(10x,6e10.3)/(10x,6e10.3)) 104 format(a6,a1,f3.0,6e10.3/(10x,6e10.3)/(10x,6e10.3)) - 200 format(1x,' x-sect:',i3,a10,a4,i5,3(3x,f6.2)) - 201 format(' Number of x-sections supplied to Fast-J2: ',i3,/, & - ' Maximum number allowed (X_) only set to: ',i3, & - ' - increase in cmn_FJX.f') END SUBROUTINE RD_XXX @@ -3034,7 +3030,7 @@ subroutine RD_CLD(NUN,NAMFIL) read (NUN,'(i2,a78)') NCC,TITLE0 if (NCC .gt. C_) then call EXITC(' too many cld-data sets: NCC > C_') - endif + end if ! write(6,'(a,2f9.5,i5)') ' ATAU/ATAU0/JMX',ATAU,ATAU0,JTAUMX @@ -3046,8 +3042,8 @@ subroutine RD_CLD(NUN,NAMFIL) read (NUN,'(f4.0,f7.4,f7.4,7f6.3)') & WCC(K,J),QCC(K,J),SCC(K,J),(PCC(I,K,J),I=2,8) PCC(1,K,J) = 1.d0 - enddo - enddo + end do + end do close(NUN) @@ -3057,7 +3053,7 @@ subroutine RD_CLD(NUN,NAMFIL) do J=1,NCC ! write(6,'(i3,1x,a8,7f8.3)') & ! J,TITLAA(J),RCC(J),DCC(J),(QCC(K,J),K=1,5) - enddo + end do END SUBROUTINE RD_CLD @@ -3092,7 +3088,7 @@ subroutine RD_MIE(NUN,NAMFIL) read (NUN,'(i2,a78)') NAA,TITLE0 if (NAA .gt. A_) then call EXITC(' too many aerosol-data sets: NAA > A_') - endif + end if ! write(6,'(a,2f9.5,i5)') ' ATAU/ATAU0/JMX',ATAU,ATAU0,JTAUMX @@ -3104,8 +3100,8 @@ subroutine RD_MIE(NUN,NAMFIL) read (NUN,'(f4.0,f7.4,f7.4,7f6.3)') & WAA(K,J),QAA(K,J),SAA(K,J),(PAA(I,K,J),I=2,8) PAA(1,K,J) = 1.d0 - enddo - enddo + end do + end do close(NUN) @@ -3115,7 +3111,7 @@ subroutine RD_MIE(NUN,NAMFIL) do J=1,NAA ! write(6,'(i3,1x,a8,7f8.3)') & ! J,TITLAA(J),RAA(J),DAA(J),(QAA(K,J),K=1,5) - enddo + end do END SUBROUTINE RD_MIE @@ -3153,8 +3149,8 @@ subroutine RD_UM(NUN,NAMFIL) !---6 wavelengths: J=1=200nm, 2=300nm, 3=400nm, (4'=550nm) 5=600nm, 6=1000nm !---3 optic vars: I=1=SSAlbedo, =2=g, =3=k-ext read(NUN,'(18f9.5)') ((UMAER(I,J,K,L),I=1,3),J=1,6) - enddo - enddo + end do + end do close(NUN) @@ -3166,9 +3162,9 @@ subroutine RD_UM(NUN,NAMFIL) do I=1,3 UMAER(I,4,K,L) = UMAER(I,5,K,L) UMAER(I,5,K,L) = UMAER(I,6,K,L) - enddo - enddo - enddo + end do + end do + end do ! write(6,'(7(i5,1x,a4))') (L,TITLUM(L), L=1,33) @@ -3202,7 +3198,7 @@ subroutine RD_PROF(NJ2,NAMFIL) L = min(18, max(1, (LAT+95)/10)) read (NJ2,'(3X,11F7.1)') (TREF(I,L,M), I=1,41) read (NJ2,'(3X,11F7.4)') (OREF(I,L,M), I=1,31) - enddo + end do close (NJ2) ! Extend climatology to 100 km @@ -3212,18 +3208,17 @@ subroutine RD_PROF(NJ2,NAMFIL) do M = 1,NTMONS do L = 1,NTLATS OREF(I,L,M) = OREF(31,L,M)*OFAK - enddo - enddo - enddo + end do + end do + end do do L = 1,NTLATS do M = 1,NTMONS do I = 42,51 TREF(I,L,M) = TREF(41,L,M) - enddo - enddo - enddo + end do + end do + end do - 1000 format(1x,'std atmos profiles: ',i3,' lat x ',i2,' mon') END SUBROUTINE RD_PROF @@ -3276,7 +3271,7 @@ subroutine RD_JS_JX(NUNIT,NAMFIL,TITLEJX,NJX) JFACTA(JJ) = F_FJX JMAP(JJ) = T_FJX NRATJ = JJ - enddo + end do 20 close(NUNIT) @@ -3287,9 +3282,9 @@ subroutine RD_JS_JX(NUNIT,NAMFIL,TITLEJX,NJX) T_FJX = TITLEJX(J) if (JMAP(K) .eq. TITLEJX(J)) then JIND(K)=J - endif - enddo - enddo + end if + end do + end do ! if(.false.)then ! write(6,'(a,i4,a)')' Photochemistry Scheme with',NRATJ,' J-values' do K=1,NRATJ @@ -3301,10 +3296,10 @@ subroutine RD_JS_JX(NUNIT,NAMFIL,TITLEJX,NJX) else ! write(6,'(i5,a50,f6.3,a,i4,1x,a6)') K,JLABEL(K),JFACTA(K), & ! ' mapped to FJX:',J,TITLEJX(J) - endif - endif - enddo -! endif + end if + end if + end do +! end if END SUBROUTINE RD_JS_JX @@ -3317,13 +3312,13 @@ module FastJ_ml use LandDefs_ml, only: LandType, LandDefs use Landuse_ml, only: LandCover use MetFields_ml, only : ps ,foundcloudwater,q,th,lwc,cc3dmax - use ModelConstants_ml, only : KMAX_BND,KMAX_MID,KCHEMTOP, METSTEP + use ModelConstants_ml, only : KMAX_BND,KMAX_MID,KCHEMTOP, METSTEP use NetCDF_ml, only :ReadField_CDF use Par_ml, only: me,LIMAX, LJMAX - use PhysicalConstants_ml, only :KAPPA, RGAS_KG, GRAV + use PhysicalConstants_ml, only :KAPPA, RGAS_KG, GRAV use Radiation_ml, only : ZenithAngleS,ZenithAngle use TimeDate_ml, only : daynumber,current_date - + USE FJX_CMN_MOD USE FJX_SUB_MOD @@ -3389,10 +3384,10 @@ subroutine phot_fastj_interpolate(i_emep,j_emep,errcode) integer, intent(in) ::i_emep,j_emep integer, intent(inout) ::errcode logical, save::first_call=.true. - + real*8 :: weight1,weight2, y, y1, y2, Z, CosZ, latitude, longitude real*8 :: thour,thour1,thour2,YGRD,XGRD,SOLF - + !part of this could be put somewhere else (in metint and store all results in nr=1?) ! we assume the rates followe a sqrt(cos(zenithangle)) function @@ -3401,7 +3396,7 @@ subroutine phot_fastj_interpolate(i_emep,j_emep,errcode) YGRD = latitude*PI180 XGRD = longitude*PI180 thour = real(current_date%hour) + current_date%seconds/3600.0 - thour1 = int((thour+0.000001)/METSTEP)*METSTEP !last meteo time + thour1 = int((thour+0.000001)/METSTEP)*METSTEP !last meteo time thour2 = thour1 + METSTEP !next meteo time (nr=2) ! call ZenithAngleS( longitude, latitude,daynumber, 365,thour, Z, CosZ ) call SOLAR_JX(thour,daynumber,YGRD,XGRD, Z,CosZ,SOLF) @@ -3451,21 +3446,23 @@ subroutine phot_fastj_interpolate(i_emep,j_emep,errcode) !FOR TESTING if(me==-6.and.i_emep==5.and.j_emep==5)then -L=3 !NB: k=kmax_bnd-L -write(*,22)'AO3 ', rcphot(IDAO3,kmax_bnd-L) , rcphot_3D(IDAO3,kmax_bnd-L,i_emep,j_emep,1) ,rcphot_3D(IDAO3,kmax_bnd-L,i_emep,j_emep,2) -write(*,22)'BO3 ', rcphot(IDBO3,kmax_bnd-L) -write(*,22) 'NO2 ', rcphot(IDNO2,kmax_bnd-L) -write(*,22) 'H2O2 ', rcphot(IDH2O2,kmax_bnd-L) -write(*,22) 'HNO3 ', rcphot(IDHNO3,kmax_bnd-L) -write(*,22) 'ACH2O ', rcphot(IDACH2O,kmax_bnd-L) -write(*,22) 'BCH2O ', rcphot(IDBCH2O,kmax_bnd-L) -write(*,22) 'CH3CHO ', rcphot(IDCH3CHO,kmax_bnd-L) -write(*,22) 'CH3COX ', rcphot(IDCH3COX,kmax_bnd-L) -write(*,22) 'HCOHCO ', rcphot(IDHCOHCO,kmax_bnd-L) -write(*,22) 'RCOHCO ', rcphot(IDRCOHCO,kmax_bnd-L) + L=3 !NB: k=kmax_bnd-L + write(*,22)'AO3 ', rcphot(IDAO3,kmax_bnd-L) , & + rcphot_3D(IDAO3,kmax_bnd-L,i_emep,j_emep,1) ,& + rcphot_3D(IDAO3,kmax_bnd-L,i_emep,j_emep,2) + write(*,22)'BO3 ', rcphot(IDBO3,kmax_bnd-L) + write(*,22)'NO2 ', rcphot(IDNO2,kmax_bnd-L) + write(*,22)'H2O2 ', rcphot(IDH2O2,kmax_bnd-L) + write(*,22)'HNO3 ', rcphot(IDHNO3,kmax_bnd-L) + write(*,22)'ACH2O ', rcphot(IDACH2O,kmax_bnd-L) + write(*,22)'BCH2O ', rcphot(IDBCH2O,kmax_bnd-L) + write(*,22)'CH3CHO ', rcphot(IDCH3CHO,kmax_bnd-L) + write(*,22)'CH3COX ', rcphot(IDCH3COX,kmax_bnd-L) + write(*,22)'HCOHCO ', rcphot(IDHCOHCO,kmax_bnd-L) + write(*,22)'RCOHCO ', rcphot(IDRCOHCO,kmax_bnd-L) 22 format(a,15E12.4) -endif +end if end subroutine phot_fastj_interpolate !put values for rcphot for one column at (i_emep,j_emep) in the emep model @@ -3504,7 +3501,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) call INIT_FJX (TITLJXX,NJX_,NJXX) !----------------------------------------------------------------------- - endif + end if nr_local=1 @@ -3526,41 +3523,41 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) !find vertical levels in clim file !Note: The pressure at the upper levels from clim file are (almost) identical with the CTM levels - call check(nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID)) + call check(nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID)) call check(nf90_inq_dimid(ncid = ncFileID, name = "lev", dimID = dimID)) call check(nf90_inquire_dimension(ncid=ncFileID,dimID=dimID,len=Nlevel_CLIM )) if(me==0)write(*,*)'Clim number of levels ',Nlevel_CLIM - + allocate(etaa_CLIM(Nlevel_CLIM+1),etab_CLIM(Nlevel_CLIM+1)) allocate(temperature_clim(Nlevel_CLIM,LIMAX,LJMAX)) allocate(cloudliquidwater_clim(Nlevel_CLIM,LIMAX,LJMAX)) allocate(humidity_clim(Nlevel_CLIM,LIMAX,LJMAX)) allocate(o3_clim(Nlevel_CLIM,LIMAX,LJMAX)) allocate(rcphot_3D(NRCPHOT,KCHEMTOP:KMAX_MID,LIMAX,LJMAX,2)) - - call check(nf90_inq_varid(ncid = ncFileID, name = "P0", varID = varID)) + + call check(nf90_inq_varid(ncid = ncFileID, name = "P0", varID = varID)) call check(nf90_get_var(ncFileID, varID, P0 )) - call check(nf90_inq_varid(ncid = ncFileID, name = "hyai", varID = varID)) + call check(nf90_inq_varid(ncid = ncFileID, name = "hyai", varID = varID)) call check(nf90_get_var(ncFileID, varID, etaa_CLIM )) !(clim file uses: P=hyai*101325.0+hybi*PS) etaa_CLIM=P0*etaa_CLIM!different definition in model and grid_Def - call check(nf90_inq_varid(ncid = ncFileID, name = "hybi", varID = varID)) - call check(nf90_get_var(ncFileID, varID, etab_CLIM )) + call check(nf90_inq_varid(ncid = ncFileID, name = "hybi", varID = varID)) + call check(nf90_get_var(ncFileID, varID, etab_CLIM )) call check(nf90_close(ncFileID)) !level 1 is P=0 corresponds to "L1_+1" - + !find number of levels above emep levels. !find first level with pressure at least 100 Pa smaller than topp emep level (i.e with lowest pressure) !NB: Pa here (not hPa) do L_CLIM=Nlevel_CLIM+1,1,-1 if((etaa_CLIM(L_CLIM)+ETAB_CLIM(L_CLIM)*110000.0)< A_bnd(1)+B_bnd(1)*110000.0-100.0)exit - enddo + end do L_CLIM_first=L_CLIM !Ensure that there are no possibilities for level crossing at high mountains if((etaa_CLIM(L_CLIM_first)+ETAB_CLIM(L_CLIM_first)*45000.0)> A_bnd(1)+B_bnd(1)*45000.0)then write(*,*)'LEVEL CROSSING!',L_CLIM,etaa_CLIM(L_CLIM_first)+ETAB_CLIM(L_CLIM_first)*45000.0,A_bnd(1)+B_bnd(1)*45000.0 stop - endif + end if !number of FastJ (mid) levels. L_FastJ corresponds to L1_ L_FastJ=kmax_mid+L_CLIM_first !remember in clim file L=1 is top level if(L_hPa ETAB(L) = B_bnd(k) - enddo + end do !then fill with clim levels do L_CLIM=L_CLIM_first,1,-1 L=L+1 ETAA(L) = etaa_CLIM(L_CLIM)/100.0!Pa->hPa ETAB(L) = ETAB_CLIM(L_CLIM) - enddo + end do if(me==0)write(*,*)'FASTJ (standard) pressure levels' L=1 if(me==0)write(*,*)L,ETAA(L)+ETAB(L)*1013.25 @@ -3593,10 +3590,10 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) if(ETAA(L)+ETAB(L)*1013.25>=ETAA(L-1)+ETAB(L-1)*1013.25)then write(*,*)'1 wrong level' stop - endif - enddo - - endif + end if + end do + + end if YGRD = glat(i_emep,j_emep)*PI180 @@ -3606,7 +3603,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) do ilu= 1, LandCover(i_emep,j_emep)%ncodes lu = LandCover(i_emep,j_emep)%codes(ilu) ALBEDO = ALBEDO + LandDefs(lu)%Albedo*0.01*LandCover(i_emep,j_emep)%fraction(ilu) - enddo + end do !use fastj vertical direction, i.e. L largest at top, 1 at surface !first emep model levels @@ -3630,7 +3627,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) if(foundcloudwater)then ! write(*,*)'CLD ',lwc(i_emep,j_emep,k)*1000*(dA(k)+dB(k)*ps(i_emep,j_emep,1))/GRAV,CLDP(L) CLDP(L) = lwc(i_emep,j_emep,k)*1000*(dA(k)+dB(k)*ps(i_emep,j_emep,1))/GRAV!kg/kg -> g/m2 - endif + end if ! AERSP(1:L1_,1:AN_) aerosol path (g/m2) ! second index are different types of aerosols? @@ -3640,7 +3637,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) AER2(L)=0.0 NAA2(L)=0 !aerosol type? - enddo + end do !fill upper levels with climatological values: @@ -3661,19 +3658,19 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) ,interpol='zero_order',needed=.true.,debug_flag=.false.) previous_month=month - endif + end if !NB: PPP changes because PSURF changes do L = 1,L_FastJ+1 PPP(L) = ETAA(L) + ETAB(L)*PSURF - enddo + end do ! PPP(L_FastJ+1+1)=0.0! intergalactical altitude !start from topp L_CLIM = 0 do L=L_FastJ,kmax_mid+1,-1 L_CLIM = L_CLIM+1 - TI(L) = temperature_clim(L_CLIM,i_emep,j_emep) + TI(L) = temperature_clim(L_CLIM,i_emep,j_emep) swp=611.2*exp(17.67*(TI(L)-273.15)/(TI(L)-29.65))!saturation water pressure in Pa ! write(*,*)'humidity ',q(i_emep,j_emep,kmid,1)*(Pres_mid)/0.622 /swp,RI(L) RI(L) = humidity_clim(L_CLIM,i_emep,j_emep)*100*0.5*(PPP(L)+PPP(L-1))/0.622 /swp @@ -3683,7 +3680,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) etaa_CLIM(L_CLIM)/100+ETAB_CLIM(L_CLIM)*PSURF, ' and ',& etaa_CLIM(L_CLIM+1)/100+ETAB_CLIM(L_CLIM+1)*PSURF,' compared to intervall',PPP(L+1),' and ',PPP(L) 44 format(A,I4,A,I4,A,10(F7.2,A)) - enddo + end do !for O3 we fill also the lower levels with clim values !should fill with emep instantaneous values? climatological are more robust. @@ -3692,10 +3689,10 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) do L=1,kmax_mid do while ((etaa_CLIM(L_CLIM)/100+ETAB_CLIM(L_CLIM)*PSURF)> PPP(L)-0.001.and.L_CLIM>1) L_CLIM = L_CLIM-1 - enddo + end do if(me==0.and.first_call)write(*,*)'taking O3 from level ',L_CLIM,L OOO(L) = o3_clim(L_CLIM,i_emep,j_emep)*(PPP(L)-PPP(L+1))*MASFAC - enddo + end do !----------------------------------------------------------------------- !---fast-JX: SOLAR_JX is called only once per grid-square to set U0, etc. @@ -3717,18 +3714,18 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) LWP(L) = CLDP(L) else IWP(L) = CLDP(L) - endif + end if NDXAER(L,1) = NAA1(L) AERSP(L,1) = AER1(L) NDXAER(L,2) = NAA2(L) AERSP(L,2) = AER2(L) - enddo + end do ZZZ(1) = 0.d0 do L = 1,L_FastJ-1 DDD(L) = (PPP(L)-PPP(L+1))*MASFAC SCALEH = 1.3806d-19*MASFAC*TTT(L) ZZZ(L+1) = ZZZ(L) -( LOG(PPP(L+1)/PPP(L)) * SCALEH ) - enddo + end do DDD(L_FastJ) = (PPP(L_FastJ)-0.0)*MASFAC ZZZ(L_FastJ+1) = ZZZ(L_FastJ) + 5.d5 REFLB = ALBEDO @@ -3751,13 +3748,13 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) IWC = max(0.001d0, IWC) REFFI(L) = 164.d0 * IWC**0.23d0 ! write(6,'(a,i3,3f10.4)') 'ICE:',L,IWP(L),IWC,REFFI(L) - endif + end if if (LWP(L) .gt. 1.d-5) then PCLD = 0.5d0*(PPP(L)+PPP(L+1)) FACTOR = min(1.d0, max(0.d0, (PCLD-610.d0)/200.d0)) REFFL(L) = 9.60d0*FACTOR + 12.68d0*(1.-FACTOR) - endif - enddo + end if + end do ! call JP_ATM0(PPP,TTT,DDD,OOO,ZZZ, L_) @@ -3781,9 +3778,9 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) ZPJ(L,J) = VALJXX(L,JIND(J))*JFACTA(J) else ZPJ(L,J) = 0.d0 - endif - enddo - enddo + end if + end do + end do !TESTING if(me==6.and.i_emep==5.and.j_emep==5)then @@ -3794,12 +3791,12 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) x=sqrt(cos(SZA*PI180))*0.00073 else x=0.0 - endif + end if write(*,*)' k=',kmax_bnd-L write(*,22)'PARAMETERS ', SZA,x,GMTAU,XGRD/PI180,YGRD/PI180!3 O3 PHOTON O2 O(total) 1.000 / write(*,22)'AO3 ', rcphot(IDAO3,kmax_bnd-L) , ZPJ(L,3), SZA,x,x**2/0.00073,x**4/0.00073/0.00073/0.00073!3 O3 PHOTON O2 O(total) 1.000 /O3 / write(*,22)'BO3 ', rcphot(IDBO3,kmax_bnd-L) , ZPJ(L,4), SZA,x*90*0.00073,x**2*90,x**4*213017751,x**6*491579426490669.0!4 O3 PHOTON O2 O(1D) 1.000 /O3(1D)/ - write(*,22) 'NO2 ', rcphot(IDNO2,kmax_bnd-L) , ZPJ(L,9),SZA,x*0.00073*27692,x**2*27692,x**4*63905325443.0!9 NO2 PHOTON N2 O 1.000 /NO2 / + write(*,22) 'NO2 ', rcphot(IDNO2,kmax_bnd-L) , ZPJ(L,9),SZA,x*0.00073*27692,x**2*27692,x**4*63905325443.0!9 NO2 PHOTON N2 O 1.000 /NO2 / write(*,22) 'H2O2 ', rcphot(IDH2O2,kmax_bnd-L) , ZPJ(L,7),SZA,x*0.00073*22.38,x**2*22.38,x**4*51656804!7 H2O2 PHOTON OH OH 1.000 /H2O2 / write(*,22) 'HNO3 ', rcphot(IDHNO3,kmax_bnd-L) , ZPJ(L,15),SZA,x*0.00073*1.846,x**2*1.846,x**4*4260355!15 HNO3 PHOTON NO2 OH 1.000 /HNO3 / write(*,22) 'ACH2O ', rcphot(IDACH2O,kmax_bnd-L) , ZPJ(L,5),SZA,x*0.00073*103.8461,x**2*103.8461,x**4*239644970!5 H2CO PHOTON HCO H 1.000 /H2COa / @@ -3807,20 +3804,22 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) write(*,22) 'CH3CHO ', rcphot(IDCH3CHO,kmax_bnd-L) , ZPJ(L,54),SZA,x*0.00073*13.84,x**2*13.84,x**4*31952662!54 CH3CHO PHOTON CH3 HCO 1.000 /ActAld/ write(*,22) 'CH3COX ', rcphot(IDCH3COX,kmax_bnd-L) , ZPJ(L,61)+ZPJ(L,62),SZA,x*0.00073*13.84,x**2*13.84,x**4*31952662!61 CH3COC2H5 PHOTON C2H5 CH3CO 0.850 /MEKeto/ !62 CH3COC2H5 PHOTON CH3 C2H5CO 0.150 /MEKeto/ ? - write(*,22) 'HCOHCO ', rcphot(IDHCOHCO,kmax_bnd-L) , ZPJ(L,66),SZA,x*0.00073*50.7692,x**2*50.7692,x**4*117159763, ZPJ(L,67),ZPJ(L,65) + write(*,22) 'HCOHCO ', rcphot(IDHCOHCO,kmax_bnd-L) , ZPJ(L,66),SZA,& + x*0.00073*50.7692,x**2*50.7692,x**4*117159763, ZPJ(L,67),ZPJ(L,65) write(*,22) 'RCOHCO ', rcphot(IDRCOHCO,kmax_bnd-L) , ZPJ(L,64),SZA,x*0.00073*576.92,x**2*576.92,x**4*1331360946.0!64 CH3COCHO PHOTON CH3CO CO 1.000 /MGlyxl/ !should add 11 and 12 or only 12? 11 NO3 PHOTON NO O2 0.114 /NO3 / - write(*,22) 'IDNO3 ', rcphot(IDNO3,kmax_bnd-L) , ZPJ(L,11)+ZPJ(L,12),SZA,x*0.00073*623076,x**2*623076,x**4*1437869822485.0!12 NO3 PHOTON NO2 O 0.886 /NO3 / + write(*,22) 'IDNO3 ', rcphot(IDNO3,kmax_bnd-L) , ZPJ(L,11)+ZPJ(L,12),SZA,& + x*0.00073*623076,x**2*623076,x**4*1437869822485.0!12 NO3 PHOTON NO2 O 0.886 /NO3 / write(*,22) 'IDCH3O2H ', rcphot(IDCH3O2H,kmax_bnd-L) , ZPJ(L,8),SZA,x*0.00073*16.6,x**2*16.6,x**4*38343195!8 CH3OOH PHOTON CH3O OH 1.000 /CH3OOH/ - endif + end if if(.not.(allocated(rcphot)))allocate(rcphot(NRCPHOT,KCHEMTOP:KMAX_MID)) !could put directly into rcphot_3D in later version do L=1,KMAX_BND-KCHEMTOP !hardcoded for now - !definitions of reactions and indices in FJX_j2j.dat + !definitions of reactions and indices in FJX_j2j.dat !example of interpretation (by PeterW!) ! 11 NO3 PHOTON NO O2 0.114 /NO3 / ! 12 NO3 PHOTON NO2 O 0.886 /NO3 / @@ -3834,7 +3833,7 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) rcphot(IDAO3,kmax_bnd-L) = ZPJ(L,3)!3 O3 PHOTON O2 O(total) 1.000 /O3 / rcphot(IDBO3,kmax_bnd-L) = ZPJ(L,4)!4 O3 PHOTON O2 O(1D) 1.000 /O3(1D)/ - rcphot(IDNO2,kmax_bnd-L) = ZPJ(L,9)!9 NO2 PHOTON N2 O 1.000 /NO2 / + rcphot(IDNO2,kmax_bnd-L) = ZPJ(L,9)!9 NO2 PHOTON N2 O 1.000 /NO2 / rcphot(IDH2O2,kmax_bnd-L) = ZPJ(L,7)!7 H2O2 PHOTON OH OH 1.000 /H2O2 / rcphot(IDHNO3,kmax_bnd-L) = ZPJ(L,15)!15 HNO3 PHOTON NO2 OH 1.000 /HNO3 / rcphot(IDACH2O,kmax_bnd-L) = ZPJ(L,5)!5 H2CO PHOTON HCO H 1.000 /H2COa / @@ -3858,11 +3857,11 @@ subroutine setup_phot_fastj(i_emep,j_emep,errcode,mode) rcphot(IDCH3O2H,kmax_bnd-L) = ZPJ(L,8)!8 CH3OOH PHOTON CH3O OH 1.000 /CH3OOH/ rcphot(IDHO2NO2,kmax_bnd-L) = ZPJ(L,16)!not used !16 HNO4 PHOTON NO2 HO2 1.000 /HNO4 / - rcphot(IDACETON,kmax_bnd-L) = ZPJ(L,68)!not used !68 CH3COCH3 PHOTON CH3CO CH3 1.000 /Acet-a/ + rcphot(IDACETON,kmax_bnd-L) = ZPJ(L,68)!not used !68 CH3COCH3 PHOTON CH3CO CH3 1.000 /Acet-a/ - enddo + end do - if(mode/=0)rcphot_3D(:,:,i_emep,j_emep,nr_local)=rcphot(:,:) + if(mode/=0)rcphot_3D(:,:,i_emep,j_emep,nr_local)=rcphot(:,:) first_call=.false. @@ -3875,8 +3874,7 @@ subroutine check(status) if(status /= nf90_noerr)then write(*,*)"Error in NetCDF fastJ " // trim( nf90_strerror(status) ) stop - endif + end if end subroutine check end module FastJ_ml - diff --git a/ForestFire_ml.f90 b/ForestFire_ml.f90 index 8cc44bf..d5a6118 100644 --- a/ForestFire_ml.f90 +++ b/ForestFire_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -107,7 +107,7 @@ module ForestFire_ml real :: unitsfac real :: frac integer :: emep -endtype bbtype +end type bbtype ! Here we include the relevant mapping file, which depends on ! the source of ffire data and the chemical mechanism (CM) @@ -132,6 +132,23 @@ module ForestFire_ml FINN_PATTERN = 'FINN_ForestFireEmis_v15_YYYY.nc',& GFAS_PATTERN = 'GFAS_ForestFireEmis_YYYY.nc' +! interpolation method in ReadField_CDF +character(len=30), save :: bbinterp = '-' + +! Notes on interpolation choices: (from NetCDF_ml) + !'zero_order' gives value at closest gridcell. Probably good enough for most + ! applications. Does not smooth out values + !'conservative' and 'mass_conservative' give smoother fields and + !are approximatively integral conservative (integral over a region is + !conserved). The initial gridcells are subdivided into smaller subcells + !and each subcell is assigned to a cell in the model grid + !'conservative' can be used for emissions given in kg/m2 (or kg/m2/s) + !or landuse or most fields. The value in the netcdf file and in + !model gridcell are of the similar. 'mass_conservative' can be used + !for emissions in kg (or kg/s). If the gricell in the model are !twice + !as small as the gridcell in the netcdf file, the values will also be + !reduced by a factor 2. + integer, save :: & verbose=1, & ! debug verbosity 0,..,4 persistence=1, & ! persistence in days @@ -156,11 +173,17 @@ subroutine Config_Fire() if(DEBUG%FORESTFIRE.and.MasterProc) write(*,*) "FIRE selects ",BBMAP select case(BBMAP) - case("GFED");persistence=8 ! 8-day records - case("FINN");persistence=1 ! 1-day records - case("GFAS");persistence=3 ! 1-day records, valid for 3 day in FORECAST mode + case("GFED") + persistence=8 ! 8-day records + bbinterp = 'conservative' + case("FINN") + persistence=1 ! 1-day records + bbinterp = 'mass_conservative' + case("GFAS") + persistence=3 ! 1-day records, valid for 3 day in FORECAST mode + bbinterp = 'conservative' case default;call CheckStop("Unknown B.B.Mapping") - endselect + end select rewind(IO_NML) read(IO_NML,NML=Fire_config,iostat=ios) @@ -168,7 +191,7 @@ subroutine Config_Fire() if(DEBUG%FORESTFIRE.and.MasterProc)then write(*,*) "NAMELIST IS " write(*,NML=Fire_config) - endif + end if ! set vebosity levels verbose=min(max(0,verbose),4) ! debug verbosity 0,..,4 @@ -195,12 +218,12 @@ subroutine Config_Fire() if(MasterProc) write(*,"(a,2i4,a17)") "FFIRE Mapping EMEP ", & ne, iemep, trim(species(iemep)%name) - enddo !n + end do !n call CheckStop(ieCO<1,"No mapping for 'CO' found on "//BiomassBurningMapping) call CheckStop(any(emep_used<1),"UNSET FFIRE EMEP "//BiomassBurningMapping) first_call=.false. -endsubroutine Config_Fire +end subroutine Config_Fire subroutine Fire_Emis(daynumber) !..................................................................... @@ -237,24 +260,25 @@ subroutine Fire_Emis(daynumber) if(fire_year>1) yyyy=fire_year select case(MODE) - case("DAILY_REC","D","d") - if(nn_old==daynumber) return ! Calculate once per day - nn_old=daynumber - dn1=dd - dn2=dd - case("MONTHLY_AVG","M","m") - if(nn_old==mm) return ! Calculate once per month - nn_old=mm - dn1=day_of_year(yyyy,mm,01) - dn2=dn1+max_day(mm,yyyy)-1 - case("YEARLY_AVG","Y","y") - if(nn_old==yyyy) return ! Calculate once per year - nn_old=yyyy - dn1=day_of_year(yyyy,01,01) - dn2=day_of_year(yyyy,12,31) - case default - call CheckStop("Unknown ForestFire MODE="//trim(MODE)) - endselect + case("DAILY_REC","D","d") + if(nn_old==daynumber) return ! Calculate once per day + nn_old=daynumber + dn1=dd + dn2=dd + case("MONTHLY_AVG","M","m") + if(nn_old==mm) return ! Calculate once per month + nn_old=mm + dn1=day_of_year(yyyy,mm,01) + dn2=dn1+max_day(mm,yyyy)-1 + case("YEARLY_AVG","Y","y") + if(nn_old==yyyy) return ! Calculate once per year + nn_old=yyyy + dn1=day_of_year(yyyy,01,01) + dn2=day_of_year(yyyy,12,31) + case default + call CheckStop("Unknown ForestFire MODE="//trim(MODE)) + end select + if(dn1[kg/m2/s] + call ReadField_CDF(fname,FF_poll,rdemis,nstart,interpol=bbinterp,& + needed=need_poll,UnDef=0.0,debug_flag=debug_nc,& + ncFileID_given=ncFileID) + end if +!-------- Aug 2017 + + select case(BBMAP) + case("GFED") + + !unit conversion, GFED [g/m2/8day]->[kg/m2/s] to_kgm2s = 1.0e-3 /(8*24.0*3600.0) if(ndn>1) to_kgm2s=to_kgm2s/ndn ! total-->avg. forall(j=1:ljmax,i=1:limax) rdemis(i,j)=rdemis(i,j)*to_kgm2s + case("FINN") - if(dn1[kg/m2/s] + ! (Can be negative if REMPPM to be calculated) fac=FF_defs(iBB)%unitsfac * FF_defs(iBB)%frac ! --> [kg/day] fac=fac/(GRIDWIDTH_M*GRIDWIDTH_M*24.0*3600.0) ! [kg/day]->[kg/m2/s] if(ndn>1) fac=fac/ndn ! total-->avg. forall(j=1:ljmax,i=1:limax) rdemis(i,j)=rdemis(i,j)*fac*xm2(i,j) + case("GFAS") - if(dn11) fac=fac/ndn ! total-->avg. if(fac/=1.0) forall(j=1:ljmax,i=1:limax) rdemis(i,j)=rdemis(i,j)*fac - endselect + end select ! Assign . units should be [kg/m2/s] here forall(j=1:ljmax,i=1:limax) & BiomassBurningEmis(ind,i,j) = BiomassBurningEmis(ind,i,j) + rdemis(i,j) - if(debug_ff) write(*,"(3a10,i4,f8.3,es12.3)") "FFIRE SUMS:", & - trim(FF_poll), trim( species(iemep)%name), ind, & - species(iemep)%molwt, sum( BiomassBurningEmis(ind,:,:) ) + if(debug_ff.and. debug_proc) & + write(*,"(3a10,2i4,f8.3,es12.3)") "FFIRE SUMS:", & + trim(FF_poll), trim( species(iemep)%name), me, ind, & + species(iemep)%molwt, sum( BiomassBurningEmis(ind,:,:) ) call PrintLog("ForestFire_ml :: Assigns "//trim(FF_poll),& first_call.and.MasterProc) - if(DEBUG%FORESTFIRE) sum_emis(ind)=sum_emis(ind)+sum(BiomassBurningEmis(ind,:,:)) - enddo ! BB_DEFS + if(DEBUG%FORESTFIRE) sum_emis(ind)=sum_emis(ind)+& + sum(BiomassBurningEmis(ind,:,:)) + end do ! BB_DEFS - call CheckNC(nf90_close(ncFileID),"close:"//trim(fname)) ! has to close the file here + ! have to close the file here + call CheckNC(nf90_close(ncFileID),"close:"//trim(fname)) ncFileID=closedID first_call = .false. deallocate(rdemis) if(allocated(xrdemis)) deallocate(xrdemis) - ! For cases where REMPPM25 s derived as the difference between PM25 and (BC+1.7*OC) - ! we need some safety: + ! For cases where REMPPM25 s derived as the difference between PM25 and + ! (BC+1.7*OC) we need some safety: BiomassBurningEmis(:,:,:) = max( BiomassBurningEmis(:,:,:), 0.0 ) - ! Logical to let Unimod know if there is any emission here to worry about + ! Logical to tell if there is any emission here to worry about burning(:,:) = ( BiomassBurningEmis(ieCO,:,:) > 1.0e-19 ) - ! Some databases (e.g. FINN, GFED) have both total PM25 and EC, OC. The difference - ! REMPPM25, is created by the BiomasBurning mapping procedure, but we just - ! check here + ! Some databases (e.g. FINN, GFED) have both total PM25 and EC, OC. The + ! difference, REMPPM25, is created by the BiomasBurning mapping procedure, + ! but we just check here if(DEBUG%FORESTFIRE.and.debug_proc) then n = ieCO loc_maxemis = maxloc(BiomassBurningEmis(n,:,: ) ) associate ( idbg=>loc_maxemis(1), jdbg=>loc_maxemis(2) ) - write(*,"(a,i4,i3,2i4,2i5,es12.3, 2i4)") "SUM_FF CHECK ME: ", daynumber, me, loc_maxemis, & - i_fdom(idbg), j_fdom(jdbg), BiomassBurningEmis(n,idbg,jdbg), debug_li,debug_lj + write(*,"(a,i4,i3,2i4,2i5,es12.3, 2i4)") "SUM_FF CHECK ME: ", daynumber,& + me, loc_maxemis, i_fdom(idbg), j_fdom(jdbg),& + BiomassBurningEmis(n,idbg,jdbg), debug_li,debug_lj call datewrite("SUM_FF CHECK CO: ", & (/ daynumber, n, i_fdom( idbg ), j_fdom( jdbg ) /) ,& (/ sum_emis(n), maxval(BiomassBurningEmis(n,:,: ) ), & BiomassBurningEmis(n,debug_li,debug_lj) /) ) end associate ! idbg, jdbg - endif ! debug_proc + end if ! debug_proc !end associate ACDATES contains @@ -422,7 +436,7 @@ function newFFrecord(ymd) result(new) case("GFED");fname=date2file(GFED_PATTERN,ymd,persistence-1,"days") case("FINN");fname=date2file(FINN_PATTERN,ymd,persistence-1,"days") case("GFAS");fname=date2file(GFAS_PATTERN,ymd,persistence-1,"days") - endselect + end select if(fname/=file_old)then if(DEBUG%FORESTFIRE.and.MasterProc) & write(*,*)"ForestFire new file: ",trim(fname) @@ -436,23 +450,23 @@ function newFFrecord(ymd) result(new) if(MasterProc)then write(*,*)"ForestFire file not found: ",trim(fname) call CheckStop(need_file,"Missing ForestFire file") - endif + end if burning(:,:) = .false. new=.false. return - endif + end if ! read all times records in fname, and process them nread=-1 fdays(:)=-1.0 call ReadTimeCDF(fname,fdays,nread) record_old=-1 - endif + end if ! Check: New pollutant if(FF_poll/=poll_old)then if(DEBUG%FORESTFIRE.and.MasterProc) & write(*,*)"ForestFire new pollutant: ",trim(FF_poll) - endif + end if ! Check: New time record call date2nctime(ymd,ncday(1)) @@ -469,12 +483,12 @@ function newFFrecord(ymd) result(new) nctime2string("YYYY-MM-DD 00:00",ncday(0))," and ",& nctime2string("YYYY-MM-DD 23:59",ncday(1)) call CheckStop(need_date,"Missing ForestFire records") - endif + end if burning(:,:) = .false. new=.false. return - endif - endif + end if + end if ! Update if new new=(fname/=file_old).or.(nstart/=record_old).or.(FF_poll/=poll_old) @@ -484,9 +498,9 @@ function newFFrecord(ymd) result(new) file_old=fname poll_old=FF_poll record_old=nstart - endif -endfunction newFFrecord -endsubroutine Fire_Emis + end if +end function newFFrecord +end subroutine Fire_Emis !============================================================================= @@ -512,7 +526,7 @@ subroutine Fire_rcemis(i,j) debug_flag = (DEBUG%FORESTFIRE.and.debug_proc .and.& i==debug_li.and.j==debug_lj) if(debug_flag.and.BiomassBurningEmis(ieCO,i,j) > 1.0e-10) & - write(*,"(a,5i4,es12.3,f9.3)") "BurningDEBUG ", me, i,j, & + write(*,"(a,5i4,es12.3,f9.3)") "FIREBurningDEBUG ", me, i,j, & i_fdom(i), j_fdom(j), BiomassBurningEmis(ieCO,i,j) N_LEVELS = KMAX_MID - KEMISFIRE + 1 @@ -536,7 +550,7 @@ subroutine Fire_rcemis(i,j) do k = KEMISFIRE, KMAX_MID invDeltaZfac(k) = 1.0/ (z_bnd(i,j,k) - z_bnd(i,j,k+1)) /N_LEVELS - enddo + end do do n = 1, NEMEPSPECS iem = emep_used(n) @@ -546,22 +560,22 @@ subroutine Fire_rcemis(i,j) ! distribute vertically: do k = KEMISFIRE, KMAX_MID rcemis(iem,k) = rcemis(iem,k) + BiomassBurningEmis(n,i,j)*invDeltaZfac(k)*fac - enddo !k + end do !k if(debug_flag) then k=KMAX_MID write(*,"(a,2i3,1x,a8,i4,es10.2,4es10.2)") "FIRERC ",& n, iem, trim(species(iem)%name), k, BiomassBurningEmis(iem,i,j),& invDeltaZfac(k), origrc, rcemis(iem,k) - endif + end if !DSBB !-- Add up emissions in ktonne ...... !DSBB ! totemadd(iem) = totemadd(iem) + & !DSBB ! tmpemis(iqrc) * dtgrid * xmd(i,j) - enddo ! n + end do ! n ! call Export_FireNc() ! Caused problems on last attempt -endsubroutine Fire_rcemis +end subroutine Fire_rcemis !============================================================================= subroutine Export_FireNc() type(Deriv) :: def1 ! definition of fields @@ -577,7 +591,7 @@ subroutine Export_FireNc() call Out_netCDF(IOU_INST,def1,2,1, BiomassBurningEmis(ieCO,:,:),1.0,& CDFtype=Real4,fileName_given='FF.nc') -endsubroutine Export_FireNc +end subroutine Export_FireNc endmodule ForestFire_ml !============================================================================= diff --git a/Functions_ml.f90 b/Functions_ml.f90 index 27a8f37..d61a1cb 100644 --- a/Functions_ml.f90 +++ b/Functions_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -83,8 +83,8 @@ function Daily_cosine(mean, amp, dmax, ndays) result (daily) do d = 1, ndays daily(d) = mean + amp * cos ( twopi * (d - dmax)/ ndays ) - enddo -endfunction Daily_cosine + end do +end function Daily_cosine !------------------------------------------------------------------- function Daily_sine(mean, amp, dmax, ndays) result (daily) !+ @@ -106,8 +106,8 @@ function Daily_sine(mean, amp, dmax, ndays) result (daily) do d = 1, ndays daily(d) = mean + amp * sin ( twopi * (d + shift - dmax)/ ndays ) - enddo -endfunction Daily_sine + end do +end function Daily_sine !------------------------------------------------------------------- function Daily_halfsine(base, amp, ndays) result (daily) !+ @@ -125,7 +125,7 @@ function Daily_halfsine(base, amp, ndays) result (daily) do d = 1, ndays daily(d) = base + amp * sin ( pi * (ndays - d )/ ndays ) end do -endfunction Daily_halfsine +end function Daily_halfsine !------------------------------------------------------------------- elemental function StandardAtmos_km_2_kPa(h_km) result (p_kPa) !------------------------------------------------------------------- @@ -144,8 +144,8 @@ elemental function StandardAtmos_km_2_kPa(h_km) result (p_kPa) p_kPa = 101.325*exp(-5.255876*log(288.15/(288.15-6.5*h_km))) else p_kPa = 22.632*exp(-0.1576884*(h_km - 11.0) ) - endif -endfunction StandardAtmos_km_2_kPa + end if +end function StandardAtmos_km_2_kPa !------------------------------------------------------------------- elemental function StandardAtmos_kPa_2_km(p_kPa) result (h_km) !------------------------------------------------------------------- @@ -166,8 +166,8 @@ elemental function StandardAtmos_kPa_2_km(p_kPa) result (h_km) h_km = (288.15-t)/6.5 else h_km = 11.0 + log( p_kPa/22.632)/(-0.1576884) - endif -endfunction StandardAtmos_kPa_2_km + end if +end function StandardAtmos_kPa_2_km !======================================================================= !+ ! Exner functions @@ -198,8 +198,8 @@ subroutine Exner_tab() p = PBAS + i*PINC ! tpi(i) = CP*(p/1.0e+5)**KAPPA ! With CP!!!! tab_exf(i) = (p/1.0e+5)**KAPPA ! Without CP - enddo -endsubroutine Exner_tab + end do +end subroutine Exner_tab !------------------------------------------------------------------- elemental function Exner_nd(p) result(exf) real, intent(in) :: p ! Pressure, p @@ -209,7 +209,7 @@ elemental function Exner_nd(p) result(exf) x1 = (p-PBAS)/PINC ix1 = floor(x1) exf = tab_exf(ix1) + (x1-ix1)*(tab_exf(ix1+1) - tab_exf(ix1)) -endfunction Exner_nd +end function Exner_nd !------------------------------------------------------------------- elemental function Tpot_2_T(p) result(fTpot) ! Identical to Exner_nd @@ -222,7 +222,7 @@ elemental function Tpot_2_T(p) result(fTpot) x1 = (p-PBAS)/PINC ix1 = int( x1 ) fTpot = tab_exf(ix1) + (x1-ix1)*(tab_exf(ix1+1) - tab_exf(ix1)) -endfunction Tpot_2_T +end function Tpot_2_T !------------------------------------------------------------------- elemental function T_2_Tpot(p) result(fT) ! Iinvese of Exner_nd @@ -236,7 +236,7 @@ elemental function T_2_Tpot(p) result(fT) ix1 = int( x1 ) exf = tab_exf(ix1) + (x1-ix1)*(tab_exf(ix1+1) - tab_exf(ix1)) fT = 1.0/exf -endfunction T_2_Tpot +end function T_2_Tpot !------------------------------------------------------------------- real function ERFfunc(x) implicit none @@ -252,7 +252,7 @@ real function ERFfunc(x) call calerf(x,result,jint) ERFfunc=result -endfunction ERFfunc +end function ERFfunc !-------------------------------------------------------------------- subroutine calerf(arg,result,jint) !-------------------------------------------------------------------- @@ -467,7 +467,7 @@ subroutine calerf(arg,result,jint) end if end if 800 return -endsubroutine calerf +end subroutine calerf !------------------------------------------------------------------- PURE function great_circle_distance(fi1,lambda1,fi2,lambda2) result(dist) !compute the great circle distance between to points given in @@ -482,7 +482,7 @@ PURE function great_circle_distance(fi1,lambda1,fi2,lambda2) result(dist) dist=2*asin(sqrt(sin(DEG2RAD*0.5*(lambda1-lambda2))**2+& cos(DEG2RAD*lambda1)*cos(DEG2RAD*lambda2)*& sin(DEG2RAD*0.5*(fi1-fi2))**2)) -endfunction great_circle_distance +end function great_circle_distance !----------------------------------------------------------------------- ! The heaviside function, 0 for x<0 and 1 for x>0 (x==0?) ! For x=0, one could have 0.5, but numerically this is too tricky to code @@ -495,8 +495,8 @@ function heaviside(x) heaviside = 0.0 else heaviside = 1.0 - endif -endfunction heaviside + end if +end function heaviside !----------------------------------------------------------------------- !program Test_exn ! use Exner_ml diff --git a/GasParticleCoeffs_ml.f90 b/GasParticleCoeffs_ml.f90 new file mode 100644 index 0000000..6af9d75 --- /dev/null +++ b/GasParticleCoeffs_ml.f90 @@ -0,0 +1,334 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program is distributed in the hope that it will be useful, +!* but WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +module GasParticleCoeffs_ml +!.............................................................................. +! specifies data for deposition modelling. Initial parameters for Henry's +! law and reactivit scaling from: +! Wesely, 1989, Atmos. Environ., 23, No.6, pp. 1293-1304 +! extended/modified for EMEP usage. +!.............................................................................. + + +! includes DryDepDefs for 14 gases +! specifies Henry's coefficients, reactivities for gases +! +use PhysicalConstants_ml, only : PRANDTL, Sc_H20 +implicit none +private + + +!------------------------------------------------------------------------- +! Table2: (variable, igas) +! Variable: +! 1 = DH2O/Dx ! ratio of diffusivities +! 2 = H* M atm^-1 ! effective Henry coeff. +! 3 = pe ! +! 4 = k (M s)**(-1) ! +! 5 = f0 ! +! +public :: Init_GasCoeff + + +integer, public, parameter :: NDRYDEP_DEF = 64 ! no. of gases in tables below + + real, public, parameter, & ! Extension of Wesely Table + dimension(5,NDRYDEP_DEF) :: DryDepDefs = & + reshape ( & + (/ & +! D H* pe k f0 + 1.9, 1.0e5, -5.0, 9999.0, 0.0, &! 1 = SO2 Sulphur dioxide +!----------------------------------------------------------------------------- +!ORIG 1.6, 1.0e-2, 28.0, 6.0e8, 1.0, &! 2 = O3 Ozone +!ORIG 1.6, 1.0e-2, 9999.0, 2.0e6, 0.1, &! 3 = NO2 Nitrogen dioxide +!RB Ozone revised D-value based on Massman 1998 - the diffusion coefficient +! in air has a large uncertainty - no experimental determination seems to +! be available. +!----------------------------------------------------------------------------- + 1.51, 1.0e-2, 28.0, 6.0e8, 1.0, &! 2 = O3 Ozone RB update +!RB Nitrogen dioxide - reactivity increased - diffusion coeff. uncertain! +! D could be higher - based on Tang et al. 2014 D is estimated to be +! ca 1.76 (range 1.3 - 2.7!) + 1.6, 1.0e-2, 9999.0, 2.0e6, 0.5, &! 3 = NO2 RB update +!----------------------------------------------------------------------------- +! + 1.3, 2.0e-3, 9999.0, 1.0e-2, 0.0, &! 4 = NO Nitric oxide + 1.9, 1.0e14, 7.0, 1.0e-2, 0.0, &! 5 = HNO3 Nitric acid vapour +!----------------------------------------------------------------------------- +!ORIG 1.4, 1.0e5, 23.0, 7.0, 1.0, &! 6 = H2O2 Hydrogen peroxide +!ORIG 1.6, 1.5e1, -1.0, 9999.0, 0.0, &! 7 = (ALD) Acetaldehyde +!ORIG 1.3, 6.0e3, -3.0, 9999.0, 0.0, &! 8 = HCHO Formaldehyde +!ORIG 1.6, 2.4e2, 9999.0, 2.0, 0.1, &! 9 = (OP) Methyl hydroperoxide +!ORIG 2.0, 5.4e2, 9999.0, 6.0e2, 0.1, &! 10 = PAA Peroxyacetic acid +!ORIG 1.6, 4.0e6, -8.0, 9999.0, 0.0, &! 11 = (ORA) Formic acid +!----------------------------------------------------------------------------- + 1.36, 1.0e5, 23.0, 7.0, 1.0, &! 6 = H2O2 Hydrogen peroxide + 2.1, 1.3e1, -1.0, 9999.0, 0.05, &! 7 = ALD Acetaldehyde - RB update + 1.4, 3.2e3, -3.0, 9999.0, 0.2, &! 8 = HCHO Formaldehyde - RB update +!RB MEOOH Methyl hydroperoxide - maybe reactivity should be higher! + 1.9, 3.0e2, 9999.0, 2.0, 0.2, &! 9 = MEOOH Methyl hydroperoxide + 2.4, 8.3e2, 9999.0, 6.0e2, 0.2, &! 10 = PAA Peroxyacetic acid - RB +! HCOOH - NOTE - may need updating - solubility is even higher at pH=7 but +! surface resistance should perhaps not be 1/100 of that for SO2... + 1.6, 1.6e7, -8.0, 9999.0, 0.0, &! 11 = HCOOH Formic acid RB +!----------------------------------------------------------------------------- + ! followed CEH recommendation and set H* NH3 equal to sulphur + ! (actually, CEH would have set it much higher than SO2!) + !orig: 2.0e4, 9999.0, 9999.0, 0.0, &! 12 = NH3 Ammonia +!ORIG 1.0, 1.0e5, 9999.0, 9999.0, 0.0, &! 12 = NH3 Ammonia +!ORIG 2.6, 3.6e0, 9999.0, 3.0e3, 0.1, &! 13 = PAN Peroxyacetyl nitrate +!ORIG 1.6, 1.0e5, 6.0, 4.0e-4, 0.1, &! 14 = HNO2 Nitrous acid + 1.1, 1.0e5, 9999.0, 9999.0, 0.0, &! 12 = NH3 Ammonia RB + 2.8, 3.0e0, 9999.0, 3.0e3, 0.5, &! 13 = PAN Peroxyacetyl nitrate. RB +!RB HNO2 - uncertain about the f0 - Zhang et al. assume much higher reactivity + 1.6, 2.6e5, 6.0, 4.0e-4, 0.5, &! 14 = HNO2 Nitrous acid RB +!----------------------------------------------------------------------------- + ! Now Robert's extension to lots of organics: + 2.1, 6.0e4, 9999.0, 9999.0, 1.0, &! 15 = HO2NO2 Pernitric acid + 2.9, 2.5e2, 9999.0, 9999.0, 1.0, &! 16 = ANHY Maleic anhydride (2,5-furandione) + 3.5, 1.3e4, 9999.0, 9999.0, 0.5, &! 17 = CO2C3PAN CH3C(O)CH2C(O)ONO3 + 4.0, 1.5e8, 9999.0, 9999.0, 0.3, &! 18 = VHISOLNO3 Very high solubility (estimated H* > ca 8.8e6 M/atm) multifunctional organic nitrates + 4.3, 5.0e6, 9999.0, 9999.0, 0.3, &! 19 = HISOLNO3 Fairly high solubility (estimated H* ca 5e6 - 7e6 M/atm) multifunctional organic nitrates + 4.7, 5.5e4, 9999.0, 9999.0, 0.3, &! 20 = C10H17NO4 moderately soluble C10-nitrates with an OH-group + 3.7, 5.0e4, 9999.0, 9999.0, 0.3, &! 21 = MDNO3OH medium size moderately soluble organic nitrates with an OH-group + 2.9, 4.0e4, 9999.0, 9999.0, 0.3, &! 22 = SMNO3OH small moderately soluble organic nitrates with an OH or OOH-group + 3.4, 2.7e4, 9999.0, 9999.0, 0.3, &! 23 = MNO3OOH small (C3-C4) moderately soluble organic nitrates with a hydro peroxide group + 4.8, 2.2e4, 9999.0, 9999.0, 0.3, &! 24 = C10NO3OOH moderately soluble C10-organic nitrates with a hydro peroxide group + 3.4, 1.0e4, 9999.0, 9999.0, 0.3, &! 25 = MDSOLNO3 rather low soluble (H* ca 0.7 - 1.7e4 M/atm) organic nitrates (mixed group) + 4., 6.0e3, 9999.0, 9999.0, 0.3, &! 26 = LOSOLNO3 low soluble (H* ca 4 - 7e3 M/atm) organic nitrates (mixed group) + 2.3, 2.0e0, 9999.0, 9999.0, 0.3, &! 27 = CH3NO3 methyl nitrate (and ethyl nitrate) + 3.2, 1.0e0, 9999.0, 9999.0, 0.3, &! 28 = VLSOLNO3 very low solubility (H* < ca 1e3 M/atm) organic nitrates (mixed group) + 3.8, 3.5e8, 9999.0, 9999.0, 0.2, &! 29 = VHISOLOOH Very high solubility (estimated H* > ca 1.2e7 M/atm) multifunctional organic hydroperoxides + 2.6, 3.2e6, 9999.0, 9999.0, 0.2, &! 30 = HCOCO3H + 4.3, 1.6e6, 9999.0, 9999.0, 0.2, &! 31 = LHISOLOOH Large (C7-C10) High solubility (estimated H* ca 1.6e6 M/atm) multifunctional organic hydroperoxides + 2.9, 1.2e6, 9999.0, 9999.0, 0.2, &! 32 = SHISOLOOH Small (C2-C5) High solubility (estimated H* ca 1 - 1.4e6 M/atm) multifunctional organic hydroperoxides + 3.1, 7.2e5, 9999.0, 9999.0, 0.2, &! 33 = RN12OOH + 4.5, 4.4e5, 9999.0, 9999.0, 0.2, &! 34 = PERPINONIC + 4.2, 1.8e5, 9999.0, 9999.0, 0.2, &! 35 = NOPINAOOH + 3.3, 1.1e5, 9999.0, 9999.0, 0.2, &! 36 = MDSOLOOH C4/C5 medium solubility (estimated H* ca 1.e5 M/atm) multifunctional organic hydroperoxides + 4.3, 9.0e4, 9999.0, 9999.0, 0.2, &! 37 = C96OOH + 2.8, 3.1e4, 9999.0, 9999.0, 0.2, &! 38 = HYPERACET + 4.8, 5.2e3, 9999.0, 9999.0, 0.2, &! 39 = C10PAN2 + 2.6, 4.6e3, 9999.0, 9999.0, 0.2, &! 40 = HOCH2CO3H + 3.4, 3.0e0, 9999.0, 9999.0, 0.2, &! 41 = MPAN + 2.7, 8.3e1, 9999.0, 9999.0, 0.2, &! 42 = C3H7OOH + 4.4, 9.0e3, 9999.0, 9999.0, 0.05, &! 43 = PINONALDEHYDE + 2.6, 8.0e3, 9999.0, 9999.0, 0.05, &! 44 = ACETOL + 3.1, 1.5e3, 9999.0, 9999.0, 0.05, &! 45 = MACROH + 2.7, 2.0e1, 9999.0, 9999.0, 0.05, &! 46 = MEK + 3.5, 4.0e7, 9999.0, 9999.0, 0.0, &! 47 = HISOLF0 species with estimated H* >= ca 4e7 M/atm and f0=0.0 + 4.6, 1.3e7, 9999.0, 9999.0, 0.0, &! 48 = PINONIC pinonic acid + 3.2, 5.5e6, 9999.0, 9999.0, 0.0, &! 49 = CO23C4CHO + 3.2, 1.1e6, 9999.0, 9999.0, 0.0, &! 50 = CARB13 - more or less guessing since no MCM equivalent to the CARB13 in the CRI scheme identified + 2.0, 7.0e5, 9999.0, 9999.0, 0.0, &! 51 = CH3CO2H + 3.7, 3.9e5, 9999.0, 9999.0, 0.0, &! 52 = HCC7CO + 2.1, 3.0e5, 9999.0, 9999.0, 0.0, &! 53 = GLYOX + 3.0, 2.3e5, 9999.0, 9999.0, 0.0, &! 54 = DICARB - mixture of C4 and C5 dicarbonyls + UCARB12 (which is not a dicarbonyl but with similar estimated D and H* + 3.45, 5.3e4, 9999.0, 9999.0, 0.0, &! 55 = MCARB moderately soluble (estimated H* ca 4.8 - 6.1E4 M/atm) carbonyls and dicarbonyls + 2.2, 4.1e4, 9999.0, 9999.0, 0.0, &! 56 = HOCH2CHO - glycolaldehyde + 3.1, 3.4e4, 9999.0, 9999.0, 0.0, &! 57 = CARB12 moderately soluble carbonyls (mixed) with estimated H* ca 3.0 - 3.8E4 M/atm + 2.5, 2.4e4, 9999.0, 9999.0, 0.0, &! 58 = MGLYOX + 3.2, 2.8e3, 9999.0, 9999.0, 0.0, &! 59 = PHENOL + 2.4, 1.0e14, 9999.0, 9999.0, 0.0, &! 60 = N2O5 + 3.9, 1.3e7, 9999.0, 9999.0, 0.0, &! 61 = LVASOA - to model Hodzics 0.01 anthropogenic VSOA bin + 3.1, 1.3e5, 9999.0, 9999.0, 0.0, &! 62 = SVASOA - to model Hodzics 10, 100 and 1000ug/m3 Anthropogenic VSOA bins + 4.6, 6.3e8, 9999.0, 9999.0, 0.0, &! 63 = LSVBSOA - to model Hodzics 0.01, 0.1, 1 and 10 ug/m3 Biogenic VSOA bins + 4.6, 3.2e7, 9999.0, 9999.0, 0.0 &! 64 = SVBSOA - to model Hodzics 100ug/m3 Biogenic VSOA bin +!END RB + /), & + (/5,NDRYDEP_DEF/) ) + + +!/ Ratio of diffusivites compared to ozone.. + +real, public, dimension(NDRYDEP_DEF), save :: DRx ! Ratio D(O3)/D(x) + +!/ and for the calculation of Rb we need: + +real, public, dimension(NDRYDEP_DEF), save :: Rb_cor ! two-thirds power of the + ! Schmidt to Prandtl numbers + +!RB integer, public, parameter :: & +!RB WES_SO2 = 1, WES_O3 = 2, WES_NO2 = 3, WES_NO = 4, WES_HNO3 = 5, & +!RB WES_H2O2= 6, WES_ALD= 7, WES_HCHO= 8, WES_OP = 9, WES_PAA = 10, & +!RB WES_ORA = 11, WES_NH3= 12, WES_PAN = 13, WES_HNO2=14 + +integer, public, parameter :: & + WES_SO2 = 1, WES_O3 = 2, WES_NO2 = 3, WES_NO = 4, WES_HNO3 = 5, & + WES_H2O2= 6, WES_ALD= 7, WES_HCHO= 8, WES_MEOOH = 9, WES_PAA = 10, & + WES_HCOOH = 11, WES_NH3= 12, WES_PAN = 13, WES_HNO2=14, WES_HO2NO2 = 15, & + WES_ANHY = 16, WES_CO2C3PAN = 17, WES_VHISOLNO3 = 18, WES_HISOLNO3 = 19, & + WES_C10H17NO4 = 20, WES_MDNO3OH = 21, WES_SMNO3OH = 22, WES_MNO3OOH = 23, & + WES_C10NO3OOH = 24, WES_MDSOLNO3 = 25, WES_LOSOLNO3 = 26, WES_CH3NO3 = 27, & + WES_VLSOLNO3 = 28, WES_VHISOLOOH = 29, WES_HCOCO3H = 30, WES_LHISOLOOH = 31, & + WES_SHISOLOOH = 32, WES_RN12OOH = 33, WES_PERPINONIC = 34, & + WES_NOPINAOOH = 35, WES_MDSOLOOH = 36,& + WES_C96OOH = 37, WES_HYPERACET = 38, WES_C10PAN2 = 39, WES_HOCH2CO3H = 40, & + WES_MPAN = 41, WES_C3H7OOH = 42, WES_PINONALDEHYDE = 43, WES_ACETOL = 44, & + WES_MACROH = 45, WES_MEK = 46, WES_HISOLF0 = 47, WES_PINONIC = 48, & + WES_CO23C4CHO = 49, WES_CARB13 = 50, WES_CH3CO2H = 51, WES_HCC7CO = 52, & + WES_GLYOX = 53, WES_DICARB = 54, WES_MCARB = 55, WES_HOCH2CHO = 56, & + WES_CARB12 = 57, WES_MGLYOX = 58, WES_PHENOL = 59, WES_N2O5 = 60, & + WES_LVASOA = 61, WES_SVASOA = 62, WES_LSVBSOA = 63, WES_SVBSOA = 64 + + +!*** Variables used in deposition calculations + +! DDEP_xx gives the index that will be used in the EMEP model +! WES_xx gives the index of the DryDepDefs gas to which this corresponds + +! Here we define the minimum set of species which has different +! deposition velocities. We calculate Vg for these, and then +! can use the rates for other similar species. (e.g. AMSU can use +! the Vg for SO4. Must set NDRYDEP_CALC species + +!*** IMPORTANT: the variables below must match up in the sense that, for +! example, if DDEP_NH3=4 then the 4th element of DRYDEP must be WES_NH3. + +!RBinteger, public, parameter :: NDRYDEP_GASES = 11 ! gases +integer, public, parameter :: NDRYDEP_GASES = 63 ! gases + +integer, public, parameter :: & + CDDEP_HNO3 = 1, CDDEP_O3 = 2, CDDEP_SO2 = 3, & + CDDEP_NH3 = 4, CDDEP_NO2 = 5, CDDEP_PAN = 6, & + CDDEP_H2O2 = 7, CDDEP_ALD = 8, CDDEP_HCHO= 9, & + CDDEP_ROOH = 10, CDDEP_HNO2= 11 !, CDDEP_PMf = 12, CDDEP_PMc = 13 + +! RB: +integer, public, parameter :: & +!RB CDDEP_HNO3 = 1, CDDEP_O3 = 2, CDDEP_SO2 = 3, & +!RB CDDEP_NH3 = 4, CDDEP_NO2 = 5, CDDEP_PAN = 6, & +!RB CDDEP_H2O2 = 7, CDDEP_ALD = 8, CDDEP_HCHO= 9, & +!RB CDDEP_MEOOH = 10, CDDEP_HNO2= 11, + CDDEP_MEOOH = 10, & !DSRD SAME AS ROOH? + CDDEP_PAA= 12,& + CDDEP_HCOOH= 13, CDDEP_HO2NO2=14, CDDEP_ANHY=15,& + CDDEP_CO2C3PAN = 16, CDDEP_VHISOLNO3 = 17, CDDEP_HISOLNO3 = 18,& + CDDEP_C10H17NO4 = 19, CDDEP_MDNO3OH = 20, & + CDDEP_SMNO3OH = 21, CDDEP_MNO3OOH = 22, CDDEP_C10NO3OOH = 23, & + CDDEP_MDSOLNO3 = 24, CDDEP_LOSOLNO3 = 25, & + CDDEP_CH3NO3 = 26, CDDEP_VLSOLNO3 = 27, CDDEP_VHISOLOOH = 28,& + CDDEP_HCOCO3H = 29, & + CDDEP_LHISOLOOH = 30, CDDEP_SHISOLOOH = 31, CDDEP_RN12OOH = 32, CDDEP_PERPINONIC = 33, & + CDDEP_NOPINAOOH = 34, CDDEP_MDSOLOOH = 35, CDDEP_C96OOH = 36, CDDEP_HYPERACET = 37, & + CDDEP_C10PAN2 = 38, CDDEP_HOCH2CO3H = 39, CDDEP_MPAN = 40, CDDEP_C3H7OOH = 41, & + CDDEP_PINONALDEHYDE = 42, CDDEP_ACETOL = 43, CDDEP_MACROH = 44, CDDEP_MEK = 45, & + CDDEP_HISOLF0 = 46, CDDEP_PINONIC = 47, CDDEP_CO23C4CHO = 48, CDDEP_CARB13 = 49, & + CDDEP_CH3CO2H = 50, CDDEP_HCC7CO = 51, CDDEP_GLYOX = 52, CDDEP_DICARB = 53, & + CDDEP_MCARB = 54, CDDEP_HOCH2CHO = 55, CDDEP_CARB12 = 56, CDDEP_MGLYOX = 57, & + CDDEP_PHENOL = 58, CDDEP_N2O5 = 59, CDDEP_LVASOA = 60, CDDEP_SVASOA = 61, & + CDDEP_LSVBSOA = 62, CDDEP_SVBSOA = 63 !, CDDEP_PMf = 52, CDDEP_PMc = 53 + +integer, public, parameter :: CDDEP_RCHO = CDDEP_ALD ! Convenience + +!OP renamed to MEOOH, FIN to PMf, COA to PMc +! specials for aerosols. we have 2 fine, 1 coarse and 1 'giant'type +!integer, public, parameter :: & +! CDDEP_PMfS= 12, CDDEP_PMfN= 13, CDDEP_PMc = 14, & +! CDDEP_SSc = 15, CDDEP_DUc = 16, CDDEP_POLLd= 17 +!integer, public, parameter :: CDDEP_PMfNH4 = 18 ! TEST_2014 +!integer, public, parameter :: CDDEP_LASTPM = 18 ! Safety. Catches changes +integer, private, parameter :: NG = NDRYDEP_GASES +integer, public, parameter :: & + CDDEP_PMfS= NG+1, CDDEP_PMfN= NG+2, CDDEP_PMc = NG+3, & + CDDEP_SSc = NG+4, CDDEP_DUc = NG+5 +!RB , CDDEP_POLLd= NG+6 +!RB integer, public, parameter :: CDDEP_PMfNH4 = NG+7 ! TEST_2014 + +!OP renamed to ROOH, FIN to PMf, COA to PMc +! specials for aerosols. we have 2 fine, 1 coarse and 1 'giant'type +integer, public, parameter :: & +!RB CDDEP_PMfS= 12, CDDEP_PMfN= 13, CDDEP_PMc = 14, & +!RB CDDEP_SSc = 15, CDDEP_DUc = 16, & +!RN CDDEP_BIRCH=17, CDDEP_OLIVE=18, CDDEP_GRASS=19 ! Pollen types + CDDEP_BIRCH=NG+6, CDDEP_OLIVE=NG+7, CDDEP_GRASS=NG+8 ! Pollen types +integer, public, parameter :: CDDEP_PMfNH4 = NG+9 ! TEST_2014 +integer, public, parameter :: CDDEP_LASTPM = NG+9 ! Safety. Catches changes + +integer, dimension(CDDEP_PMfS:CDDEP_LASTPM), public, parameter :: & +! 1=fine,2=coarse,3=coarse sea salt, 4=dust, 5/6/7 = birch/olive/grass pollen + AERO_SIZE = (/ 1, 1, 2, 3, 4, 5, 6, 7, 1 /) + +integer, public, parameter :: NDRYDEP_AER = 9 ! aerosols with CDDEP_PMfNH4 +integer, public, parameter :: NDRYDEP_CALC = NDRYDEP_GASES + NDRYDEP_AER + +integer, public, parameter :: & + CDDEP_ASH1=CDDEP_PMfS,CDDEP_ASH2=CDDEP_PMfS,CDDEP_ASH3=CDDEP_PMfS,& + CDDEP_ASH4=CDDEP_PMfS,CDDEP_ASH5=CDDEP_PMc ,CDDEP_ASH6=CDDEP_PMc, & + CDDEP_ASH7=CDDEP_PMc + +integer, public, parameter :: CDDEP_SET = -99 + +integer, public, parameter, dimension(NDRYDEP_GASES) :: & +!RB DRYDEP_GASES = (/ WES_HNO3, WES_O3, WES_SO2, & +!RB WES_NH3, WES_NO2, WES_PAN, & +!RB WES_H2O2, WES_ALD, WES_HCHO, WES_OP, WES_HNO2 /) + DRYDEP_GASES = (/ WES_HNO3, WES_O3, WES_SO2, & + WES_NH3, WES_NO2, WES_PAN, & + WES_H2O2, WES_ALD, WES_HCHO, WES_MEOOH, & + WES_HNO2, WES_PAA, WES_HCOOH, WES_HO2NO2, WES_ANHY, & + WES_CO2C3PAN, WES_VHISOLNO3, WES_HISOLNO3, & + WES_C10H17NO4, WES_MDNO3OH, WES_SMNO3OH, WES_MNO3OOH, & + WES_C10NO3OOH, WES_MDSOLNO3, WES_LOSOLNO3, WES_CH3NO3, & + WES_VLSOLNO3, WES_VHISOLOOH, WES_HCOCO3H, WES_LHISOLOOH, & + WES_SHISOLOOH, WES_RN12OOH, WES_PERPINONIC, WES_NOPINAOOH, & + WES_MDSOLOOH, WES_C96OOH, WES_HYPERACET, WES_C10PAN2, WES_HOCH2CO3H, & + WES_MPAN, WES_C3H7OOH, WES_PINONALDEHYDE, WES_ACETOL, & + WES_MACROH, WES_MEK, WES_HISOLF0, WES_PINONIC, & + WES_CO23C4CHO, WES_CARB13, WES_CH3CO2H, WES_HCC7CO, & + WES_GLYOX, WES_DICARB, WES_MCARB, WES_HOCH2CHO, WES_CARB12,& + WES_MGLYOX, WES_PHENOL, WES_N2O5, WES_LVASOA, & + WES_SVASOA, WES_LSVBSOA, WES_SVBSOA /) + + +contains + +!========================================================== +subroutine Init_GasCoeff() +!========================================================== +!Description: +!calculates: +! 1) DRx - ratio of diffusivities of ozone to gas requried +! 2) Rb_corr - the two-thirds power of the Schmidt to Prandtl +!number ratio values for all 14 gases listed in DryDepDefs + +!========================================================== +! -> Calculated Rb_cor + + !Declaration of local variables + + integer :: icmp + real :: Schmidt !.. number + + + GASLOOP: do icmp = 1, NDRYDEP_DEF + DRx (icmp) = DryDepDefs(1,WES_O3)/DryDepDefs(1,icmp) + Schmidt = Sc_H20* DryDepDefs(1,icmp) + Rb_cor(icmp) = (Schmidt/PRANDTL)**(2.0/3.0) + end do GASLOOP + + end subroutine Init_GasCoeff +end module GasParticleCoeffs_ml diff --git a/Gravset_ml.f90 b/Gravset_ml.f90 new file mode 100644 index 0000000..24f9f70 --- /dev/null +++ b/Gravset_ml.f90 @@ -0,0 +1,200 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program is distributed in the hope that it will be useful, +!* but WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +module Gravset_ml + +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +! Testing for ash gravitational settling +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +use CheckStop_ml, only: CheckStop +use Chemfields_ml, only: xn_adv +use ChemChemicals_ml, only: species_adv +use ChemSpecs_adv_ml +use ChemSpecs_shl_ml, only: NSPEC_SHL +use ChemGroups_ml, only: chemgroups +use DerivedFields_ml, only: f_3d,d_3d ! debug output +use GridValues_ml, only: A_mid,B_mid,A_bnd,B_bnd +use MetFields_ml, only: roa,th,ps +use ModelConstants_ml, only: KMAX_MID,KMAX_BND,dt_advec,MasterProc,& + IOU_INST,num_lev3d,lev3d +use Par_ml, only: MAXLIMAX,MAXLJMAX,li0,li1,lj0,lj1 +use PhysicalConstants_ml, only: GRAV +use SmallUtils_ml, only: find_index + +implicit none +private + +public :: gravset + +real, parameter :: & + slinnfac = 1.0 ,& + density = 2.5E03,& !3.0E03 + F = 0.8, wil_hua = F**(-0.828) + 2*SQRT(1.07-F) + +contains + +subroutine gravset() + real :: ztempx,vt,zsedl,tempc,knut + real :: Re, vt_old, ztemp + real,dimension(KMAX_MID) :: zvis,p_mid,zlair,zflux,zdp1,num_sed + real,dimension(KMAX_BND) :: p_full + integer :: i,j,k,ash,n,b + integer,save :: bins=0 + logical :: first_call = .true. + +! need to calculate +! zvis -> dynamic viscosity of air.. dependent on temperature + + type :: sediment + integer :: spec,n3d_gravset + real :: diameter + end type sediment + type(sediment),save,allocatable,dimension(:) :: grav_sed + + + if (first_call) then + if(MasterProc) & + write(*,*) "Gravset called!" + + ash=find_index("ASH",chemgroups(:)%name) + bins=0 + if(ash>0)& + bins=size(chemgroups(ash)%specs) + select case(bins) + case(7) + allocate(grav_sed(bins)) + grav_sed(:)%spec = chemgroups(ash)%specs(:)-NSPEC_SHL + grav_sed(:)%diameter = [0.1,0.3,1.0,3.0,10.0,30.0,100.0]*1e-6 + case(9) + allocate(grav_sed(bins)) + grav_sed(:)%spec = chemgroups(ash)%specs(:)-NSPEC_SHL + grav_sed(:)%diameter = [4.0,6.0,8.0,10.0,12.0,14.0,16.0,18.0,25.0]*1e-6 +! case(10) +! allocate(grav_sed(bins)) +! grav_sed(:)%spec = chemgroups(ash)%specs(:)-NSPEC_SHL +! grav_sed(:)%diameter = [2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.0,18.0,25.0]*1e-6 + case default + if(MasterProc) & + write(*,"(A,I0,A)") "Unsupported number of ASH bins ",bins,", skip gravset." + end select + + if(allocated(grav_sed))then + grav_sed(:)%n3d_gravset=0 + do n=1,size(f_3d) + if(f_3d(n)%class/='USET')cycle + b=find_index(f_3d(n)%txt,species_adv(grav_sed(:)%spec)%name) + if(b<1)cycle + select case(f_3d(n)%subclass) + case('gravset_3D') + grav_sed(b)%n3d_gravset=n + f_3d(n)%unit="m/s" + f_3d(n)%scale=1.0 + end select + end do + end if + + first_call = .false. + end if !first_call + if(.not.allocated(grav_sed))& + return + + do j = lj0,lj1 + do i = li0,li1 + do k = 1,KMAX_MID + ! dynamic viscosity of air after Prup.Klett in [Pa s] + tempc = th(i,j,k,1) - 273.15 + if (tempc >= 0.0 ) then + zvis(k) = (1.718 + 0.0049*tempc)*1.E-5 + else + zvis(k) = (1.718 + 0.0049*tempc - 1.2E-05*(tempc**2))*1.E-5 + end if + + ! mean free path of air (Prupp. Klett) in [10^-6 m] + p_mid(k) = A_mid(k)+B_mid(k)*ps(i,j,1) + zlair(k) = 0.066 *(1.01325E+5/p_mid(k))*(th(i,j,k,1)/293.15)*1.E-06 + + ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)] + p_full(k) = A_bnd(k)+B_bnd(k)*ps(i,j,1) + end do + p_full(KMAX_BND) = A_bnd(KMAX_BND)+B_bnd(KMAX_BND)*ps(i,j,1) + + do k = 1,KMAX_MID + zdp1(k)=(p_full(k+1) - p_full(k))/(GRAV*dt_advec) ! do outside of k-loop???? + end do + + do b = 1,bins + do k = 1,KMAX_MID-1 + knut = 2*zlair(k)/grav_sed(b)%diameter + ztemp = 2.*((grav_sed(b)%diameter/2)**2)*(density-roa(i,j,k,1))*GRAV/ &! roa [kg m-3] + (9.*zvis(k))![m/s] + ! with Cunningham slip-flow correction + vt = ztemp*slinnfac* & + (1.+ 1.257*knut+0.4*knut*EXP(-1.1/(knut))) ![m/s] + Re = grav_sed(b)%diameter*vt/(zvis(k)/roa(i,j,k,1)) + vt_old = vt + vt = vt/wil_hua + num_sed(k)= vt + + ! calculation of sedimentation flux zflux[kg/(m^2 s)]=zsedl*zdp1 + ! definition of zflux=vt*ztm1(:,:,jt)*zdens + ! compute flux in terms of mixing ratio zsedl= zflux/zdp1 -->>zsedl [kg/kg] + ! change of tracer tendency according to loss of tracer + ! due to sedimentation from the box + ! unit of zdp1 kg of air m-2 s-1 + + ztempx = min(1.0,vt*roa(i,j,k,1)/zdp1(k)) ! 1, loss is limited to content of box + zsedl = ztempx*xn_adv(grav_sed(b)%spec,i,j,k) ! kg kg-1, loss in terms of mixing ratio ! blir likt uavhengig av vt + zflux(k) = zsedl*zdp1(k) ! --> [kg m-2 s-1] + + ! loss of mass in layer + xn_adv(grav_sed(b)%spec,i,j,k) = xn_adv(grav_sed(b)%spec,i,j,k) - zsedl ! kg kg-1 + end do + + ! teste å gjøre det i en ny k-loop så det ikke blir så effektivt + + do k = 1,KMAX_MID-1 + ! "arrival" of sedimented mass in box below + if(k0)& + d_3d(n,i,j,:,IOU_INST)=num_sed(lev3d(:num_lev3d)) + + end do + end do + end do + +! Multilayer crossing is here no ralised!!! +! sedimentation velocity is in effect limited to z/delt +! sedimentation to the ground from first layer sflx --> [kg m-2 s-1] +! sflux = zflux(:,1) ! sedimenterer ikke på bakken, bare sender det til nederste laget +end subroutine gravset + + +end module Gravset_ml diff --git a/GridAllocate_ml.f90 b/GridAllocate_ml.f90 index 087f93b..d1508fc 100644 --- a/GridAllocate_ml.f90 +++ b/GridAllocate_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -117,8 +117,8 @@ subroutine GridAllocate_ij(label,i,j,code,ncmax,ic,& " GridAlloc::Already listed ", me, i,j, nc , icc, code ic = icc return - endif - enddo + end if + end do ic = nc + 1 if ( ic > ncmax ) then @@ -185,8 +185,8 @@ subroutine GridAllocate_rarray(label,ncmax,ncmaxfound,& if( gridc(i,j,icc) == code ) then data(i,j,icc) = data(i,j,icc) + dat cycle GRIDLOOP ! Yep, go onto to next k - endif - enddo + end if + end do ! Nope, must be new. Add to ngridc and gridc: ngridc(i,j) = ngridc(i,j) + 1 @@ -206,7 +206,7 @@ subroutine GridAllocate_rarray(label,ncmax,ncmaxfound,& (gridc(i,j,icc),icc=1,ncmaxfound) write(unit=*,fmt=*) "GridAlloc Data: ", & (data(i,j,icc),icc=1,ncmaxfound) - endif + end if end do GRIDLOOP end do ! j end do ! i diff --git a/GridValues_ml.f90 b/GridValues_ml.f90 index c46cf61..ebccb35 100644 --- a/GridValues_ml.f90 +++ b/GridValues_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -33,37 +33,40 @@ Module GridValues_ml ! Nomenclature: ! fulldomain is the largest grid, usually where metdata is defined. ! rundomain is a grid where the run is performed, smaller than fulldomain. +! subdomain: the domain covered by one MPI process or processor. ! restricted domain is a grid smaller than rundomain, where data is outputed; ! (the restricted domains are for instance, fullrun_DOMAIN,month_DOMAIN, ! day_DOMAIN,hour_DOMAIN). -! subdomain: the domain covered by one MPI process or processor. ! !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC use CheckStop_ml, only: CheckStop,StopAll,check=>CheckNC use Functions_ml, only: great_circle_distance use Io_Nums_ml, only: IO_LOG,IO_TMP -use MetFields_ml +use MetFields_ml use ModelConstants_ml, only: & KMAX_BND, KMAX_MID, & ! vertical extent DEBUG, & ! DEBUG%GRIDVALUES - MasterProc,NPROC,IIFULLDOM,JJFULLDOM,RUNDOMAIN,& - PT,Pref,NMET,METSTEP,USE_EtaCOORDINATES,MANUAL_GRID,USE_WRF_MET_NAMES,startdate -use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER, MPI_LOGICAL, & - MPI_MIN, MPI_MAX, MPI_SUM, & - MPI_COMM_CALC, MPI_COMM_WORLD, MPISTATUS, IERROR, ME_MPI, NPROC_MPI,& - ME_CALC, largeLIMAX,largeLJMAX + MasterProc,NPROC,IIFULLDOM,JJFULLDOM,RUNDOMAIN, JUMPOVER29FEB,& + PT,Pref,NMET,METSTEP,USE_EtaCOORDINATES,MANUAL_GRID,USE_WRF_MET_NAMES,& + startdate,NPROCX,NPROCY +use MPI_Groups_ml!, only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_LOGICAL, & + ! MPI_MIN, MPI_MAX, & + ! MPI_COMM_CALC, MPI_COMM_WORLD, MPISTATUS, IERROR, & + ! ME_MPI, NPROC_MPI, ME_CALC, largeLIMAX,largeLJMAX use Par_ml, only : & - LIMAX,LJMAX, & ! max. possible i, j in this domain - limax,ljmax, & ! actual max. i, j in this domain - li0,li1,lj0,lj1, & ! for debugging TAB GIMAX,GJMAX, & ! Size of rundomain - IRUNBEG,JRUNBEG, & ! start of user-specified domain - gi0,gj0, & ! full-dom coordinates of domain lower l.h. corner - gi1,gj1, & ! full-dom coordinates of domain uppet r.h. corner + IRUNBEG,JRUNBEG, & ! start of rundomain in fulldomain coordinates + gi0,gj0, & ! rundomain coordinates of subdomain lower l.h. corner + gi1,gj1, & ! rundomain coordinates of subdomain uppet r.h. corner + limax,ljmax, & ! max i,j in this subdomain (can differ on other subdomains) + li0,li1,lj0,lj1, & ! start and end of i,j excluding outer frame of rundomain. + ! li0=1 or 2, li1=limax or limax-1 me, & ! local processor - parinit,parinit_groups -use PhysicalConstants_ml, only: GRAV, PI, EARTH_RADIUS ! gravity, pi + neighbor,WEST,EAST,SOUTH,NORTH,NOPROC, & + parinit,parinit_groups, & + MAXLIMAX,MAXLJMAX,MINLIMAX,MINLJMAX,tljmax,tlimax +use PhysicalConstants_ml, only: GRAV,PI,EARTH_RADIUS,deg2rad,rad2deg use TimeDate_ml, only: current_date,date,Init_nmdays,nmdays use TimeDate_ExtraUtil_ml, only: date2string use InterpolationRoutines_ml, only: inside_1234 @@ -82,10 +85,13 @@ Module GridValues_ml public :: ij2ijm ! polar grid1 to polar grid2 public :: lb2ij ! longitude latitude to (i,j) in any grid projection public :: ij2lb ! polar stereo grid to longitude latitude +public :: lb_rot2lb !rotated lon lat to lon lat +public :: lb2UTM ! lon lat to Transverse Mercator +public :: UTM2lb ! Transverse Mercator to lon lat interface lb2ij module procedure lb2ij_real,lb2ij_int -end interface +end interface private :: lb2ij_real,lb2ij_int public :: coord_check ! normalize longitudes @@ -93,78 +99,98 @@ Module GridValues_ml public :: & coord_in_gridbox, & ! Are coord (lon/lat) inside gridbox(i,j)? coord_in_processor,& ! Are coord (lon/lat) inside local domain? - coord_in_domain ! Are coord (lon/lat) inside "domain"? + coord_in_domain ! Are coord (lon/lat) inside "domain" (full, run or sub)? + +public :: RestrictDomain ! mask from full domain to rundomain -public :: RestrictDomain !mask from full domain to rundomain +public :: GridRead +public :: extendarea_N ! returns array which includes neighbours from other subdomains -public :: GridRead!,Getgridparams private :: Alloc_GridFields private :: GetFullDomainSize private :: find_poles !** 1) Public (saved) Variables from module: +! Polar stereographic projection parameters real, public, save :: & - xp=0.0, yp=1.0, & ! Coordinates of North pole (from infield) - fi=0.0, & ! projections rotation angle around y axis (from infield) - AN=1.0, & ! Distance on the map from pole to equator (No. of cells) - GRIDWIDTH_M=1.0,& ! width of grid at 60N, in meters (old "h")(from infield) - ref_latitude =60. ! latitude at which projection is true (degrees) + xp=0.0, yp=1.0, & ! Coordinates of North pole + fi=0.0, & ! projections rotation angle around y axis + AN=1.0, & ! Distance on the map from pole to equator (No. of cells) + GRIDWIDTH_M=1.0, & ! width of grid at ref_latitude, in meters + ref_latitude =60. ! latitude at which projection is true (degrees) -!Rotated_Spherical grid prarameters -real, public, save :: grid_north_pole_latitude,grid_north_pole_longitude,& - dx_rot,dx_roti,x1_rot,y1_rot +! Rotated_Spherical grid prarameters +real, public, save :: & + grid_north_pole_latitude,grid_north_pole_longitude,& + dx_rot,dx_roti,x1_rot,y1_rot + +! Lambert conformal projection parameters +real, public, save :: & + lon0_lambert,& ! reference longitude, also called phi, at which y=0 if lat=lat0_lambert + lat0_lambert,& ! reference latitude, at which x=0 + lat_stand1_lambert,&! standard latitude at which mapping factor=1 + lat_stand2_lambert,&! second standard latitude + y0_lambert,& ! reference y coordinate, also called rho0 + k_lambert,& ! also called n, = sin(lat_stand1_lambert) + earth_radius_lambert,&! earth_radius used to define x and y in the met file. NOT USED + F_lambert,& ! normalization constant = cos(dr*lat0_lambert)*tan(PI/4+dr2*lat0_lambert)**k_lambert/k_lambert + x1_lambert,& ! x value at i=1 + y1_lambert ! y value at j=1 !/ Variables to define full-domain (fdom) coordinates of local i,j values, ! and reciprocal variables. integer, public, allocatable, save, dimension(:) :: & - i_fdom,j_fdom,& ! fdom coordinates of local i,j - i_local,j_local ! local coordinates of full-domain i,j + i_fdom,j_fdom, & ! fdom coordinates of local i,j + i_local,j_local ! local coordinates of full-domain i,j !Parameters for Vertical Hybrid coordinates: real, public, save,allocatable, dimension(:) :: & - A_bnd,B_bnd,& ! first [Pa],second [1] constants at layer boundary - ! (i.e. half levels in EC nomenclature) - A_bnd_met,B_bnd_met,& ! first [Pa],second [1] constants at layer boundary - ! (i.e. half levels in EC nomenclature) - A_mid,B_mid,& ! first [Pa],second [1] constants at middle of layer - ! (i.e. full levels in EC nomenclature) - dA,dB,& ! A_bnd(k+1)-A_bnd(k) [Pa],B_bnd(k+1)-B_bnd(k) [1] - ! P = A + B*PS; eta = A/Pref + B - dEta_i,& !1/deta = 1/(dA/Pref + dB) - Eta_bnd,Eta_mid,& ! boundary,midpoint of eta layer - sigma_bnd,sigma_mid ! boundary,midpoint of sigma layer + A_bnd,B_bnd,& ! first [Pa],second [1] constants at layer boundary + ! (i.e. half levels in EC nomenclature) + A_bnd_met,B_bnd_met,& ! first [Pa],second [1] constants at layer boundary + ! (i.e. half levels in EC nomenclature) + A_mid,B_mid,& ! first [Pa],second [1] constants at middle of layer + ! (i.e. full levels in EC nomenclature) + dA,dB,& ! A_bnd(k+1)-A_bnd(k) [Pa],B_bnd(k+1)-B_bnd(k) [1] + ! P = A + B*PS; eta = A/Pref + B + dEta_i,& ! 1/deta = 1/(dA/Pref + dB) + Eta_bnd,Eta_mid,& ! boundary,midpoint of eta layer + sigma_bnd,sigma_mid ! boundary,midpoint of sigma layer real, public, save,allocatable, dimension(:,:) :: & - glon ,glat ,& ! longitude,latitude of gridcell centers - gl_stagg ,gb_stagg,& ! longitude,latitude of gridcell corners - !NB: gl_stagg, gb_stagg are here defined as the average of the four - ! surrounding gl gb. - ! These differ slightly from the staggered points in the (i,j) grid. - rot_angle + glon ,glat ,& !longitude,latitude of gridcell centers + gl_stagg ,gb_stagg,& !longitude,latitude of gridcell corners + !NB: gl_stagg,gb_stagg are here defined as the average of the four + ! surrounding glat,glon. + ! These differ slightly from the staggered points in the (i,j) grid. + rot_angle real, public, save :: gbacmax,gbacmin,glacmax,glacmin ! EMEP grid definitions (old and official) real, public, parameter :: & - xp_EMEP_official=8.,yp_EMEP_official=110.0,fi_EMEP=-32.0,& - ref_latitude_EMEP=60.0,GRIDWIDTH_M_EMEP=50000.0,& - an_EMEP=237.7316364, &! = 6.370e6*(1.0+0.5*sqrt(3.0))/50000. - xp_EMEP_old=43.0,yp_EMEP_old=121.0 + xp_EMEP_official=8.,yp_EMEP_official=110.0,fi_EMEP=-32.0,& + ref_latitude_EMEP=60.0,GRIDWIDTH_M_EMEP=50000.0,& + an_EMEP=237.7316364, &! = 6.370e6*(1.0+0.5*sqrt(3.0))/50000. + xp_EMEP_old=43.0,yp_EMEP_old=121.0 !*** Map factor stuff: real, public, save,allocatable, dimension(:,:) :: & - xm_i, & ! map-factor in i direction, between cell j and j+1 - xm_j, & ! map-factor in j direction, between cell i and i+1 - xm2, & ! xm*xm: area factor in the middle of a cell (i,j) - xmd, & ! 1/xm2 - xm2ji,xmdji + xm_i, & ! map-factor in i direction, between cell j and j+1 + xm_j, & ! map-factor in j direction, between cell i and i+1 + xm2, & ! xm*xm: area factor in the middle of a cell (i,j) + xmd, & ! 1/xm2 + xm2ji,xmdji +!vertical "map factors" +real, public, save, allocatable,dimension(:) :: dhs1, dhs1i, dhs2i + !*** Grid Area real, public, save,allocatable, dimension(:,:) :: GridArea_m2 integer, public, save :: & - debug_li=-99, debug_lj=-99 ! Local Coordinates of debug-site + debug_li=-99, debug_lj=-99 ! Local Coordinates of debug-site logical, public, save :: debug_proc ! Processor with debug-site character(len=100),public :: projection @@ -179,1141 +205,1292 @@ Module GridValues_ml real, allocatable, save, public :: x_k1_met(:) logical, public, save :: External_Levels_Def=.false. integer, public, save :: KMAX_MET !number of vertical levels from the meteo files +real, private :: u(2),v(2)!array for temporary use contains - subroutine GridRead(meteo,cyclicgrid) - ! the subroutine reads the grid parameters (projection, resolution etc.) - ! defined by the meteorological fields - ! - implicit none - - character(len=*),intent(in):: meteo ! template for meteofile - integer, intent(out) :: cyclicgrid - integer :: nyear,nmonth,nday,nhour,k,ios - integer :: MIN_GRIDS - character(len=len(meteo)) :: filename !name of the input file - logical :: Use_Grid_Def=.false.!Experimental for now - - nyear=startdate(1) - nmonth=startdate(2) - nday=startdate(3) - nhour=0 - current_date = date(nyear, nmonth, nday, nhour, 0 ) - call Init_nmdays( current_date ) - - !*********initialize grid parameters********* - if(MANUAL_GRID)then - !define the grid parameter manually (explicitely) - if(me==0)write(*,*)'DEFINING GRID MANUALLY!' - - !must set all parameters... see example in version 3066 (or before) +subroutine GridRead(meteo,cyclicgrid) + ! the subroutine reads the grid parameters (projection, resolution etc.) + ! defined by the meteorological fields + implicit none + + character(len=*),intent(in):: meteo ! template for meteofile + integer, intent(out) :: cyclicgrid + integer :: nyear,nmonth,nday,nhour,k,ios + integer :: MIN_GRIDS + character(len=len(meteo)) :: filename !name of the input file + logical :: Use_Grid_Def=.false.!Experimental for now + + nyear=startdate(1) + nmonth=startdate(2) + nday=startdate(3) + nhour=0 + current_date = date(nyear, nmonth, nday, nhour, 0 ) + call Init_nmdays( current_date, JUMPOVER29FEB) + + !*********initialize grid parameters********* + if(MANUAL_GRID)then + ! define the grid parameter manually (explicitely) + if(MasterProc)write(*,*)'DEFINING GRID MANUALLY!' + ! must set all parameters... see example in version from 20151019 (or before) + else + ! NOT MANUAL GRID + + !check first if grid is defined in a separate file: + filename='Grid_Def.nc' + inquire(file=filename,exist=Grid_Def_exist) + Grid_Def_exist=Grid_Def_exist.and.Use_Grid_Def + if(Grid_Def_exist)then + if(MasterProc)write(*,*)'Found Grid_Def! ',trim(filename) else + if(MasterProc.and.Use_Grid_Def)& + write(*,*)'Did not found Grid_Def ',trim(filename) + filename=date2string(meteo,startdate) + end if + if(MasterProc)write(*,*)'reading domain sizes from ',trim(filename) + + call GetFullDomainSize(filename,IIFULLDOM,JJFULLDOM,KMAX_MET,METSTEP,projection) + + KMAX_MID=0!initialize + filename_vert='Vertical_levels.txt' + open(IO_TMP,file=filename_vert,action="read",iostat=ios) + if(ios==0)then + ! define own vertical coordinates + if(MasterProc)& + write(*,*)'Define vertical levels from ',trim(filename_vert) + read(IO_TMP,*)KMAX_MID + if(MasterProc)& + write(*,*)KMAX_MID, 'vertical levels ' + External_Levels_Def=.true. + ! Must use eta coordinates + if(MasterProc.and..not.USE_EtaCOORDINATES)& + write(*,*)'WARNING: using hybrid levels even if not asked to! ' + USE_EtaCOORDINATES=.true. + else + External_Levels_Def=.false. + close(IO_TMP) + KMAX_MID=KMAX_MET + end if + + KMAX_BND=KMAX_MID+1 + + allocate(A_bnd(KMAX_BND),B_bnd(KMAX_BND)) + allocate(A_mid(KMAX_MID),B_mid(KMAX_MID)) + allocate(dA(KMAX_MID),dB(KMAX_MID),dEta_i(KMAX_MID)) + allocate(sigma_bnd(KMAX_BND),sigma_mid(KMAX_MID)) + allocate(Eta_bnd(KMAX_BND),Eta_mid(KMAX_MID)) + allocate(i_local(IIFULLDOM)) + allocate(j_local(JJFULLDOM)) + + ! set RUNDOMAIN default values where not defined + if(RUNDOMAIN(1)<1)RUNDOMAIN(1)=1 + if(RUNDOMAIN(2)<1 .or. RUNDOMAIN(2)>IIFULLDOM) RUNDOMAIN(2)=IIFULLDOM + if(RUNDOMAIN(3)<1)RUNDOMAIN(3)=1 + if(RUNDOMAIN(4)<1 .or. RUNDOMAIN(4)>JJFULLDOM) RUNDOMAIN(4)=JJFULLDOM + if(MasterProc)then +55 format(A,I5,A,I5) + write(*,55) 'FULLDOMAIN has sizes ',IIFULLDOM,' X ',JJFULLDOM + write(IO_LOG,55)'FULLDOMAIN has sizes ',IIFULLDOM,' X ',JJFULLDOM + write(*,55) 'RUNDOMAIN x coordinates from ',RUNDOMAIN(1),' to ',RUNDOMAIN(2) + write(IO_LOG,55)'RUNDOMAIN x coordinates from ',RUNDOMAIN(1),' to ',RUNDOMAIN(2) + write(*,55) 'RUNDOMAIN y coordinates from ',RUNDOMAIN(3),' to ',RUNDOMAIN(4) + write(IO_LOG,55)'RUNDOMAIN y coordinates from ',RUNDOMAIN(3),' to ',RUNDOMAIN(4) + end if + + call find_poles(filename,Pole_Singular) + + MIN_GRIDS=5 + if(NPROC==NPROC_MPI)then + ! partition into subdomains + call parinit(MIN_GRIDS,Pole_Singular) ! subdomains sizes and position + else + ! partition into largesubdomains and subdomains + call parinit_groups(MIN_GRIDS,Pole_Singular) ! subdomains sizes and position + end if + call Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) - !NOT MANUAL GRID - - - !check first if grid is defined in a separate file: - filename='Grid_Def.nc' - inquire(file=filename,exist=Grid_Def_exist) - Grid_Def_exist=Grid_Def_exist.and.Use_Grid_Def - if(Grid_Def_exist)then - if(MasterProc)write(*,*)'Found Grid_Def! ',trim(filename) - else - if(MasterProc.and.Use_Grid_Def)write(*,*)'Did not found Grid_Def ',trim(filename) - !56 FORMAT(a5,i4.4,i2.2,i2.2,a3) - ! write(filename,56)'meteo',nyear,nmonth,nday,'.nc' - filename = date2string(meteo,startdate) - endif - if(MasterProc)write(*,*)'reading domain sizes from ',trim(filename) - - call GetFullDomainSize(filename,IIFULLDOM,JJFULLDOM,KMAX_MET,METSTEP,projection) - - KMAX_MID=0!initialize - filename_vert='Vertical_levels.txt' - open(IO_TMP,file=filename_vert,action="read",iostat=ios) - if(ios==0)then - !define own vertical coordinates - if(me==0)write(*,*)'Define vertical levels from ',trim(filename_vert) - read(IO_TMP,*)KMAX_MID - if(me==0)write(*,*)KMAX_MID, 'vertical levels ' - External_Levels_Def=.true. - !Must use eta coordinates - if(.not.USE_EtaCOORDINATES)write(*,*)'WARNING: using hybrid levels even if not asked to! ' - USE_EtaCOORDINATES=.true. - else - External_Levels_Def=.false. - close(IO_TMP) - KMAX_MID=KMAX_MET - endif - - KMAX_BND=KMAX_MID+1 - - allocate(A_bnd(KMAX_BND),B_bnd(KMAX_BND)) - allocate(A_mid(KMAX_MID),B_mid(KMAX_MID)) - allocate(dA(KMAX_MID),dB(KMAX_MID),dEta_i(KMAX_MID)) - allocate(sigma_bnd(KMAX_BND),sigma_mid(KMAX_MID)) - allocate(Eta_bnd(KMAX_BND),Eta_mid(KMAX_MID)) - - allocate(i_local(IIFULLDOM)) - allocate(j_local(JJFULLDOM)) - - !set RUNDOMAIN default values where not defined - if(RUNDOMAIN(1)<1)RUNDOMAIN(1)=1 - if(RUNDOMAIN(2)<1 .or. RUNDOMAIN(2)>IIFULLDOM) RUNDOMAIN(2)=IIFULLDOM - if(RUNDOMAIN(3)<1)RUNDOMAIN(3)=1 - if(RUNDOMAIN(4)<1 .or. RUNDOMAIN(4)>JJFULLDOM) RUNDOMAIN(4)=JJFULLDOM - if(MasterProc)then -55 format(A,I5,A,I5) - write(*,55) 'FULLDOMAIN has sizes ',IIFULLDOM,' X ',JJFULLDOM - write(IO_LOG,55)'FULLDOMAIN has sizes ',IIFULLDOM,' X ',JJFULLDOM - write(*,55) 'RUNDOMAIN x coordinates from ',RUNDOMAIN(1),' to ',RUNDOMAIN(2) - write(IO_LOG,55)'RUNDOMAIN x coordinates from ',RUNDOMAIN(1),' to ',RUNDOMAIN(2) - write(*,55) 'RUNDOMAIN y coordinates from ',RUNDOMAIN(3),' to ',RUNDOMAIN(4) - write(IO_LOG,55)'RUNDOMAIN y coordinates from ',RUNDOMAIN(3),' to ',RUNDOMAIN(4) - endif - - call find_poles(filename,Pole_Singular) - - MIN_GRIDS=5 - if(NPROC==NPROC_MPI)then - !partition into subdomains - call parinit(MIN_GRIDS,Pole_Singular) !subdomains sizes and position - else - !partition into largesubdomains and subdomains - call parinit_groups(MIN_GRIDS,Pole_Singular) !subdomains sizes and position - endif - - call Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) - - if(ME_CALC>=0)then - call Alloc_GridFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND) - else - call Alloc_GridFields(largeLIMAX,largeLJMAX,KMAX_MID,KMAX_BND) - endif - - if(ME_CALC>=0)then - call Getgridparams(LIMAX,LJMAX,filename,cyclicgrid) - !defines i_fdom,j_fdom,i_local,j_local,Cyclicgrid,North_pole,Poles - !GRIDWIDTH_M, glon, glat, xm_i,xm_j,xm2,xmd,xmdji,xm2ji,gl_stagg,gb_stagg - !for Stereographic projection: ref_latitude,fi,xp,yp,AN - !for lon lat projection: no additional parameters - !for Rotated_Spherical projection: grid_north_pole_latitude,grid_north_pole_longitude,x1_rot,y1_rot,dx_rot,dx_roti - !P0,A_bnd_met,B_bnd_met,A_bnd,B_bnd,A_mid,B_mid,sigma_mid,sigma_bnd - else - call Getgridparams(largeLIMAX,largeLJMAX,filename,cyclicgrid) - endif - - - if(ios==0)close(IO_TMP) - - if(MasterProc .and. DEBUG%GRIDVALUES)then - write(*,*)'sigma_mid:',(sigma_mid(k),k=1,20) - write(*,*)'grid resolution:',GRIDWIDTH_M - write(*,*)'xcoordinate of North Pole, xp:',xp - write(*,*)'ycoordinate of North Pole, yp:',yp - write(*,*)'longitude rotation of grid, fi:',fi - write(*,*)'true distances latitude, ref_latitude:',ref_latitude - endif - - endif - -! - end subroutine GridRead - - - - subroutine GetFullDomainSize(filename,IIFULLDOM,JJFULLDOM,KMAX,METSTEP,projection) - - ! - ! Get input grid sizes - ! - - implicit none - - character (len = *), intent(in) ::filename - integer, intent(out):: IIFULLDOM,JJFULLDOM,KMAX,METSTEP - character (len = *), intent(out) ::projection - - integer :: status,ncFileID,idimID,jdimID, kdimID,timeDimID - integer :: GIMAX_file,GJMAX_file,KMAX_file,wrf_proj_code - real :: wrf_POLE_LAT=0.0 - - - if(ME_MPI==0)then - print *,'Defining grid properties from ',trim(filename) - !open an existing netcdf dataset - status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) - if(status /= nf90_noerr) then - print *,'not found',trim(filename) - call StopAll("GridValues: File not found") - endif - - ! print *,' reading ',trim(filename) - projection='' - status = nf90_get_att(ncFileID,nf90_global,"projection",projection) - if(status /= nf90_noerr) then - !WRF projection format - call check(nf90_get_att(ncFileID,nf90_global,"MAP_PROJ",wrf_proj_code)) - if(.not.USE_WRF_MET_NAMES .and. me==0)write(*,*)'Assuming WRF metdata' - USE_WRF_MET_NAMES = .true. - if(wrf_proj_code==6)then - status = nf90_get_att(ncFileID,nf90_global,"POLE_LAT",wrf_POLE_LAT) - if(status == nf90_noerr) then - write(*,*)"POLE_LAT", wrf_POLE_LAT - if(abs(wrf_POLE_LAT-90.0)<0.001)then - projection='lon lat' - else - projection='Rotated_Spherical' - endif - else - write(*,*)"POLE_LAT not found" - projection='lon lat' - endif - else if(wrf_proj_code==2)then - projection='Stereographic' + if(ME_CALC>=0)then + call Alloc_GridFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND) + else + call Alloc_GridFields(largeLIMAX,largeLJMAX,KMAX_MID,KMAX_BND) + end if + + if(ME_CALC>=0)then + call Getgridparams(LIMAX,LJMAX,filename,cyclicgrid) + ! defines i_fdom,j_fdom,i_local,j_local,Cyclicgrid,North_pole,Poles + ! GRIDWIDTH_M, glon, glat, xm_i,xm_j,xm2,xmd,xmdji,xm2ji,gl_stagg,gb_stagg + ! P0,A_bnd_met,B_bnd_met,A_bnd,B_bnd,A_mid,B_mid,sigma_mid,sigma_bnd + ! for Stereographic projection: + ! ref_latitude,fi,xp,yp,AN + ! for lon lat projection: + ! no additional parameters + ! for Rotated_Spherical projection: + ! grid_north_pole_latitude,grid_north_pole_longitude,x1_rot,y1_rot,dx_rot,dx_roti + else + call Getgridparams(largeLIMAX,largeLJMAX,filename,cyclicgrid) + end if + + + if(ios==0)close(IO_TMP) + + if(MasterProc .and. DEBUG%GRIDVALUES)then + write(*,*)'sigma_mid:',(sigma_mid(k),k=1,20) + write(*,*)'grid resolution:',GRIDWIDTH_M + write(*,*)'xcoordinate of North Pole, xp:',xp + write(*,*)'ycoordinate of North Pole, yp:',yp + write(*,*)'longitude rotation of grid, fi:',fi + write(*,*)'true distances latitude, ref_latitude:',ref_latitude + end if + end if +end subroutine GridRead + +subroutine GetFullDomainSize(filename,IIFULLDOM,JJFULLDOM,KMAX,METSTEP,projection) + ! Get input grid sizes + + implicit none + + character (len = *), intent(in) ::filename + integer, intent(out):: IIFULLDOM,JJFULLDOM,KMAX,METSTEP + character (len = *), intent(out) ::projection + + integer :: status,ncFileID,idimID,jdimID, kdimID,timeDimID + integer :: GIMAX_file,GJMAX_file,KMAX_file,wrf_proj_code + real :: wrf_POLE_LAT=0.0 + character (len = 30) ::MAP_PROJ_CHAR + + + if(ME_MPI==0)then + print *,'Defining grid properties from ',trim(filename) + ! open an existing netcdf dataset + status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) + if(status/=nf90_noerr) then + print *,'not found',trim(filename) + call StopAll("GridValues: File not found") + end if + + projection='' + status = nf90_get_att(ncFileID,nf90_global,"projection",projection) + if(status/=nf90_noerr) then + ! WRF projection format + call check(nf90_get_att(ncFileID,nf90_global,"MAP_PROJ",wrf_proj_code)) + if(.not.USE_WRF_MET_NAMES .and. MasterProc)write(*,*)'Assuming WRF metdata' + USE_WRF_MET_NAMES = .true. + select case(wrf_proj_code) + case(6) + status = nf90_get_att(ncFileID,nf90_global,"POLE_LAT",wrf_POLE_LAT) + if(status==nf90_noerr) then + write(*,*)"POLE_LAT", wrf_POLE_LAT + if(abs(wrf_POLE_LAT-90.0)<0.001)then + projection='lon lat' else - call StopAll("Projection not recognized") - endif - endif - - !put into emep standard - if(trim(projection)=='Polar Stereographic')projection='Stereographic' - - if(trim(projection)=='Rotated_Spherical'.or.trim(projection)=='rotated_spherical'& - .or.trim(projection)=='rotated_pole'.or.trim(projection)=='rotated_latitude_longitude')then - projection='Rotated_Spherical' - endif - - write(*,*)'projection: ',trim(projection) - - !get dimensions id - if(trim(projection)=='Stereographic') then - status = nf90_inq_dimid(ncid = ncFileID, name = "i", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status = nf90_inq_dimid(ncid = ncFileID, name = "j", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - elseif(trim(projection)==trim('lon lat')) then - status=nf90_inq_dimid(ncid = ncFileID, name = "lon", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status=nf90_inq_dimid(ncid = ncFileID, name = "lat", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - else - ! write(*,*)'GENERAL PROJECTION ',trim(projection) - status=nf90_inq_dimid(ncid = ncFileID, name = "i", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status=nf90_inq_dimid(ncid = ncFileID, name = "j", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - endif - - status=nf90_inq_dimid(ncid = ncFileID, name = "k", dimID = kdimID) - if(status /= nf90_noerr)then - status=nf90_inq_dimid(ncid = ncFileID, name = "lev", dimID = kdimID)!hybrid coordinates - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "bottom_top", dimID = kdimID)) - endif - endif - - !get dimensions length - call check(nf90_inquire_dimension(ncid=ncFileID,dimID=idimID,len=GIMAX_file)) - call check(nf90_inquire_dimension(ncid=ncFileID,dimID=jdimID,len=GJMAX_file)) - call check(nf90_inquire_dimension(ncid=ncFileID,dimID=kdimID,len=KMAX_file)) - - write(*,*)'dimensions input grid:',GIMAX_file,GJMAX_file,KMAX_file!,Nhh - - IIFULLDOM=GIMAX_file - JJFULLDOM=GJMAX_file - KMAX =KMAX_file - - - !find METSTEP (checked also in first meteo read) - status=nf90_inq_dimid(ncid=ncFileID,name="time",dimID=timedimID) - if(status/=nf90_noerr)then - status=nf90_inq_dimid(ncid=ncFileID,name="Time",dimID=timedimID)! WRF - endif - if(status/=nf90_noerr)then - write(*,*)'time variable not found assuming 8 records' - Nhh=8 - else - call check(nf90_inquire_dimension(ncid=ncFileID,dimID=timedimID,len=Nhh)) - endif - - METSTEP=24/Nhh - write(*,*)'METSTEP set to ',METSTEP,' hours' - call check(nf90_close(ncFileID)) - endif - - CALL MPI_BCAST(METSTEP ,4,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(USE_WRF_MET_NAMES ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(IIFULLDOM ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(JJFULLDOM ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(KMAX ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(projection ,len(projection),MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - - end subroutine GetFullDomainSize - - subroutine find_poles(filename,Pole_Singular) - !defines if there is a singularity at poles - - implicit none - character (len = *), intent(in) ::filename - integer, intent(out):: Pole_Singular - integer :: status,ncFileID,varid - real,allocatable :: latitudes(:) - - Pole_Singular=0 - if(trim(projection)==trim('lon lat')) then - if(ME_MPI==0)then - !find wether poles are included (or almost included) in grid - ! - !If some cells are to narrow (Poles in lat lon coordinates), - !this will give too small time steps in the Advection, - !because of the constraint that the Courant number should be <1. - ! - !If Poles are found and lon-lat coordinates are used the Advection scheme - !will be modified to be able to cope with the singularity - !the advection routine will not work efficiently with NPROCY>2 in this case - - !open an existing netcdf dataset - status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) - if(status /= nf90_noerr) then - print *,'not found',trim(filename) - call StopAll("GridValues: File not found") - endif - - allocate(latitudes(JJFULLDOM)) - status=nf90_inq_varid(ncid = ncFileID, name = "lat", varID = varID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_varid(ncid = ncFileID, name = "XLAT", varID = varID)) - endif - call check(nf90_get_var(ncFileID, varID,latitudes )) - if(latitudes(RUNDOMAIN(4))>88.0)then - write(*,*)'The grid is singular at North Pole' - Pole_Singular=Pole_Singular+1 - endif - if(latitudes(RUNDOMAIN(3))<-88.0)then - write(*,*)'The grid is singular at South Pole' - Pole_Singular=Pole_Singular+1 - endif - deallocate(latitudes) - call check(nf90_close(ncFileID)) - endif - endif - - CALL MPI_BCAST(Pole_Singular ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - - end subroutine find_poles - - subroutine Getgridparams(LIMAX,LJMAX,filename,cyclicgrid) - ! - ! Get grid and time parameters as defined in the meteo or Grid_Def file - ! Do some checks on sizes and dates + projection='Rotated_Spherical' + end if + else + write(*,*)"POLE_LAT not found" + projection='lon lat' + end if + case(2) + projection='Stereographic' + case(1) + projection='lambert' + call check(nf90_get_att(ncFileID,nf90_global,"MAP_PROJ_CHAR",MAP_PROJ_CHAR)) + write(*,*)"wrf projection: "//trim(MAP_PROJ_CHAR) + case default + call CheckStop("Projection not recognized") + end select + end if + + ! put into emep standard + if(trim(projection)=='Polar Stereographic')projection='Stereographic' + + if(trim(projection)=='Rotated_Spherical'.or.trim(projection)=='rotated_spherical'& + .or.trim(projection)=='rotated_pole'.or.trim(projection)=='rotated_latitude_longitude')then + projection='Rotated_Spherical' + end if + + if(trim(projection)=='lambert_conformal_conic'.or.trim(projection)=='Lambert Conformal')projection='lambert' + + write(*,*)'projection: ',trim(projection) + + ! get dimensions id + if(trim(projection)=='Stereographic') then + status = nf90_inq_dimid(ncid=ncFileID, name="i", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status = nf90_inq_dimid(ncid=ncFileID, name="j", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + elseif(trim(projection)=='lambert') then + status = nf90_inq_dimid(ncid=ncFileID, name="x", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status = nf90_inq_dimid(ncid=ncFileID, name="y", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + write(*,*)'x y dimensions' + elseif(trim(projection)==trim('lon lat')) then + status=nf90_inq_dimid(ncid=ncFileID, name="lon", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status=nf90_inq_dimid(ncid=ncFileID, name="lat", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + else + ! write(*,*)'GENERAL PROJECTION ',trim(projection) + status=nf90_inq_dimid(ncid=ncFileID, name="i", dimID = idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status=nf90_inq_dimid(ncid=ncFileID, name="j", dimID = jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + end if + + status=nf90_inq_dimid(ncid=ncFileID, name="k", dimID=kdimID) + if(status/=nf90_noerr)then + status=nf90_inq_dimid(ncid=ncFileID, name="lev", dimID=kdimID)!hybrid coordinates + if(status/=nf90_noerr) then + status=nf90_inq_dimid(ncid=ncFileID, name="hybrid", dimID=kdimID)!hybrid coordinates + if(status/=nf90_noerr) then ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="bottom_top", dimID=kdimID)) + end if + end if + end if + + !get dimensions length + call check(nf90_inquire_dimension(ncid=ncFileID,dimID=idimID,len=GIMAX_file)) + call check(nf90_inquire_dimension(ncid=ncFileID,dimID=jdimID,len=GJMAX_file)) + call check(nf90_inquire_dimension(ncid=ncFileID,dimID=kdimID,len=KMAX_file)) + write(*,*)'dimensions input grid:',GIMAX_file,GJMAX_file,KMAX_file!,Nhh + + IIFULLDOM=GIMAX_file + JJFULLDOM=GJMAX_file + KMAX =KMAX_file + + ! find METSTEP (checked also in first meteo read) + status=nf90_inq_dimid(ncid=ncFileID,name="time",dimID=timedimID) + if(status/=nf90_noerr)& + status=nf90_inq_dimid(ncid=ncFileID,name="Time",dimID=timedimID)! WRF + if(status/=nf90_noerr)then + write(*,*)'time variable not found assuming 8 records' + Nhh=8 + else + call check(nf90_inquire_dimension(ncid=ncFileID,dimID=timedimID,len=Nhh)) + end if + + METSTEP=24/Nhh + write(*,*)'METSTEP set to ',METSTEP,' hours' + call check(nf90_close(ncFileID)) + end if + + CALL MPI_BCAST(METSTEP ,4,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(USE_WRF_MET_NAMES ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(IIFULLDOM ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(JJFULLDOM ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(KMAX ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(projection ,len(projection),MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + +end subroutine GetFullDomainSize + +subroutine find_poles(filename,Pole_Singular) + ! defines if there is a singularity at poles + + implicit none + character (len = *), intent(in) ::filename + integer, intent(out):: Pole_Singular + integer :: status,ncFileID,varid + real,allocatable :: latitudes(:) + + Pole_Singular=0 + if(trim(projection)==trim('lon lat')) then + ! find wether poles are included (or almost included) in grid ! - ! This routine is called only once (and is therefore not optimized for speed) + ! If some cells are to narrow (Poles in lat lon coordinates), + ! this will give too small time steps in the Advection, + ! because of the constraint that the Courant number should be <1. ! - !defines i_fdom,j_fdom,i_local,j_local,Cyclicgrid,North_pole,Poles - !GRIDWIDTH_M, glon, glat, xm_i,xm_j,xm2,xmd,xmdji,xm2ji,gl_stagg,gb_stagg - !for Stereographic projection: ref_latitude,fi,xp,yp,AN - !for lon lat projection: no additional parameters - !for Rotated_Spherical projection: grid_north_pole_latitude,grid_north_pole_longitude,x1_rot,y1_rot,dx_rot,dx_roti - !P0,A_bnd_met,B_bnd_met,A_bnd,B_bnd,A_mid,B_mid,sigma_mid,sigma_bnd - - - implicit none - - integer, intent(in):: LIMAX,LJMAX - character (len = *), intent(in) ::filename - integer, intent(out):: cyclicgrid - - integer :: n,i,j,k,kk - integer :: ncFileID,idimID,jdimID,varID - integer :: status,South_pole,North_pole - real :: x1,x2,x3,x4,P0,x,y,mpi_out - logical::found_hybrid=.false. - real :: CEN_LAT, CEN_LON,P_TOP_MET - real :: rb,rl,rp,dx,dy,dy2,glmax,glmin,v2(2),glon_fdom1,glat_fdom1 - integer :: iloc_start, iloc_end,jloc_start, jloc_end - - real, dimension(-1:LIMAX+2,-1:LJMAX+2)::xm,xm_i_ext,xm_j_ext - real, dimension(0:LIMAX+1,0:LJMAX+1)::lon_ext,lat_ext - - !define longitudes in interval [-180,180] - glmin = -180.0 - glmax = glmin + 360.0 - - ! we can already define some arrays: - - !/ Define full-domain coordinates of local i,j values. We need to account for - ! the fact that each parallel domain has its starting cordinate - ! gi0, gj0, and the user may specify a set of lower-left starting - ! coordinates for running the model, IRUNBEG, JRUNBEG - ! i_fdom(i) = i + gi0 + IRUNBEG - 2 - ! j_fdom(j) = j + gj0 + JRUNBEG - 2 - i_fdom = (/ (n + gi0 + IRUNBEG - 2, n=0,LIMAX+1) /) - j_fdom = (/ (n + gj0 + JRUNBEG - 2, n=0,LJMAX+1) /) - - ! And the reverse, noting that we even define for area - ! outside local domain - - i_local = (/ (n - gi0 - IRUNBEG + 2, n=1, IIFULLDOM) /) - j_local = (/ (n - gj0 - JRUNBEG + 2, n=1, JJFULLDOM) /) - - - call CheckStop(GIMAX+IRUNBEG-1 > IIFULLDOM, "GridRead: I outside domain" ) - call CheckStop(GJMAX+JRUNBEG-1 > JJFULLDOM, "GridRead: J outside domain" ) - - !open an existing netcdf dataset - status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) - if(status /= nf90_noerr) then - print *,'not found',trim(filename) - call StopAll("GridValues: File not found") - endif - if(MasterProc)print *,'Defining grid parameters from ',trim(filename) - - !get dimensions id - if(trim(projection)=='Stereographic') then - status = nf90_inq_dimid(ncid = ncFileID, name = "i", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status = nf90_inq_dimid(ncid = ncFileID, name = "j", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - elseif(trim(projection)==trim('lon lat')) then - status=nf90_inq_dimid(ncid = ncFileID, name = "lon", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status=nf90_inq_dimid(ncid = ncFileID, name = "lat", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - else - ! write(*,*)'GENERAL PROJECTION ',trim(projection) - status=nf90_inq_dimid(ncid = ncFileID, name = "i", dimID = idimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "west_east", dimID = idimID)) - endif - status=nf90_inq_dimid(ncid = ncFileID, name = "j", dimID = jdimID) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_inq_dimid(ncid = ncFileID, name = "south_north", dimID = jdimID)) - endif - endif - - !get global attributes - status = nf90_get_att(ncFileID,nf90_global,"Grid_resolution",GRIDWIDTH_M) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_get_att(ncFileID,nf90_global,"DX",GRIDWIDTH_M)) + ! If Poles are found and lon-lat coordinates are used the Advection scheme + ! will be modified to be able to cope with the singularity + ! the advection routine will not work efficiently with NPROCY>2 in this case + if(ME_MPI==0)then + ! open an existing netcdf dataset + status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) + if(status/=nf90_noerr) then + print *,'not found',trim(filename) + call StopAll("GridValues: File not found") + end if + + allocate(latitudes(JJFULLDOM)) + status=nf90_inq_varid(ncid=ncFileID, name="lat", varID=varID) + if(status/=nf90_noerr) then + !WRF format + call check(nf90_inq_varid(ncid=ncFileID, name="XLAT", varID=varID)) + call check(nf90_get_var(ncFileID, varID,latitudes ,start=(/1,1/), count=(/1,JJFULLDOM/) )) + else + call check(nf90_get_var(ncFileID, varID,latitudes )) + endif + + if(latitudes(RUNDOMAIN(4))>88.0)then + write(*,*)'The grid is singular at North Pole' + Pole_Singular=Pole_Singular+1 + end if + if(latitudes(RUNDOMAIN(3))<-88.0)then + write(*,*)'The grid is singular at South Pole' + Pole_Singular=Pole_Singular+1 + end if + deallocate(latitudes) + call check(nf90_close(ncFileID)) + end if + end if + + CALL MPI_BCAST(Pole_Singular ,4*1,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + +end subroutine find_poles + +subroutine Getgridparams(LIMAX,LJMAX,filename,cyclicgrid) + ! Get grid and time parameters as defined in the meteo or Grid_Def file + ! Do some checks on sizes and dates + ! + ! This routine is called only once (and is therefore not optimized for speed) + + ! defines i_fdom,j_fdom,i_local,j_local,Cyclicgrid,North_pole,Poles + ! GRIDWIDTH_M, glon, glat, xm_i,xm_j,xm2,xmd,xmdji,xm2ji,gl_stagg,gb_stagg + ! P0,A_bnd_met,B_bnd_met,A_bnd,B_bnd,A_mid,B_mid,sigma_mid,sigma_bnd + ! for Stereographic projection: + ! ref_latitude,fi,xp,yp,AN + ! for lon lat projection: + ! no additional parameters + ! for Rotated_Spherical projection: + ! grid_north_pole_latitude,grid_north_pole_longitude,x1_rot,y1_rot,dx_rot,dx_roti + + + implicit none + + integer, intent(in):: LIMAX,LJMAX + character (len = *), intent(in) ::filename + integer, intent(out):: cyclicgrid + + integer :: n,i,j,k,kk + integer :: ncFileID,idimID,jdimID,varID + integer :: status,South_pole,North_pole + real :: x1,x2,x3,x4,P0,x,y,mpi_out,r,t + logical::found_hybrid=.false.,found_metlevels=.false. + real :: CEN_LAT, CEN_LON,P_TOP_MET, WRF_DY + real :: rb,rl,rp,dx,dy,dy2,glmax,glmin,v2(2),glon_fdom1,glat_fdom1,lat + integer :: iloc_start, iloc_end,jloc_start, jloc_end + + real, dimension(-1:LIMAX+2,-1:LJMAX+2)::xm,xm_i_ext,xm_j_ext + real, dimension(0:LIMAX+1,0:LJMAX+1)::lon_ext,lat_ext + + + !define longitudes in interval [-180,180] + glmin = -180.0 + glmax = glmin + 360.0 + + ! we can already define some arrays: + + !/ Define full-domain coordinates of local i,j values. We need to account for + ! the fact that each parallel domain has its starting cordinate + ! gi0, gj0, and the user may specify a set of lower-left starting + ! coordinates for running the model, IRUNBEG, JRUNBEG + ! i_fdom(i) = i + gi0 + IRUNBEG - 2 + ! j_fdom(j) = j + gj0 + JRUNBEG - 2 + i_fdom = (/ (n + gi0 + IRUNBEG - 2, n=0,LIMAX+1) /) + j_fdom = (/ (n + gj0 + JRUNBEG - 2, n=0,LJMAX+1) /) + + ! And the reverse, noting that we even define for area + ! outside local domain + i_local = (/ (n - gi0 - IRUNBEG + 2, n=1, IIFULLDOM) /) + j_local = (/ (n - gj0 - JRUNBEG + 2, n=1, JJFULLDOM) /) + + call CheckStop(GIMAX+IRUNBEG-1 > IIFULLDOM, "GridRead: I outside domain" ) + call CheckStop(GJMAX+JRUNBEG-1 > JJFULLDOM, "GridRead: J outside domain" ) + + !open an existing netcdf dataset + status = nf90_open(path=trim(filename),mode=nf90_nowrite,ncid=ncFileID) + if(status/=nf90_noerr) then + print *,'not found',trim(filename) + call CheckStop("GridValues: File not found") + end if + if(MasterProc)print *,'Defining grid parameters from ',trim(filename) + + !get dimensions id + select case(projection) + case('Stereographic') + status = nf90_inq_dimid(ncid=ncFileID, name="i", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status = nf90_inq_dimid(ncid=ncFileID, name="j", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + case('lambert') + status = nf90_inq_dimid(ncid=ncFileID, name="x", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status = nf90_inq_dimid(ncid=ncFileID, name="y", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + case('lon lat') + status=nf90_inq_dimid(ncid=ncFileID, name="lon", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status=nf90_inq_dimid(ncid=ncFileID, name="lat", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + case default + ! write(*,*)'GENERAL PROJECTION ',trim(projection) + status=nf90_inq_dimid(ncid=ncFileID, name="i", dimID=idimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="west_east", dimID=idimID)) + status=nf90_inq_dimid(ncid=ncFileID, name="j", dimID=jdimID) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_inq_dimid(ncid=ncFileID, name="south_north", dimID=jdimID)) + end select + + !get global attributes + status = nf90_get_att(ncFileID,nf90_global,"Grid_resolution",GRIDWIDTH_M) + if(status/=nf90_noerr)then + !WRF format + call check(nf90_get_att(ncFileID,nf90_global,"DX",GRIDWIDTH_M)) + status = nf90_get_att(ncFileID,nf90_global,"DY",v(1)) + if(status==nf90_noerr .and. abs(GRIDWIDTH_M-v(1))>0.01) then + ! if(MasterProc)write(*,*)'Gridcells not square. Will correct y mapping factor' endif - if(MasterProc)write(*,*)"Grid_resolution",GRIDWIDTH_M - - if(trim(projection)=='Stereographic')then - status = nf90_get_att(ncFileID,nf90_global,"ref_latitude",ref_latitude) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_get_att(ncFileID,nf90_global,"TRUELAT1",ref_latitude)) - endif - status = nf90_get_att(ncFileID, nf90_global, "fi",fi ) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_get_att(ncFileID, nf90_global, "STAND_LON",fi )) - endif - status = nf90_get_att(ncFileID, nf90_global, "xcoordinate_NorthPole",xp ) - if(status == nf90_noerr) then - call check(nf90_get_att(ncFileID, nf90_global, "ycoordinate_NorthPole",yp )) - else - !WRF format compute from grid center coordinates - call check(nf90_get_att(ncFileID, nf90_global, "CEN_LAT" & - , CEN_LAT)) - call check(nf90_get_att(ncFileID, nf90_global, "CEN_LON" & - , CEN_LON)) - xp = 0.5 + 0.5*IIFULLDOM - EARTH_RADIUS/GRIDWIDTH_M*(1+sin(ref_latitude*PI/180.))& - *tan(PI/4-CEN_LAT*PI/180./2)*sin((CEN_LON-fi)*PI/180.) - yp = 0.5 + 0.5*JJFULLDOM + EARTH_RADIUS/GRIDWIDTH_M*(1+sin(ref_latitude*PI/180.))& - *tan(PI/4-CEN_LAT*PI/180./2)*cos((CEN_LON-fi)*PI/180.) - !correct for last digits. Assume that numbers are close enough to an integer - if(abs(nint(xp)-xp)<0.01)xp=nint(xp) - if(abs(nint(yp)-yp)<0.01)yp=nint(yp) - - if(MasterProc)write(*,*)"M= ",EARTH_RADIUS/GRIDWIDTH_M*(1+sin(ref_latitude*PI/180.)) - if(MasterProc)write(*,*)"coordinates of North pole ",xp,yp - endif - - AN = 6.370e6*(1.0+sin( ref_latitude*PI/180.))/GRIDWIDTH_M ! = 237.7316364 for GRIDWIDTH_M=50 km and ref_latitude=60 - - do j = 0, LJMAX+1 - dy = yp - j_fdom(j) - dy2 = dy*dy - do i = 0, LIMAX+1 - dx = i_fdom(i) - xp - rp = sqrt(dx*dx+dy2) ! => distance to pole - rb = 90.0 - 180.0/PI*2* atan(rp/AN) ! => latitude - rl = 0.0 - if (rp > 1.0e-10) rl = fi + 180.0/PI*atan2(dx,dy) - if (rl < glmin) rl = rl + 360.0 - if (rl > glmax) rl = rl - 360.0 - lon_ext(i,j)=rl ! longitude - lat_ext(i,j)=rb ! latitude - - end do ! i - end do ! j - - elseif(trim(projection)==trim('lon lat')) then - if(.not. USE_WRF_MET_NAMES)then - !NB: lon and lat are stored as 1 dimensional arrays - call check(nf90_inq_varid(ncid = ncFileID, name = "lon", varID = varID)) - - call check(nf90_get_var(ncFileID, varID, lon_ext(1:limax,1),start=(/gi0+IRUNBEG-1/),count=(/limax/) )) - if(LIMAX>limax)lon_ext(LIMAX,1)=lon_ext(limax,1)+(lon_ext(limax,1)-lon_ext(limax-1,1)) - lon_ext(0,1)=2*lon_ext(1,1)-lon_ext(2,1) - lon_ext(LIMAX+1,1)=2*lon_ext(LIMAX,1)-lon_ext(LIMAX-1,1) - do j=0,LJMAX+1 - lon_ext(:,j)=lon_ext(:,1) - enddo - - call check(nf90_inq_varid(ncid = ncFileID, name = "lat", varID = varID)) - call check(nf90_get_var(ncFileID, varID, lat_ext(1,1:ljmax),start=(/gj0+JRUNBEG-1/),count=(/ljmax/) )) - lat_ext(1,LJMAX)=min(90.0,lat_ext(1,LJMAX))!should never be used anyway - lat_ext(1,0)=2*lat_ext(1,1)-lat_ext(1,2) - lat_ext(1,LJMAX+1)=2*lat_ext(1,LJMAX)-lat_ext(1,LJMAX-1) - do i=0,LIMAX+1 - lat_ext(i,:)=lat_ext(1,:) - enddo - else - !WRF format - call check(nf90_inq_varid(ncid = ncFileID, name = "XLONG", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) - call check(nf90_inq_varid(ncid = ncFileID, name = "XLAT", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) - endif - else if(trim(projection)=='Rotated_Spherical')then - status=nf90_get_att(ncFileID,nf90_global,"grid_north_pole_latitude",grid_north_pole_latitude) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_get_att(ncFileID,nf90_global,"POLE_LAT",grid_north_pole_latitude)) - endif - if(MasterProc)write(*,*)"grid_north_pole_latitude",grid_north_pole_latitude - status=nf90_get_att(ncFileID,nf90_global,"grid_north_pole_longitude",grid_north_pole_longitude) - if(status /= nf90_noerr) then - !WRF format - call check(nf90_get_att(ncFileID,nf90_global,"POLE_LON",grid_north_pole_longitude)) - !find resolution in degrees from resolution in km. WRF uses Erath Radius 6370 km(?) - dx_rot=360./(6370000.*2*PI/GRIDWIDTH_M) - !round to 6 digits - dx_rot=0.000001*nint(1000000*dx_rot) - endif - if(MasterProc)write(*,*)"grid_north_pole_longitude",grid_north_pole_longitude - status=nf90_inq_varid(ncid = ncFileID, name = "i", varID = varID) - if(status == nf90_noerr) then - call check(nf90_get_var(ncFileID, varID, v2))!note that i is one dimensional - x1_rot=v2(1) - dx_rot=v2(2)-v2(1) - call check(nf90_inq_varid(ncid = ncFileID, name = "j", varID = varID)) - call check(nf90_get_var(ncFileID, varID, v2(1)))!note that j is one dimensional - y1_rot=v2(1) - call check(nf90_inq_varid(ncid = ncFileID, name = "lon", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) - call check(nf90_inq_varid(ncid = ncFileID, name = "lat", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) - else - !WRF format - call check(nf90_inq_varid(ncid = ncFileID, name = "XLONG", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) - call check(nf90_get_var(ncFileID, varID, v2,start=(/1,1/),count=(/1,1/) )) - glon_fdom1=v2(1) - !glon=0.0!to get some value for outside subdomain too (when limax180.0)then - x1_rot=x1_rot-360.0 - else if(x1_rot<-180.0)then - x1_rot=x1_rot+360.0 - else - exit - endif - enddo - ! call lb2ij(glon_fdom(1,1),glat_fdom(1,1),x,y) - ! write(*,*)'after ',glon_fdom(1,1),glat_fdom(1,1),x,y - ! call lb_rot2lb(x,y,x1_rot,y1_rot,grid_north_pole_longitude,grid_north_pole_latitude) - ! write(*,*)"spherical lon lat of (i,j)=(1,1)",x,y,glon_fdom(1,1),glat_fdom(1,1) - if(MasterProc)write(*,*)"rotated lon lat of (i,j)=(1,1)",x1_rot,y1_rot - if(MasterProc)write(*,*)"resolution",dx_rot - endif - dx_roti=1.0/dx_rot - + end if + if(MasterProc)write(*,*)"Grid_resolution",GRIDWIDTH_M + + select case(projection) + case('Stereographic') + status=nf90_get_att(ncFileID,nf90_global,"ref_latitude",ref_latitude) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_get_att(ncFileID,nf90_global,"TRUELAT1",ref_latitude)) + status = nf90_get_att(ncFileID, nf90_global, "fi",fi ) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_get_att(ncFileID, nf90_global, "STAND_LON",fi )) + status = nf90_get_att(ncFileID, nf90_global, "xcoordinate_NorthPole",xp ) + if(status==nf90_noerr) then + call check(nf90_get_att(ncFileID, nf90_global, "ycoordinate_NorthPole",yp )) else - !other projection? - call check(nf90_inq_varid(ncid = ncFileID, name = "lon", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) - call check(nf90_inq_varid(ncid = ncFileID, name = "lat", varID = varID)) - call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) - endif - - glon(1:LIMAX,1:LJMAX)=lon_ext(1:LIMAX,1:LJMAX) ! longitude - glat(1:LIMAX,1:LJMAX)=lat_ext(1:LIMAX,1:LJMAX) ! latitude - do j=1,LJMAX - do i=1,LIMAX - if(glon(i,j)>glmax)glon(i,j)=glon(i,j)-360.0 - if(glon(i,j) distance to pole + rb = 90.0 - 180.0/PI*2* atan(rp/AN) ! => latitude + rl = 0.0 + if (rp > 1.0e-10) rl = fi + 180.0/PI*atan2(dx,dy) + if (rl < glmin) rl = rl + 360.0 + if (rl > glmax) rl = rl - 360.0 + lon_ext(i,j)=rl ! longitude + lat_ext(i,j)=rb ! latitude + + end do ! i + end do ! j + + case('lambert') + if(USE_WRF_MET_NAMES)then + call check(nf90_get_att(ncFileID, nf90_global, "TRUELAT1",lat_stand1_lambert )) + call check(nf90_get_att(ncFileID, nf90_global, "TRUELAT2",lat_stand2_lambert )) + call check(nf90_get_att(ncFileID, nf90_global, "STAND_LON",lon0_lambert )) + earth_radius_lambert = earth_radius else - !map factor are already staggered - status=nf90_inq_varid(ncid=ncFileID, name="map_factor_i", varID=varID) - iloc_start=-1 - if(iloc_start+IRUNBEG+gi0-2<1)iloc_start=1!first cell (in i direction) - iloc_end=LIMAX+2 - if(iloc_end+IRUNBEG+gi0-2>IIFULLDOM)iloc_end=IIFULLDOM+2-gi0-IRUNBEG!last cell - jloc_start=-1 - if(jloc_start+JRUNBEG+gj0-2<1)jloc_start=1!first cell (in j direction) - jloc_end=LJMAX+2 - if(jloc_end+JRUNBEG+gj0-2>JJFULLDOM)jloc_end=JJFULLDOM+2-gj0-JRUNBEG!last cell - - if(status == nf90_noerr)then - call nf90_get_var_extended(ncFileID,varID,xm_i_ext,-1,LIMAX+2,-1,LJMAX+2) - else - !WRF format - call check(nf90_inq_varid(ncid=ncFileID, name="MAPFAC_VX", varID=varID)) - call nf90_get_var_extended(ncFileID,varID,xm_i_ext,-1,LIMAX+2,-1,LJMAX+2,jshift_in=1)!NB:shift j by 1 since wrf start at bottom face - endif - - status=nf90_inq_varid(ncid=ncFileID, name="map_factor_j", varID=varID) - if(status == nf90_noerr)then - call nf90_get_var_extended(ncFileID,varID,xm_j_ext,-1,LIMAX+2,-1,LJMAX+2) - else - !WRF format - call check(nf90_inq_varid(ncid=ncFileID, name="MAPFAC_UY", varID=varID)) - call nf90_get_var_extended(ncFileID,varID,xm_j_ext,-1,LIMAX+2,-1,LJMAX+2,ishift_in=1)!NB:shift i by 1 since wrf start at left face - endif - - !define xm2, xm_i and xm_j now - !Note that xm is inverse length: interpolate 1/xm rather than xm - do j=0,LJMAX+1 - do i=0,LIMAX+1 - xm_i(i,j)=xm_i_ext(i,j) - xm_j(i,j)=xm_j_ext(i,j) - xm2(i,j) = 4.0*( (xm_i_ext(i,j-1)*xm_i_ext(i,j))/& - (xm_i_ext(i,j-1)+xm_i_ext(i,j)) )& - *( (xm_j_ext(i-1,j)*xm_j_ext(i,j))/& - (xm_j_ext(i-1,j)+xm_j_ext(i,j)) ) - xmd(i,j) =1.0/xm2(i,j) - xm2ji(j,i) = xm2(i,j) - xmdji(j,i) = xmd(i,j) - enddo - enddo - + status = nf90_get_att(ncFileID,nf90_global,"latitude_of_projection_origin",lat0_lambert)!reference latitude, at which x=0 + if(status/=nf90_noerr) then + call check(nf90_inq_varid(ncid=ncFileID, name="projection_lambert", varID=varID)) + call check(nf90_get_att(ncFileID,varID,"latitude_of_projection_origin",lat0_lambert)) + endif + status = nf90_get_att(ncFileID,nf90_global,"longitude_of_central_meridian",lon0_lambert)!reference longitude + if(status/=nf90_noerr) then + call check(nf90_inq_varid(ncid=ncFileID, name="projection_lambert", varID=varID)) + call check(nf90_get_att(ncFileID,varID,"longitude_of_central_meridian",lon0_lambert)) + endif + status = nf90_get_att(ncFileID,nf90_global,"earth_radius",earth_radius_lambert)! + if(status/=nf90_noerr) then + call check(nf90_inq_varid(ncid=ncFileID, name="projection_lambert", varID=varID)) + call check(nf90_get_att(ncFileID,varID,"earth_radius",earth_radius_lambert)) + endif + !status = nf90_get_att(ncFileID,nf90_global,"standard_parallel",(/lat_stand1_lambert,lat_stand2_lambert/))!standard latitude at which mapping factor=1 + !default lat_stand1_lambert=lat_stand2_lambert=lat0_lambert + lat_stand1_lambert = lat0_lambert + lat_stand2_lambert = lat0_lambert endif - - status=nf90_inq_varid(ncid = ncFileID, name = "k", varID = varID) - if(status /= nf90_noerr)then - !always use hybrid coordinates at output, if hybrid in input - if(.not.USE_EtaCOORDINATES)then - write(*,*)'WARNING: using hybrid levels even if not asked to! ',trim(filename) - USE_EtaCOORDINATES=.true. - endif - if(MasterProc)write(*,*)'reading met hybrid levels from ',trim(filename) - ! call check(nf90_inq_varid(ncid = ncFileID, name = "hyam", varID = varID)) - ! call check(nf90_get_var(ncFileID, varID, A_mid )) - ! A_mid=P0*A_mid!different definition in modell and grid_Def - ! call check(nf90_inq_varid(ncid = ncFileID, name = "hybm", varID = varID)) - ! call check(nf90_get_var(ncFileID, varID,B_mid)) - status=nf90_inq_varid(ncid = ncFileID, name = "P0", varID = varID) - if(status /= nf90_noerr)then - status=nf90_inq_varid(ncid = ncFileID, name = "P00", varID = varID) !WRF case - if(status /= nf90_noerr)then - if(External_Levels_Def)then - write(*,*)'WARNING: did not find P0. Assuming vertical levels from ',trim(filename_vert) - else - write(*,*)'Do not know how to define vertical levels ' - call StopAll('Define levels in Vertical_levels.txt') - endif - else - !WRF - !asuming sigma levels ZNW=(P-P_TOP_MET)/(PS-P_TOP_MET) - !P = A+B*PS = P_TOP_MET*(1-ZNW) + ZNW*PS - !B = ZNW - !A = P_TOP_MET*(1-ZNW) - call check(nf90_get_var(ncFileID, varID, P0 )) - if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) - call check(nf90_inq_varid(ncid = ncFileID, name = "P_TOP", varID = varID)) - call check(nf90_get_var(ncFileID, varID, P_TOP_MET )) - call check(nf90_inq_varid(ncid = ncFileID, name = "ZNW", varID = varID)) - call check(nf90_get_var(ncFileID, varID, B_bnd_met )) - if(MET_REVERSE_K)then - A_bnd_met=B_bnd_met!use A_bnd_met as temporary buffer - do k=1,KMAX_MET+1 - B_bnd_met(k)=A_bnd_met(KMAX_MET+2-k) - enddo - endif - A_bnd_met=P_TOP_MET*(1.-B_bnd_met) - endif - if(MET_REVERSE_K)then - if(MasterProc)write(*,*)"Reversed vertical levels from met, P at levels boundaries:" - else - if(MasterProc)write(*,*)"Vertical levels from met, P at levels boundaries:" - endif - do k=1,KMAX_MET+1 - if(MasterProc)write(*,44)k, A_bnd_met(k)+P0*B_bnd_met(k) - enddo - else - call check(nf90_get_var(ncFileID, varID, P0 )) - if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) - call check(nf90_inq_varid(ncid = ncFileID, name = "hyai", varID = varID)) - call check(nf90_get_var(ncFileID, varID, A_bnd_met )) - A_bnd_met=P0*A_bnd_met!different definition in model and grid_Def - call check(nf90_inq_varid(ncid = ncFileID, name = "hybi", varID = varID)) - call check(nf90_get_var(ncFileID, varID, B_bnd_met )) - endif - if(External_Levels_Def)then - !model levels defined from external text file - if(MasterProc)write(*,*)'reading external hybrid levels from ',trim(filename_vert) - P0=Pref - do k=1,KMAX_MID+1 - read(IO_TMP,*)kk,A_bnd(k),B_bnd(k) - if(kk/=k.and.MasterProc)write(*,*)'WARNING: unexpected format for vertical levels ',k,kk - enddo - if(status /= nf90_noerr)then - !assume levels from metdata are defined in filename_vert - if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) - A_bnd_met=A_bnd - B_bnd_met=B_bnd - endif - else - !vertical model levels are the same as in meteo - A_bnd=A_bnd_met - B_bnd=B_bnd_met - endif - - do k=1,KMAX_MID - A_mid(k)=0.5*(A_bnd(k)+A_bnd(k+1)) - B_mid(k)=0.5*(B_bnd(k)+B_bnd(k+1)) - enddo - sigma_mid =B_mid!for Hybrid coordinates sigma_mid=B if A*P0=PT-sigma_mid*PT - - if(me==0)write(*,*)"Hybrid vertical coordinates, P at levels boundaries:" - do k=1,KMAX_MID+1 -44 FORMAT(i4,10F12.2) - if(me==0)write(*,44)k, A_bnd(k)+P0*B_bnd(k) - enddo - !test if the top is within the height defined in the meteo files - if(me==0.and.External_Levels_Def.and.(A_bnd(1)+P0*B_bnd(1)1.E-4)then + k_lambert = log(cos(deg2rad*lat_stand1_lambert)/cos(deg2rad*lat_stand2_lambert))/& + (log(tan(0.25*PI+0.5*deg2rad*lat_stand2_lambert)/tan(0.25*PI+0.5*deg2rad*lat_stand1_lambert))) + lat0_lambert = rad2deg*asin(k_lambert) + if(MasterProc)then + write(*,*)'first true latitude ',lat_stand1_lambert + write(*,*)'second true latitude ',lat_stand2_lambert + write(*,*)'latitude of projection origin calculated to ',lat0_lambert + end if else - call check(nf90_get_var(ncFileID, varID, sigma_mid )) + k_lambert = sin(deg2rad*lat0_lambert)! also called n endif - call check(nf90_close(ncFileID)) - - !TEMPORARY: definition of sigma. Only A and B will be used in the future - ! definition of the half-sigma levels (boundaries between layers) - ! from the full levels. - sigma_bnd(KMAX_BND) = 1. - do k = KMAX_MID,2,-1 - sigma_bnd(k) = 2.*sigma_mid(k) - sigma_bnd(k+1) - enddo - sigma_bnd(1) = 0. - - if(.not.(found_hybrid.or.Grid_Def_exist))then - !define A and B that gives the correspondin sigma - do k = 1,KMAX_BND - A_bnd(k)=PT * (1-sigma_bnd(k)) - B_bnd(k)=sigma_bnd(k) - enddo - do k = 1,KMAX_MID - A_mid(k)=(A_bnd(k+1)+A_bnd(k))/2.0 - B_mid(k)=(B_bnd(k+1)+B_bnd(k))/2.0 - enddo + F_lambert = cos(deg2rad*lat_stand1_lambert) & + * tan(0.25*PI+0.5*deg2rad*lat_stand1_lambert)**k_lambert /k_lambert!normalization constant + y0_lambert = F_lambert*tan(0.25*PI-0.5*deg2rad*lat0_lambert)**k_lambert!reference y coordinate, also called rho0 + if(USE_WRF_MET_NAMES)then + call check(nf90_inq_varid(ncid=ncFileID, name="XLONG", varID=varID)) + call check(nf90_get_var(ncFileID,varID,v,count=(/1/))) + call check(nf90_inq_varid(ncid=ncFileID, name="XLAT", varID=varID)) + call check(nf90_get_var(ncFileID,varID,u,count=(/1/))) + else + status = nf90_inq_varid(ncid=ncFileID, name="lon", varID=varID) + if(status/=nf90_noerr)& + call check(nf90_inq_varid(ncid=ncFileID, name="longitude", varID=varID)) + call check(nf90_get_var(ncFileID,varID,v,count=(/1/))) + x1_lambert=v(1) + status = nf90_inq_varid(ncid=ncFileID, name="lat", varID=varID) + if(status/=nf90_noerr)& + call check(nf90_inq_varid(ncid=ncFileID, name="latitude", varID=varID)) + call check(nf90_get_var(ncFileID,varID,v,count=(/1/))) + y1_lambert=v(1) endif - do k = 1,KMAX_MID - dA(k)=A_bnd(k+1)-A_bnd(k) - dB(k)=B_bnd(k+1)-B_bnd(k) - Eta_bnd(k)=A_bnd(k)/Pref+B_bnd(k) - Eta_mid(k)=A_mid(k)/Pref+B_mid(k) - dEta_i(k)=1.0/(dA(k)/Pref+dB(k)) - enddo - Eta_bnd(KMAX_MID+1)=A_bnd(KMAX_MID+1)/Pref+B_bnd(KMAX_MID+1) - if(me==0)write(*,*)'External_Levels ',External_Levels_Def - if(External_Levels_Def)call make_vertical_levels_interpolation_coeff - - do j=0,LJMAX - do i=0,LIMAX - x1=lon_ext(i,j) - x2=lon_ext(i+1,j) - x3=lon_ext(i,j+1) - x4=lon_ext(i+1,j+1) - - !8100=90*90; could use any number much larger than zero and much smaller than 180*180 - if(x1*x2<-8100.0 .or. x1*x3<-8100.0 .or. x1*x4<-8100.0)then - !Points are on both sides of the longitude -180=180 - if(x1<0)x1=x1+360.0 - if(x2<0)x2=x2+360.0 - if(x3<0)x3=x3+360.0 - if(x4<0)x4=x4+360.0 - endif - gl_stagg(i,j)=0.25*(x1+x2+x3+x4) - - gb_stagg(i,j)=0.25*(lat_ext(i,j)+& - lat_ext(i+1,j)+& - lat_ext(i,j+1)+& - lat_ext(i+1,j+1)) - enddo - enddo - - !ensure that lon values are within [-180,+180]] - do j=0,LJMAX - do i=0,LIMAX - if(gl_stagg(i,j)>180.0)gl_stagg(i,j)=gl_stagg(i,j)-360.0 - if(gl_stagg(i,j)<-180.0)gl_stagg(i,j)=gl_stagg(i,j)+360.0 - enddo - enddo - - !test if the grid is cyclicgrid: - !The last cell + 1 cell = first cell - Cyclicgrid=1 !Cyclicgrid - do j=1,ljmax - if(mod(nint(10*(360+GIMAX*(glon(2,j)-glon(1,j)))),3600)/=0)then - Cyclicgrid=0 !not cyclicgrid - endif - enddo - - if(MasterProc .and. DEBUG%GRIDVALUES)write(*,*)'CYCLICGRID:',Cyclicgrid - - !Look for poles - !If the northernmost or southernmost lines are poles, they are not - !considered as outer boundaries and will not be treated - !by "BoundaryConditions_ml". - !If the projection is not lat lon (i.e. the poles are not lines, but points), the poles are - !not a problem and Pole=0, even if the grid actually include a pole. - !Note that "Poles" is defined in subdomains - - North_pole=1 - do i=1,limax - if(nint(glat(i,ljmax))<=88)then - North_pole=0 !not north pole - endif + + x1_lambert=0.0 + y1_lambert=0.0 + call lb2ij(v(1),u(1),x1_lambert,y1_lambert) + x1_lambert = (x1_lambert-1)*GRIDWIDTH_M + y1_lambert = (y1_lambert-1)*GRIDWIDTH_M + ! test that (i,j)=(1,1) has the coordinates (1,1) + ! call lb2ij(v(1),u(1),v(2),u(2)) + ! write(*,*)v(2),u(2) + + if(MasterProc)then + write(*,*)"Lambert grid resolution (m) ",GRIDWIDTH_M + write(*,*)"x and y at (i,j)=(1,1)",x1_lambert,y1_lambert + write(*,*)"y0_lambert,F_lambert ",y0_lambert,F_lambert + end if + + !make lon lat and mapping factors + do j = 0, LJMAX+1 + y = (y1_lambert+(j_fdom(j)-1)*GRIDWIDTH_M)/EARTH_RADIUS + do i = 0, LIMAX+1 + x = (x1_lambert+(i_fdom(i)-1)*GRIDWIDTH_M)/EARTH_RADIUS + r = sqrt(x*x+(y0_lambert-y)*(y0_lambert-y)) + if(k_lambert<0.0)r = -r + t = atan(x/(y0_lambert-y)) + lat_ext(i,j) = 2*rad2deg*atan((F_lambert/r)**(1.0/k_lambert))-90.0 + lon_ext(i,j) = lon0_lambert + rad2deg*t/k_lambert + !does not work for lat = -90.0 + xm(i,j)=k_lambert*F_lambert& + *tan(PI*0.25-deg2rad*0.5*lat_ext(i,j))**(k_lambert-1)& + *0.5/(cos(PI*0.25-deg2rad*0.5*lat_ext(i,j))**2) + xm2(i,j) = xm(i,j)*xm(i,j) + xmd(i,j) = 1.0/xm2(i,j) + xm2ji(j,i) = xm2(i,j) + xmdji(j,i) = xmd(i,j) + enddo enddo - - South_pole=1 - do i=1,limax - if(nint(glat(i,1))>=-88)then - South_pole=0 !not south pole - endif + !staggered map factors + do j = 0, LJMAX+1 + y = (y1_lambert+(j_fdom(j)-1+0.5)*GRIDWIDTH_M)/EARTH_RADIUS + do i = 0, LIMAX+1 + x = (x1_lambert+(i_fdom(i)-1)*GRIDWIDTH_M)/EARTH_RADIUS + r = sqrt(x*x+(y0_lambert-y)*(y0_lambert-y)) + if(k_lambert<0.0)r = -r + lat = 2*rad2deg*atan((F_lambert/r)**(1.0/k_lambert))-90.0 + xm_i(i,j)=k_lambert*F_lambert& + *tan(PI*0.25-deg2rad*0.5*lat)**(k_lambert-1)& + *0.5/(cos(PI*0.25-deg2rad*0.5*lat)**2) + enddo enddo - - Poles=0 - if(North_pole==1)then - Poles(1)=1 - write(*,*)me,'Found North Pole' - endif - - if(South_pole==1)then - Poles(2)=1 - write(*,*)me,'Found South Pole' - endif - do j=1,LJMAX - do i=1,LIMAX - GridArea_m2(i,j) = GRIDWIDTH_M*GRIDWIDTH_M*xmd(i,j) - enddo + do j = 0, LJMAX+1 + y = (y1_lambert+(j_fdom(j)-1)*GRIDWIDTH_M)/EARTH_RADIUS + do i = 0, LIMAX+1 + x = (x1_lambert+(i_fdom(i)-1+0.5)*GRIDWIDTH_M)/EARTH_RADIUS + r = sqrt(x*x+(y0_lambert-y)*(y0_lambert-y)) + if(k_lambert<0.0)r = -r + lat = 2*rad2deg*atan((F_lambert/r)**(1.0/k_lambert))-90.0 + xm_j(i,j)=k_lambert*F_lambert& + *tan(PI*0.25-deg2rad*0.5*lat)**(k_lambert-1)& + *0.5/(cos(PI*0.25-deg2rad*0.5*lat)**2) + enddo enddo + case('lon lat') + if(.not. USE_WRF_MET_NAMES)then + !NB: lon and lat are stored as 1 dimensional arrays + call check(nf90_inq_varid(ncid=ncFileID, name="lon", varID=varID)) + + call check(nf90_get_var(ncFileID, varID, lon_ext(1:limax,1),& + start=(/gi0+IRUNBEG-1/),count=(/limax/) )) + if(LIMAX>limax)& + lon_ext(LIMAX,1)=lon_ext(limax,1)+(lon_ext(limax,1)-lon_ext(limax-1,1)) + lon_ext(0,1)=2*lon_ext(1,1)-lon_ext(2,1) + lon_ext(LIMAX+1,1)=2*lon_ext(LIMAX,1)-lon_ext(LIMAX-1,1) + do j=0,LJMAX+1 + lon_ext(:,j)=lon_ext(:,1) + end do + + call check(nf90_inq_varid(ncid=ncFileID,name="lat",varID=varID)) + call check(nf90_get_var(ncFileID, varID, lat_ext(1,1:ljmax),& + start=(/gj0+JRUNBEG-1/),count=(/ljmax/) )) + lat_ext(1,LJMAX)=min(90.0,lat_ext(1,LJMAX))!should never be used anyway + lat_ext(1,0)=2*lat_ext(1,1)-lat_ext(1,2) + lat_ext(1,LJMAX+1)=2*lat_ext(1,LJMAX)-lat_ext(1,LJMAX-1) + do i=0,LIMAX+1 + lat_ext(i,:)=lat_ext(1,:) + end do + else + !WRF format + call check(nf90_inq_varid(ncid=ncFileID, name="XLONG", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) + call check(nf90_inq_varid(ncid=ncFileID, name="XLAT", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) + end if + case('Rotated_Spherical') + status=nf90_get_att(ncFileID,nf90_global,"grid_north_pole_latitude",grid_north_pole_latitude) + if(status/=nf90_noerr)& ! WRF format + call check(nf90_get_att(ncFileID,nf90_global,"POLE_LAT",grid_north_pole_latitude)) + if(MasterProc)write(*,*)"grid_north_pole_latitude",grid_north_pole_latitude + status=nf90_get_att(ncFileID,nf90_global,"grid_north_pole_longitude",grid_north_pole_longitude) + if(status/=nf90_noerr) then + ! WRF format + call check(nf90_get_att(ncFileID,nf90_global,"POLE_LON",grid_north_pole_longitude)) + !find resolution in degrees from resolution in km. WRF uses Erath Radius 6370 km(?) + dx_rot=360./(6370000.*2*PI/GRIDWIDTH_M) + !round to 6 digits + dx_rot=0.000001*nint(1000000*dx_rot) + end if + if(MasterProc)write(*,*)"grid_north_pole_longitude",grid_north_pole_longitude + status=nf90_inq_varid(ncid=ncFileID, name="i", varID=varID) + if(status==nf90_noerr) then + call check(nf90_get_var(ncFileID, varID, v2))!note that i is one dimensional + x1_rot=v2(1) + dx_rot=v2(2)-v2(1) + call check(nf90_inq_varid(ncid=ncFileID, name="j", varID=varID)) + call check(nf90_get_var(ncFileID, varID, v2(1)))!note that j is one dimensional + y1_rot=v2(1) + call check(nf90_inq_varid(ncid=ncFileID, name="lon", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) + call check(nf90_inq_varid(ncid=ncFileID, name="lat", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) + else + ! WRF format + call check(nf90_inq_varid(ncid=ncFileID, name="XLONG", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) + call check(nf90_get_var(ncFileID, varID, v2,start=(/1,1/),count=(/1,1/) )) + glon_fdom1=v2(1) + ! glon=0.0!to get some value for outside subdomain too (when limax180.0)then + x1_rot=x1_rot-360.0 + else if(x1_rot<-180.0)then + x1_rot=x1_rot+360.0 + else + exit + end if + end do + ! call lb2ij(glon_fdom(1,1),glat_fdom(1,1),x,y) + ! write(*,*)'after ',glon_fdom(1,1),glat_fdom(1,1),x,y + ! call lb_rot2lb(x,y,x1_rot,y1_rot,grid_north_pole_longitude,grid_north_pole_latitude) + ! write(*,*)"spherical lon lat of (i,j)=(1,1)",x,y,glon_fdom(1,1),glat_fdom(1,1) + if(MasterProc)write(*,*)"rotated lon lat of (i,j)=(1,1)",x1_rot,y1_rot + if(MasterProc)write(*,*)"resolution",dx_rot + end if + dx_roti=1.0/dx_rot - if(me_calc>=0)then - gbacmax = maxval(glat(:,:)) - gbacmin = minval(glat(:,:)) - glacmax = maxval(glon(:,:)) - glacmin = minval(glon(:,:)) + case default + ! other projection? + call check(nf90_inq_varid(ncid=ncFileID, name="lon", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lon_ext,0,LIMAX+1,0,LJMAX+1) + call check(nf90_inq_varid(ncid=ncFileID, name="lat", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,lat_ext,0,LIMAX+1,0,LJMAX+1) + end select + + glon(1:LIMAX,1:LJMAX)=lon_ext(1:LIMAX,1:LJMAX) ! longitude + glat(1:LIMAX,1:LJMAX)=lat_ext(1:LIMAX,1:LJMAX) ! latitude + do j=1,LJMAX + do i=1,LIMAX + if(glon(i,j)>glmax)glon(i,j)=glon(i,j)-360.0 + if(glon(i,j)IIFULLDOM)iloc_end=IIFULLDOM+2-gi0-IRUNBEG!last cell + jloc_start=-1 + if(jloc_start+JRUNBEG+gj0-2<1)jloc_start=1!first cell (in j direction) + jloc_end=LJMAX+2 + if(jloc_end+JRUNBEG+gj0-2>JJFULLDOM)jloc_end=JJFULLDOM+2-gj0-JRUNBEG!last cell + + if(status==nf90_noerr)then + call nf90_get_var_extended(ncFileID,varID,xm_i_ext,-1,LIMAX+2,-1,LJMAX+2) else - gbacmax = -999.9 - gbacmin = 999.9 - glacmax = -999.9 - glacmin = 999.9 - endif - - CALL MPI_ALLREDUCE(gbacmax, mpi_out, 1,MPI_DOUBLE_PRECISION, & - MPI_MAX, MPI_COMM_WORLD, IERROR) - gbacmax=mpi_out - CALL MPI_ALLREDUCE(gbacmin, mpi_out, 1, & - MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_WORLD, IERROR) - gbacmin=mpi_out - CALL MPI_ALLREDUCE(glacmax, mpi_out, 1,MPI_DOUBLE_PRECISION, & - MPI_MAX, MPI_COMM_WORLD, IERROR) - glacmax=mpi_out - CALL MPI_ALLREDUCE(glacmin, mpi_out, 1, & - MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_WORLD, IERROR) - glacmin=mpi_out - if(MasterProc) write(unit=6,fmt="(a,40f9.2)") & - " GridValues: max/min for lat,lon ", & - gbacmax,gbacmin,glacmax,glacmin - - end subroutine Getgridparams - - - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - subroutine DefDebugProc() - !-------------------------------------------------------------------! - ! -------------- Find debug coords and processor ------------------ - !-------------------------------------------------------------------! - - integer :: i, j - - debug_proc = .false. - - do i = li0, li1 - do j = lj0, lj1 - if( i_fdom(i) == DEBUG%IJ(1) .and. j_fdom(j) == DEBUG%IJ(2) ) then - debug_li = i - debug_lj = j - debug_proc = .true. - end if - end do + !WRF format + call check(nf90_inq_varid(ncid=ncFileID, name="MAPFAC_VX", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,xm_i_ext,-1,LIMAX+2,-1,LJMAX+2,& + jshift_in=1) !NB:shift j by 1 since wrf start at bottom face + end if + + status=nf90_inq_varid(ncid=ncFileID, name="map_factor_j", varID=varID) + if(status==nf90_noerr)then + call nf90_get_var_extended(ncFileID,varID,xm_j_ext,-1,LIMAX+2,-1,LJMAX+2) + else + !WRF format + call check(nf90_inq_varid(ncid=ncFileID, name="MAPFAC_UY", varID=varID)) + call nf90_get_var_extended(ncFileID,varID,xm_j_ext,-1,LIMAX+2,-1,LJMAX+2,& + ishift_in=1) !NB:shift i by 1 since wrf start at left face + status = nf90_get_att(ncFileID,nf90_global,"DY",WRF_DY) + if(status==nf90_noerr) then + !WRF uses DY/MAPFAC_UY while emep uses GRIDWIDTH_M/xm_j for the y size + if(abs(GRIDWIDTH_M/WRF_DY-1.0)>1.E-6)then + if(MasterProc)write(*,*)"rescaling y mapfactors with = ",GRIDWIDTH_M/WRF_DY + xm_j_ext=xm_j_ext*GRIDWIDTH_M/WRF_DY + endif + else + if(MasterProc)write(*,*)"not rescaling y mapfactors" + endif + end if + + !define xm2, xm_i and xm_j now + !Note that xm is inverse length: interpolate 1/xm rather than xm + do j=0,LJMAX+1 + do i=0,LIMAX+1 + xm_i(i,j)=xm_i_ext(i,j) + xm_j(i,j)=xm_j_ext(i,j) + xm2(i,j) = 4.0*( (xm_i_ext(i,j-1)*xm_i_ext(i,j))/& + (xm_i_ext(i,j-1)+xm_i_ext(i,j)) )& + *( (xm_j_ext(i-1,j)*xm_j_ext(i,j))/& + (xm_j_ext(i-1,j)+xm_j_ext(i,j)) ) + xmd(i,j) =1.0/xm2(i,j) + xm2ji(j,i) = xm2(i,j) + xmdji(j,i) = xmd(i,j) + end do end do - - if(debug_proc) write(*,*) "GridValues debug_proc found:", & - me, debug_li, debug_lj - if(DEBUG%GRIDVALUES) then - if(MasterProc) write(*,"(a,2a4,a3,4a4,a2,2a4,4a12)") "GridValues debug:", & - "D_i", "D_j", "me", "li0", "li1", "lj0", "lj1", & - "dp" , "d_li", "d_lj", "i_fdom(li0)","i_fdom(li1)", & - "j_fdom(lj0)", "j_fdom(lj1)" - - write(*,"(a,2i4,i3,4i4,L2,2i4,4i12)") "GridValues debug:", & - DEBUG%IJ(1), DEBUG%IJ(2), me, li0, li1, lj0, lj1, & - debug_proc , debug_li, debug_lj, & - i_fdom(li0),i_fdom(li1), j_fdom(lj0), j_fdom(lj1) - endif - - end subroutine DefDebugProc - - - subroutine lb2ijm(imax,jmax,lon,lat,xr2,yr2,fi2,an2,xp2,yp2) - !-------------------------------------------------------------------! - ! calculates coordinates xr2, yr2 (real values) from glat(lat),glon(long) - ! - ! input: glon,glat: coord. of the polar point in grid1 - ! an2: number of grid-distances from pole to equator in grid2. - ! fi2: rotational angle for the grid2 (at i2=0). - ! i1max,j1max: number of points (grid1) in x- og y- direction - ! - ! - ! output: xr2(i1,j1): i coordinates in grid2 (with decimals) - ! yr2(i1,j1): j coordinates in grid2 (with decimals) - !-------------------------------------------------------------------! - - real, intent(in) :: lon(imax,jmax),lat(imax,jmax) - real, intent(out) :: xr2(imax,jmax),yr2(imax,jmax) - real, intent(in), optional :: fi2,an2,xp2,yp2 - integer, intent(in) :: imax,jmax - real :: fi_loc,an_loc,xp_loc,yp_loc - real, parameter :: PI=3.14159265358979323 - real :: PId4,dr,dr2,dist,dist2,dist3 - integer ::i,j,ip1,jp1, ir2, jr2,i1,j1 - - - if(projection=='Stereographic'.or.(present(fi2).and.present(an2).and.present(xp2).and.present(yp2)))then - PId4 =PI/4. - dr2 =PI/180.0/2. ! degrees to radians /2 - dr =PI/180.0 ! degrees to radians - fi_loc=fi - an_loc=an - xp_loc=xp - yp_loc=yp - - if(present(fi2))fi_loc=fi2 - if(present(an2))an_loc=an2 - if(present(xp2))xp_loc=xp2 - if(present(yp2))yp_loc=yp2 - do j1 = 1, jmax - do i1 = 1, imax - xr2(i1,j1)=xp_loc+an_loc*tan(PId4-lat(i1,j1)*dr2)*sin(dr*(lon(i1,j1)-fi_loc)) - yr2(i1,j1)=yp_loc-an_loc*tan(PId4-lat(i1,j1)*dr2)*cos(dr*(lon(i1,j1)-fi_loc)) - enddo - enddo - else if(projection=='lon lat')then! lon-lat grid - do j1 = 1, jmax - do i1 = 1, imax - xr2(i1,j1)=(lon(i1,j1)-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) - if(xr2(i1,j1)<0.5)xr2=xr2+360.0/(glon(2,1)-glon(1,1)) - yr2(i1,j1)=(lat(i1,j1)-glat(1,1))/(glat(1,2)-glat(1,1))+j_fdom(1) - enddo - enddo - else!general projection, Use only info from glon_fdom and glat_fdom - call StopAll('lb2ijm: not implemented yet') - !NB: glon_fdom is no more defined. Could easily rewrite if necessary - dist2=0.0 - dist3=0.0 - - !VERY SLOW, specially for large grids - do j1 = 1, jmax - do i1 = 1, imax - dist=10.0!max distance is PI - do j=1,JJFULLDOM - do i=1,IIFULLDOM -! if(dist>great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(i,j) & -! ,glat_fdom(i,j)))then -! dist=great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(i,j) & -! ,glat_fdom(i,j)) -! xr2(i1,j1)=i -! yr2(i1,j1)=j -! endif - enddo - enddo - - !find the real part of i and j by comparing distances to neighbouring cells - ! - ! C - ! /|\ - ! / | \ - ! / | \ - ! A---D---B - ! - !A=(i,j) ,B=(i+1,j), C=(glon,glat) - !dist=AC, dist2=BC, dist3=AB - !AD=(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3) - ! - ir2 = nint(xr2(i1,j1)) - jr2 = nint(yr2(i1,j1)) - ip1=ir2+1 - if(ip1>IIFULLDOM)ip1=ip1-2 -! dist2=great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(ip1,jr2),glat_fdom(ip1,jr2)) -! dist3=great_circle_distance( glon_fdom(ir2,jr2), & -! glat_fdom(ir2,jr2), & -! glon_fdom(ip1,jr2), & -! glat_fdom(ip1,jr2)) - - xr2(i1,j1)=xr2(i1,j1)+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) - - - jp1=jr2+1 - if(jp1>JJFULLDOM)jp1=jp1-2 - -! dist2=great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(ir2,jp1),glat_fdom(ir2,jp1)) - !GFORTRAN CHANGE -! dist3=great_circle_distance( glon_fdom(ir2,jr2), & -! glat_fdom(ir2,jr2), & -! glon_fdom(ir2,jp1), & -! glat_fdom(ir2,jp1) ) - - yr2(i1,j1)=yr2(i1,j1)+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) - - enddo - enddo - - endif - end subroutine lb2ijm - -subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) -!Note: this routine is not yet CPU optimized -!-------------------------------------------------------------------! -! calculates coordinates xr2, yr2 (real values) from gl(lat),gb(long) -! -! input: xp2,yp2: coord. of the polar point in grid2 -! an2: number of grid-distances from pole to equator in grid2. -! fi2: rotational angle for the grid2 (at i2=0). -! i1max,j1max: number of points (grid1) in x- og y- direction -! -! -! output: xr2(i1,j1): i coordinates in grid2 -! yr2(i1,j1): j coordinates in grid2 -!-------------------------------------------------------------------! - real, intent(in) :: gl2,gb2 + + end if + + status=nf90_inq_varid(ncid=ncFileID, name="k", varID=varID) + if(status/=nf90_noerr)then + !always use hybrid coordinates at output, if hybrid in input + if(.not.USE_EtaCOORDINATES)then + write(*,*)'WARNING: using hybrid levels even if not asked to! ',trim(filename) + USE_EtaCOORDINATES=.true. + end if + if(MasterProc)write(*,*)'reading met hybrid levels from ',trim(filename) + ! call check(nf90_inq_varid(ncid=ncFileID, name="hyam", varID=varID)) + ! call check(nf90_get_var(ncFileID, varID, A_mid )) + ! A_mid=P0*A_mid!different definition in modell and grid_Def + ! call check(nf90_inq_varid(ncid=ncFileID, name="hybm", varID=varID)) + ! call check(nf90_get_var(ncFileID, varID,B_mid)) + status=nf90_inq_varid(ncid=ncFileID, name="P0", varID=varID) + if(status/=nf90_noerr)& + status=nf90_inq_varid(ncid=ncFileID, name="p0", varID=varID) + if(status/=nf90_noerr)then + status=nf90_inq_varid(ncid=ncFileID, name="P00", varID=varID) !WRF case + if(status/=nf90_noerr)then + if(External_Levels_Def)then + write(*,*)'WARNING: did not find P0. Assuming vertical levels from ',trim(filename_vert) + else + write(*,*)'Do not know how to define vertical levels ' + call StopAll('Define levels in Vertical_levels.txt') + end if + else + ! WRF format + ! asuming sigma levels ZNW=(P-P_TOP_MET)/(PS-P_TOP_MET) + ! P = A+B*PS = P_TOP_MET*(1-ZNW) + ZNW*PS + ! B = ZNW + ! A = P_TOP_MET*(1-ZNW) + call check(nf90_get_var(ncFileID, varID, P0 )) + if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) + call check(nf90_inq_varid(ncid=ncFileID, name="P_TOP", varID=varID)) + call check(nf90_get_var(ncFileID, varID, P_TOP_MET )) + call check(nf90_inq_varid(ncid=ncFileID, name="ZNW", varID=varID)) + call check(nf90_get_var(ncFileID, varID, B_bnd_met )) + if(MET_REVERSE_K)then + A_bnd_met=B_bnd_met!use A_bnd_met as temporary buffer + do k=1,KMAX_MET+1 + B_bnd_met(k)=A_bnd_met(KMAX_MET+2-k) + end do + end if + A_bnd_met=P_TOP_MET*(1.-B_bnd_met) + found_metlevels=.true. + end if + if(MET_REVERSE_K)then + if(MasterProc)write(*,*)"Reversed vertical levels from met, P at levels boundaries:" + else + if(MasterProc)write(*,*)"Vertical levels from met, P at levels boundaries:" + end if + do k=1,KMAX_MET+1 + if(MasterProc)write(*,44)k, A_bnd_met(k)+P0*B_bnd_met(k) + end do + else + call check(nf90_get_var(ncFileID, varID, P0 )) + if(MasterProc)write(*,*)'P0 = ',P0 + if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) + status=nf90_inq_varid(ncid=ncFileID, name="hyai", varID=varID) + if(status/=nf90_noerr)then + call check(nf90_inq_varid(ncid=ncFileID, name="ap", varID=varID)) + call check(nf90_get_var(ncFileID, varID, A_bnd_met, count=(/KMAX_MET/)))!read mid values! + call check(nf90_inq_varid(ncid=ncFileID, name="b", varID=varID)) + call check(nf90_get_var(ncFileID, varID, B_bnd_met, count=(/KMAX_MET/) )) !read mid values! + A_bnd_met(KMAX_MET+1)=0.0 + B_bnd_met(KMAX_MET+1)=1.0 + do k=KMAX_MET,1,-1 + A_bnd_met(k)=A_bnd_met(k+1)-2.0*(A_bnd_met(k+1)-A_bnd_met(k))!from mid to bnd values! + B_bnd_met(k)=B_bnd_met(k+1)-2.0*(B_bnd_met(k+1)-B_bnd_met(k))!from mid to bnd values! + end do + + if(MasterProc)write(*,*)'Met hybrid vertical coordinates, P at levels boundaries:' + do k=1,KMAX_MET+1 + if(MasterProc)write(*,44)k, A_bnd_met(k)+P0*B_bnd_met(k) + end do + found_metlevels=.true. + + else + call check(nf90_get_var(ncFileID, varID, A_bnd_met )) + A_bnd_met=P0*A_bnd_met!different definition in model and grid_Def + call check(nf90_inq_varid(ncid=ncFileID, name="hybi", varID=varID)) + call check(nf90_get_var(ncFileID, varID, B_bnd_met )) + found_metlevels=.true. + end if + end if + if(External_Levels_Def)then + !model levels defined from external text file + if(MasterProc)& + write(*,*)'reading external hybrid levels from ',trim(filename_vert),& + A_bnd_met(kMAX_met-20),B_bnd_met(kMAX_met+1) + P0=Pref + do k=1,KMAX_MID+1 + read(IO_TMP,*)kk,A_bnd(k),B_bnd(k) + if(kk/=k.and.MasterProc)write(*,*)'WARNING: unexpected format for vertical levels ',k,kk + end do + if(MasterProc)write(*,*)'A_bnd_met A2',A_bnd_met(kMAX_met-20),B_bnd_met(kMAX_met+1) + + if(.not.found_metlevels)then + ! assume levels from metdata are defined in filename_vert + if(.not.allocated(A_bnd_met))allocate(A_bnd_met(KMAX_MET+1),B_bnd_met(KMAX_MET+1)) + A_bnd_met=A_bnd + B_bnd_met=B_bnd + end if + + else + !vertical model levels are the same as in meteo + A_bnd=A_bnd_met + B_bnd=B_bnd_met + end if + + do k=1,KMAX_MID + A_mid(k)=0.5*(A_bnd(k)+A_bnd(k+1)) + B_mid(k)=0.5*(B_bnd(k)+B_bnd(k+1)) + end do + sigma_mid =B_mid!for Hybrid coordinates sigma_mid=B if A*P0=PT-sigma_mid*PT + + if(MasterProc)write(*,*)"Hybrid vertical coordinates, P at levels boundaries:" + do k=1,KMAX_MID+1 +44 FORMAT(i4,10F12.2) + if(MasterProc)write(*,44)k, A_bnd(k)+P0*B_bnd(k) + end do + !test if the top is within the height defined in the meteo files + if(MasterProc.and.External_Levels_Def.and.(A_bnd(1)+P0*B_bnd(1)+0.01180.0)gl_stagg(i,j)=gl_stagg(i,j)-360.0 + if(gl_stagg(i,j)<-180.0)gl_stagg(i,j)=gl_stagg(i,j)+360.0 + end do + end do + + !test if the grid is cyclicgrid: + !The last cell + 1 cell = first cell + Cyclicgrid=1 !Cyclicgrid + do j=1,ljmax + if(mod(nint(10*(360+GIMAX*(glon(2,j)-glon(1,j)))),3600)/=0)then + Cyclicgrid=0 !not cyclicgrid + end if + end do + + if(MasterProc .and. DEBUG%GRIDVALUES)write(*,*)'CYCLICGRID:',Cyclicgrid + +! Look for poles +! If the northernmost or southernmost lines are poles, they are not considered +! as outer boundaries and will not be treated by "BoundaryConditions_ml". +! If the projection is not lat lon (i.e. the poles are not lines, but points), +! the poles are not a problem and Pole=0, even if the grid actually include a pole. +! Note that "Poles" is defined in subdomains + + North_pole=1 + do i=1,limax + if(nint(glat(i,ljmax))<=88)then + North_pole=0 !not north pole + end if + end do + + South_pole=1 + do i=1,limax + if(nint(glat(i,1))>=-88)then + South_pole=0 !not south pole + end if + end do + + Poles=0 + if(North_pole==1)then + Poles(1)=1 + write(*,*)me,'Found North Pole' + end if + + if(South_pole==1)then + Poles(2)=1 + write(*,*)me,'Found South Pole' + end if + do j=1,LJMAX + do i=1,LIMAX + GridArea_m2(i,j) = GRIDWIDTH_M*GRIDWIDTH_M*xmd(i,j) + end do + end do + + if(me_calc>=0)then + gbacmax = maxval(glat(:,:)) + gbacmin = minval(glat(:,:)) + glacmax = maxval(glon(:,:)) + glacmin = minval(glon(:,:)) + else + gbacmax = -999.9 + gbacmin = 999.9 + glacmax = -999.9 + glacmin = 999.9 + end if + + CALL MPI_ALLREDUCE(gbacmax, mpi_out, 1,MPI_DOUBLE_PRECISION, & + MPI_MAX, MPI_COMM_WORLD, IERROR) + gbacmax=mpi_out + CALL MPI_ALLREDUCE(gbacmin, mpi_out, 1, & + MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_WORLD, IERROR) + gbacmin=mpi_out + CALL MPI_ALLREDUCE(glacmax, mpi_out, 1,MPI_DOUBLE_PRECISION, & + MPI_MAX, MPI_COMM_WORLD, IERROR) + glacmax=mpi_out + CALL MPI_ALLREDUCE(glacmin, mpi_out, 1, & + MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_WORLD, IERROR) + glacmin=mpi_out + if(MasterProc) write(unit=6,fmt="(a,40f9.2)") & + " GridValues: max/min for lat,lon ", & + gbacmax,gbacmin,glacmax,glacmin + +end subroutine Getgridparams + +subroutine DefDebugProc() + ! Find debug coords and processor + + integer :: i, j + + debug_proc = .false. + + do i = li0, li1 + do j = lj0, lj1 + if( i_fdom(i)==DEBUG%IJ(1) .and. j_fdom(j)==DEBUG%IJ(2) ) then + debug_li = i + debug_lj = j + debug_proc = .true. + end if + end do + end do + + if(debug_proc) write(*,*) "GridValues debug_proc found:", & + me, debug_li, debug_lj + if(DEBUG%GRIDVALUES) then + if(MasterProc) write(*,"(a,2a4,a3,4a4,a2,2a4,4a12)") "GridValues debug:", & + "D_i", "D_j", "me", "li0", "li1", "lj0", "lj1", & + "dp" , "d_li", "d_lj", "i_fdom(li0)","i_fdom(li1)", & + "j_fdom(lj0)", "j_fdom(lj1)" + + write(*,"(a,2i4,i3,4i4,L2,2i4,4i12)") "GridValues debug:", & + DEBUG%IJ(1), DEBUG%IJ(2), me, li0, li1, lj0, lj1, & + debug_proc , debug_li, debug_lj, & + i_fdom(li0),i_fdom(li1), j_fdom(lj0), j_fdom(lj1) + end if + +end subroutine DefDebugProc + +subroutine lb2ijm(imax,jmax,lon,lat,xr2,yr2,fi2,an2,xp2,yp2) + !-------------------------------------------------------------------! + ! calculates coordinates xr2, yr2 (real values) from lat and lon + ! + ! input: glon,glat: coord. of the polar point in grid1 + ! an2: number of grid-distances from pole to equator in grid2. + ! fi2: rotational angle for the grid2 (at i2=0). + ! i1max,j1max: number of points (grid1) in x- og y- direction + ! + ! + ! output: xr2(i1,j1): i coordinates in grid2 (with decimals) + ! yr2(i1,j1): j coordinates in grid2 (with decimals) + !-------------------------------------------------------------------! + + integer, intent(in) :: imax,jmax + real, intent(in) :: lon(imax,jmax),lat(imax,jmax) + real, intent(out) :: xr2(imax,jmax),yr2(imax,jmax) + real, intent(in), optional :: fi2,an2,xp2,yp2 + real :: fi_loc,an_loc,xp_loc,yp_loc + real, parameter :: PI=3.14159265358979323 + real :: PId4,dr,dr2,dist,dist2,dist3 + integer ::i,j,ip1,jp1, ir2, jr2,i1,j1 + + if(projection=='Stereographic'.or.(present(fi2).and.present(an2).and.present(xp2).and.present(yp2)))then + PId4 =PI/4. + dr2 =PI/180.0/2. ! degrees to radians /2 + dr =PI/180.0 ! degrees to radians + fi_loc=fi + an_loc=an + xp_loc=xp + yp_loc=yp + + if(present(fi2))fi_loc=fi2 + if(present(an2))an_loc=an2 + if(present(xp2))xp_loc=xp2 + if(present(yp2))yp_loc=yp2 + do j1 = 1, jmax + do i1 = 1, imax + xr2(i1,j1)=xp_loc+an_loc*tan(PId4-lat(i1,j1)*dr2)*sin(dr*(lon(i1,j1)-fi_loc)) + yr2(i1,j1)=yp_loc-an_loc*tan(PId4-lat(i1,j1)*dr2)*cos(dr*(lon(i1,j1)-fi_loc)) + end do + end do + else if(projection=='lon lat')then! lon-lat grid + do j1 = 1, jmax + do i1 = 1, imax + xr2(i1,j1)=(lon(i1,j1)-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) + if(xr2(i1,j1)<0.5)xr2=xr2+360.0/(glon(2,1)-glon(1,1)) + yr2(i1,j1)=(lat(i1,j1)-glat(1,1))/(glat(1,2)-glat(1,1))+j_fdom(1) + end do + end do + else ! general projection, Use only info from glon_fdom and glat_fdom + call StopAll('lb2ijm: not implemented yet') + !NB: glon_fdom is no more defined. Could easily rewrite if necessary + dist2=0.0 + dist3=0.0 + + !VERY SLOW, specially for large grids + do j1 = 1, jmax + do i1 = 1, imax + dist=10.0!max distance is PI + do j=1,JJFULLDOM + do i=1,IIFULLDOM + ! if(dist>great_circle_distance(glon(i1,j1),glat(i1,j1),& + ! glon_fdom(i,j) ,glat_fdom(i,j)))then + ! dist=great_circle_distance(glon(i1,j1),glat(i1,j1), & + ! glon_fdom(i,j),glat_fdom(i,j)) + ! xr2(i1,j1)=i + ! yr2(i1,j1)=j + ! end if + end do + end do + + !find the real part of i and j by comparing distances to neighbouring cells + ! + ! C + ! /|\ + ! / | \ + ! / | \ + ! A---D---B + ! + !A=(i,j) ,B=(i+1,j), C=(glon,glat) + !dist=AC, dist2=BC, dist3=AB + !AD=(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3) + ! + ir2 = nint(xr2(i1,j1)) + jr2 = nint(yr2(i1,j1)) + ip1=ir2+1 + if(ip1>IIFULLDOM)ip1=ip1-2 + ! dist2=great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(ip1,jr2),glat_fdom(ip1,jr2)) + ! dist3=great_circle_distance( glon_fdom(ir2,jr2), & + ! glat_fdom(ir2,jr2), & + ! glon_fdom(ip1,jr2), & + ! glat_fdom(ip1,jr2)) + + xr2(i1,j1)=xr2(i1,j1)+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) + + + jp1=jr2+1 + if(jp1>JJFULLDOM)jp1=jp1-2 + + ! dist2=great_circle_distance(glon(i1,j1),glat(i1,j1),glon_fdom(ir2,jp1),glat_fdom(ir2,jp1)) + !GFORTRAN CHANGE + ! dist3=great_circle_distance( glon_fdom(ir2,jr2), & + ! glat_fdom(ir2,jr2), & + ! glon_fdom(ir2,jp1), & + ! glat_fdom(ir2,jp1) ) + + yr2(i1,j1)=yr2(i1,j1)+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) + + end do + end do + + end if +end subroutine lb2ijm + +subroutine lb2ij_real(gl,gb,xr2,yr2,fi2,an2,xp2,yp2) + ! Note: this routine is not yet CPU optimized + !-------------------------------------------------------------------! + ! calculates coordinates xr2, yr2 (real values) from gl(lon),gb(lat) + ! NB: xr2, yr2 are given in FULLDOMAIN coordinates + ! + ! input: xp2,yp2: coord. of the polar point in grid2 + ! an2: number of grid-distances from pole to equator in grid2. + ! fi2: rotational angle for the grid2 (at i2=0). + ! i1max,j1max: number of points (grid1) in x- og y- direction + ! + ! output: xr2(i1,j1): i coordinates in grid2 + ! yr2(i1,j1): j coordinates in grid2 + !-------------------------------------------------------------------! + real, intent(in) :: gl,gb real, intent(out) :: xr2,yr2 real, intent(in), optional :: fi2,an2,xp2,yp2 real :: fi_loc,an_loc,xp_loc,yp_loc - real, parameter :: PI=3.14159265358979323,dr=PI/180.0,dri= 180.0/PI - real :: PId4,dr2,dist,dist2,dist3 + real, parameter :: PI=3.14159265358979323,PId4=PI/4.0,dr=PI/180.0,dri= 180.0/PI,dr2=dr*0.5 + real :: dist,dist2,dist3,r integer ::i,j,ip1,jp1, ir2, jr2 real ::xscen ,yscen,zsycen,zcycen ,zxmxc,zsxmxc,zcxmxc,zsysph,zsyrot,yrot,zsxrot,zcysph,zcyrot,zcxrot,xrot +! real,save :: r_save,lat_save=-999.0 select case (projection) case('Stereographic') - PId4 =PI/4. - dr2 =dr*0.5 ! degrees to radians /2 fi_loc=fi an_loc=an xp_loc=xp @@ -1324,42 +1501,40 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) if(present(xp2))xp_loc=xp2 if(present(yp2))yp_loc=yp2 - xr2=xp_loc+an_loc*tan(PId4-gb2*dr2)*sin(dr*(gl2-fi_loc)) - yr2=yp_loc-an_loc*tan(PId4-gb2*dr2)*cos(dr*(gl2-fi_loc)) + xr2=xp_loc+an_loc*tan(0.25*PI-0.5*deg2rad*gb)*sin(deg2rad*(gl-fi_loc)) + yr2=yp_loc-an_loc*tan(0.25*PI-0.5*deg2rad*gb)*cos(deg2rad*(gl-fi_loc)) - case('lon lat') ! lon-lat grid - if((gl2-glon(1,1))+i_fdom(1)*(glon(2,1)-glon(1,1))<360.0)then - xr2=(gl2-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) - else - xr2=(gl2-360.0-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) - endif + case('lon lat') ! lon-lat grid + if((gl-glon(1,1))+i_fdom(1)*(glon(2,1)-glon(1,1))<360.0)then + xr2=(gl-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) + else + xr2=(gl-360.0-glon(1,1))/(glon(2,1)-glon(1,1))+i_fdom(1) + end if if(xr2<0.5)xr2=xr2+360.0/(glon(2,1)-glon(1,1)) - yr2=(gb2-glat(1,1))/(glat(1,2)-glat(1,1))+j_fdom(1) + yr2=(gb-glat(1,1))/(glat(1,2)-glat(1,1))+j_fdom(1) case('Rotated_Spherical') ! rotated lon-lat grid - ! dx_roti=20.0 - ! grid_north_pole_longitude = -170.0 - ! grid_north_pole_latitude = 40.0 + ! dx_roti=20.0 + ! grid_north_pole_longitude = -170.0 + ! grid_north_pole_latitude = 40.0 xscen = grid_north_pole_longitude-180.0 if(xscen<-180.0)xscen = xscen+360.0 yscen = 90.0-grid_north_pole_latitude - ! xscen=grid_north_pole_longitude-180.0 - ! yscen=90.0-grid_north_pole_latitude + ! xscen=grid_north_pole_longitude-180.0 + ! yscen=90.0-grid_north_pole_latitude zsycen = sin(dr*yscen) zcycen = cos(dr*yscen) - ! - zxmxc = dr*(gl2 - xscen) + zxmxc = dr*(gl - xscen) zsxmxc = sin(zxmxc) zcxmxc = cos(zxmxc) - zsysph = sin(dr*gb2) - zcysph = cos(dr*gb2) + zsysph = sin(dr*gb) + zcysph = cos(dr*gb) zsyrot = zcycen*zsysph - zsycen*zcysph*zcxmxc zsyrot = amax1(zsyrot,-1.0) zsyrot = amin1(zsyrot,+1.0) yrot = asin(zsyrot) zcyrot = cos(yrot) - zcxrot = (zcycen*zcysph*zcxmxc +& - zsycen*zsysph)/zcyrot + zcxrot = (zcycen*zcysph*zcxmxc + zsycen*zsysph)/zcyrot zcxrot = amax1(zcxrot,-1.0) zcxrot = amin1(zcxrot,+1.0) zsxrot = zcysph*zsxmxc/zcyrot @@ -1372,8 +1547,24 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) xr2=(xrot-x1_rot)*dx_roti+1 yr2=(yrot-y1_rot)*dx_roti+1 + case('lambert') ! lambert projection + ! if(gb==lat_save)then + ! r=r_save + ! else + ! r depends only on latitude -> reuse save a little, but not worth it? + r = F_lambert*tan(PId4-dr2*gb)**k_lambert + ! r_save=r + ! lat_save=gb + ! endif + xr2 = r*sin(dr*k_lambert*(gl-lon0_lambert)) + yr2 = y0_lambert - r*cos(dr*k_lambert*(gl-lon0_lambert)) + + !convert from x,y (erath radius=1) to i,j + xr2=(xr2*EARTH_RADIUS-x1_lambert)/GRIDWIDTH_M + 1 + yr2=(yr2*EARTH_RADIUS-y1_lambert)/GRIDWIDTH_M + 1 + case default ! general projection, Use only info from glon_fdom and glat_fdom - !first find closest by testing all gridcells. + !first find closest by testing all gridcells. call StopAll('lb2ij: conversion broken 27 Oct 2015, Peter') !glon_fdom is no more defined. Could easily rewrite if necessary dist2=0.0 @@ -1381,15 +1572,15 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) dist=10.0!max distance is PI do j=1,JJFULLDOM do i=1,IIFULLDOM -! if(dist>great_circle_distance(gl2,gb2,glon_fdom(i,j) & +! if(dist>great_circle_distance(gl,gb,glon_fdom(i,j) & ! ,glat_fdom(i,j)))then -! dist=great_circle_distance(gl2,gb2,glon_fdom(i,j) & +! dist=great_circle_distance(gl,gb,glon_fdom(i,j) & ! ,glat_fdom(i,j)) ! xr2=i ! yr2=j -! endif - enddo - enddo +! end if + end do + end do !find the real part of i and j by comparing distances to neighbouring cells ! @@ -1399,7 +1590,7 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) ! / | \ ! A---D---B ! - !A=(i,j) ,B=(i+1,j), C=(gl2,gb2) + !A=(i,j) ,B=(i+1,j), C=(gl,gb) !dist=AC, dist2=BC, dist3=AB !AD=(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3) ! @@ -1407,11 +1598,9 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) jr2 = nint(yr2) ip1=ir2+1 if(ip1>IIFULLDOM)ip1=ip1-2 -! dist2=great_circle_distance(gl2,gb2,glon_fdom(ip1,jr2),glat_fdom(ip1,jr2)) -! dist3=great_circle_distance( glon_fdom(ir2,jr2), & -! glat_fdom(ir2,jr2), & -! glon_fdom(ip1,jr2), & -! glat_fdom(ip1,jr2)) +! dist2=great_circle_distance(gl,gb,glon_fdom(ip1,jr2),glat_fdom(ip1,jr2)) +! dist3=great_circle_distance(glon_fdom(ir2,jr2),glat_fdom(ir2,jr2), & +! glon_fdom(ip1,jr2),glat_fdom(ip1,jr2)) xr2=xr2+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) @@ -1419,495 +1608,641 @@ subroutine lb2ij_real(gl2,gb2,xr2,yr2,fi2,an2,xp2,yp2) jp1=jr2+1 if(jp1>JJFULLDOM)jp1=jp1-2 -! dist2=great_circle_distance(gl2,gb2,glon_fdom(ir2,jp1),glat_fdom(ir2,jp1)) - !GFORTRAN CHANGE -! dist3=great_circle_distance( glon_fdom(ir2,jr2), & -! glat_fdom(ir2,jr2), & -! glon_fdom(ir2,jp1), & -! glat_fdom(ir2,jp1) ) +! dist2=great_circle_distance(gl,gb,glon_fdom(ir2,jp1),glat_fdom(ir2,jp1)) +! dist3=great_circle_distance(glon_fdom(ir2,jr2),glat_fdom(ir2,jr2), & +! glon_fdom(ir2,jp1),glat_fdom(ir2,jp1) ) yr2=yr2+(dist*dist+dist3*dist3-dist2*dist2)/(2*dist3*dist3) - endselect -endsubroutine lb2ij_real -subroutine lb2ij_int(gl2,gb2,ix,iy) - real, intent(in) :: gl2,gb2 + end select +end subroutine lb2ij_real +subroutine lb2ij_int(gl,gb,ix,iy) + real, intent(in) :: gl,gb !gl=lon, gb=lat integer, intent(out):: ix,iy real ::x,y ! stations can easily be defined exactly at gridcell boundaries -! 1.0E-7 is to ensure same rounding for all CPUs - call lb2ij_real(gl2,gb2,x,y) +! 1.0E-7 is to ensure same rounding for all situations + call lb2ij_real(gl,gb,x,y) ix=nint(x+1.0E-7) iy=nint(y+1.0E-7) -endsubroutine lb2ij_int - - subroutine ij2lbm(imax,jmax,glon,glat,fi,an,xp,yp) - !-------------------------------------------------------------------! - ! calculates l(lat),b(long) (geographical coord.) - ! in every grid point. - ! - ! input: xp,yp: coord. of the polar point. - ! an: number of grid-distances from pole to equator. - ! fi: rotational angle for the x,y grid (at i=0). - ! imax,jmax: number of points in x- og y- direction - ! glmin: gives min.value of geographical lenght - ! => glmin <= l <= glmin+360. - ! (example glmin = -180. or 0.) - ! if "geopos","georek" is used - ! then glmin must be the lenght i(1,1) in the - ! geographical grid (gl1 to "geopos") - ! output: gl(ii,jj): longitude glmin <= l <= glmin+360. - ! gb(ii,jj): latitude -90. <= b <= +90. - !-------------------------------------------------------------------! - - integer :: i, j, imax, jmax - real :: glon(imax,jmax),glat(imax,jmax) - real :: fi, an, xp, yp - real :: om, om2, glmin, glmax,dy, dy2,rp,rb, rl, dx, dr - real, parameter :: PI=3.14159265358979323 - - glmin = -180.0 - - glmax = glmin + 360.0 - dr = PI/180.0 ! degrees to radians - om = 180.0/PI ! radians to degrees (om=Norwegian omvendt?) - om2 = om * 2.0 - - do j = 1, jmax - dy = yp - j - dy2 = dy*dy - do i = 1, imax - - dx = i - xp ! ds - changed - rp = sqrt(dx*dx+dy2) ! => distance to pole - rb = 90.0 - om2 * atan(rp/AN) ! => latitude - rl = 0.0 - if (rp > 1.0e-10) rl = fi + om*atan2(dx,dy) - if (rl < glmin) rl = rl + 360.0 - if (rl > glmax) rl = rl - 360.0 - glon(i,j)=rl ! longitude - glat(i,j)=rb ! latitude - end do ! i - end do ! j - - end subroutine ij2lbm - - subroutine ij2lb(i,j,lon,lat,fi,an,xp,yp) - !-------------------------------------------------------------------! - ! calculates l(lat),b(long) (geographical coord.) - ! from i,j coordinates in polar stereographic projection - ! - ! input: i,j - ! xp,yp: coord. of the polar point. - ! an: number of grid-distances from pole to equator. - ! fi: rotational angle for the x,y grid (at i=0). - ! imax,jmax: number of points in x- og y- direction - ! glmin: gives min.value of geographical lenght - ! => glmin <= l <= glmin+360. - ! (example glmin = -180. or 0.) - ! if "geopos","georek" is used - ! then glmin must be the lenght i(1,1) in the - ! geographical grid (gl1 to "geopos") - ! output: lon: longitude glmin <= lon <= glmin+360. - ! lat: latitude -90. <= lat <= +90. - !-------------------------------------------------------------------! - - integer :: i, j - real :: lon,lat - real :: fi, an, xp, yp - real :: om, om2, glmin, glmax,dy, dy2,rp,rb, rl, dx, dr - real, parameter :: PI=3.14159265358979323 - - glmin = -180.0 - - glmax = glmin + 360.0 - dr = PI/180.0 ! degrees to radians - om = 180.0/PI ! radians to degrees (om=Norwegian omvendt?) - om2 = om * 2.0 - - ! do j = 1, jmax - dy = yp - j +end subroutine lb2ij_int + +subroutine ij2lbm(imax,jmax,glon,glat,fi,an,xp,yp) + !-------------------------------------------------------------------! + ! calculates lon and lat (geographical coord.) + ! in every grid point for a polarsteraographic projection. + ! + ! input: xp,yp: coord. of the polar point. + ! an: number of grid-distances from pole to equator. + ! fi: rotational angle for the x,y grid (at i=0). + ! imax,jmax: number of points in x- og y- direction + ! glmin: gives min.value of geographical lenght + ! => glmin <= l <= glmin+360. + ! (example glmin = -180. or 0.) + ! if "geopos","georek" is used + ! then glmin must be the lenght i(1,1) in the + ! geographical grid (gl1 to "geopos") + ! output: gl(ii,jj): longitude glmin <= l <= glmin+360. + ! gb(ii,jj): latitude -90. <= b <= +90. + !-------------------------------------------------------------------! + + integer :: i, j, imax, jmax + real :: glon(imax,jmax),glat(imax,jmax) + real :: fi, an, xp, yp + real :: om, om2, glmin, glmax,dy, dy2,rp,rb, rl, dx, dr + real, parameter :: PI=3.14159265358979323 + + glmin = -180.0 + + glmax = glmin + 360.0 + dr = PI/180.0 ! degrees to radians + om = 180.0/PI ! radians to degrees (om=Norwegian omvendt?) + om2 = om * 2.0 + + do j = 1, jmax + dy = yp - j dy2 = dy*dy - ! do i = 1, imax - - dx = i - xp ! ds - changed - rp = sqrt(dx*dx+dy2) ! => distance to pole - rb = 90.0 - om2 * atan(rp/AN) ! => latitude - rl = 0.0 - if (rp > 1.0e-10) rl = fi + om*atan2(dx,dy) - if (rl < glmin) rl = rl + 360.0 - if (rl > glmax) rl = rl - 360.0 - lon=rl ! longitude - lat=rb ! latitude - ! end do ! i - ! end do ! j - - end subroutine ij2lb - - subroutine ij2ijm(in_field,imaxin,jmaxin,out_field,imaxout,jmaxout, & - fiin,anin,xpin,ypin,fiout,anout,xpout,ypout) - - ! Converts data (in_field) stored in coordinates (fiin,anin,xpin,ypin) - ! into data (out_field) in coordinates (fiout,anout,xpout,ypout) - ! pw august 2002 - - - integer, intent(in) :: imaxin,jmaxin,imaxout,jmaxout - real, intent(in) :: fiin,anin,xpin,ypin,fiout,anout,xpout,ypout - real, intent(in) :: in_field(imaxin,jmaxin)! Field to be transformed - real, intent(out) :: out_field(imaxout,jmaxout)! Field to be transformed - - real, allocatable,dimension(:,:) :: x,y,glat,glon - integer alloc_err,i,j,i2,j2 - logical :: interpolate - real :: f11,f12,f21,f22 - - interpolate = .true. - ! interpolate = .false. - - allocate(x(imaxout,jmaxout), stat=alloc_err) - allocate(y(imaxout,jmaxout), stat=alloc_err) - allocate(glat(imaxout,jmaxout), stat=alloc_err) - allocate(glon(imaxout,jmaxout), stat=alloc_err) - if ( alloc_err /= 0 ) WRITE(*,*) 'MPI_ABORT: ', "ij2ij alloc failed" - if ( alloc_err /= 0 ) call MPI_ABORT(MPI_COMM_CALC,9,IERROR) - - ! find longitude, latitude of wanted area - call ij2lbm(imaxout,jmaxout,glon,glat,fiout,anout,xpout,ypout) - - ! find corresponding coordinates (i,j) in in_field coordinates - call lb2ijm(imaxout,jmaxout,glon,glat,x,y,fiin,anin,xpin,ypin) - - - ! check if the corners of the domain are inside the area covered by the - ! in_grid: (In principle we should test for all i,j , but test the corners - ! should be good enough in practice) - - if(int(x(1,1)) < 1 .or. int(x(1,1))+1 > imaxin .or. & - int(x(imaxout,1)) < 1 .or. int(x(imaxout,1))+1 > imaxin .or. & - int(x(1,jmaxout)) < 1 .or. int(x(1,jmaxout))+1 > imaxin .or. & - int(x(imaxout,jmaxout)) < 1 .or. & - int(x(imaxout,jmaxout))+1 > imaxin .or. & - int(y(1,1)) < 1 .or. int(y(1,1))+1 > jmaxin .or. & - int(y(imaxout,1)) < 1 .or. int(y(imaxout,1))+1 > jmaxin .or. & - int(y(1,jmaxout)) < 1 .or. int(y(1,jmaxout))+1 > jmaxin .or. & - int(y(imaxout,jmaxout)) < 1 .or. & - int(y(imaxout,jmaxout))+1 > jmaxin ) then - write(*,*)'Did not find all the necessary data in in_field' - write(*,*)'values needed: ' - write(*,*)x(1,1),y(1,1) - write(*,*)x(imaxout,1),y(imaxout,1) - write(*,*)x(1,jmaxout),y(1,jmaxout) - write(*,*)x(imaxout,jmaxout),y(imaxout,jmaxout) - write(*,*)'max values found: ',imaxin ,jmaxin - write(*,*) 'MPI_ABORT: ', "ij2ij: area to small" - call MPI_ABORT(MPI_COMM_CALC,9,IERROR) - endif - - - ! interpolate fields if required - - if(interpolate)then - do j = 1, jmaxout - do i = 1,imaxout - i2=int(x(i,j)) - j2=int(y(i,j)) - f11=(1.-(x(i,j)-i2))*(1.-(y(i,j)-j2)) - f12=(1.-(x(i,j)-i2))*((y(i,j)-j2)) - f21=((x(i,j)-i2))*(1.-(y(i,j)-j2)) - f22=((x(i,j)-i2))*((y(i,j)-j2)) - - out_field(i,j) = & - f11 * in_field(i2,j2) + & - f12 * in_field(i2,j2+1) + & - f21 * in_field(i2+1,j2) + & - f22 * in_field(i2+1,j2+1) - - enddo - enddo - else - - do j = 1, jmaxout - do i = 1,imaxout - out_field(i,j) =in_field(nint(x(i,j)),nint(y(i,j))) - enddo - enddo - - endif - - deallocate(x,stat=alloc_err) - deallocate(y,stat=alloc_err) - deallocate(glat,stat=alloc_err) - deallocate(glon,stat=alloc_err) - if ( alloc_err /= 0 ) WRITE(*,*) 'MPI_ABORT: ', "ij2ijde-alloc_err" - if ( alloc_err /= 0 ) call MPI_ABORT(MPI_COMM_CALC,9,IERROR) - - end subroutine ij2ijm - - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - subroutine range_check(vname,var,vrange,fatal) - character(len=*), intent(in) :: vname - real, intent(in) :: var,vrange(0:1) - logical :: fatal - character(len=*), parameter :: & - errfmt="(A,'=',F6.2,' is out of range ',F6.2,'..',F6.2)" - character(len=len_trim(vname)+21+6*3) :: errmsg - if(varvrange(1))then - write(errmsg,errfmt)trim(vname),var,vrange - if(fatal)then - call CheckStop("range_check",trim(errmsg)) - else - write(*,*)"WARNING: ",trim(errmsg) - endif - endif - endsubroutine range_check - subroutine coord_check(msg,lon,lat,fix) - !-------------------------------------------------------------------! - ! lon/lat range check. - ! Some longitude range errors can be corrected, when fix=.true. - ! Latitude range errors are always fatal. - !-------------------------------------------------------------------! - character(len=*), intent(in) :: msg - real, intent(inout) :: lon,lat - logical :: fix - call range_check(trim(msg)//" lat",lat,(/ -90.0, 90.0/),fatal=.true.) - call range_check(trim(msg)//" lon",lon,(/-180.0,180.0/),fatal=.not.fix) - if(fix)then - !! lat=mod (lat , 90.0) ! lat/gb_stagg range -90 .. 90 - lon=modulo(lon+180.0,360.0)-180.0 ! lon/gl_stagg range -180 .. 180 - call range_check(trim(msg)//" lon",lon,(/-180.0,180.0/),fatal=.true.) - endif - endsubroutine coord_check - function coord_in_domain(domain,lon,lat,iloc,jloc,iglob,jglob) result(in) - !-------------------------------------------------------------------! - ! Is coord (lon/lat) is inside global domain|local domain|grid cell? - !-------------------------------------------------------------------! - character(len=*), intent(in) :: domain - real, intent(inout) :: lon,lat - integer, intent(inout),optional :: iloc,jloc - integer, intent(out) ,optional :: iglob,jglob - logical :: in - integer :: i,j - call coord_check("coord_in_"//trim(domain),lon,lat,fix=.true.) - call lb2ij(lon,lat,i,j) - if(present(iglob))iglob=i - if(present(jglob))jglob=j - in=(i>=1).and.(i<=IIFULLDOM).and.(j>=1).and.(j<=JJFULLDOM) - i=max(1,min(i,IIFULLDOM));i=i_local(i) - j=max(1,min(j,JJFULLDOM));j=j_local(j) - select case(domain) - case("g","G","global","full") - if(present(iloc))iloc=i - if(present(jloc))jloc=j - case("l","L","local","processor") - if(in) in=(i>=1).and.(i<=limax).and.(j>=1).and.(j<=ljmax) - if(present(iloc))iloc=i - if(present(jloc))jloc=j - case("c","C","cell","gridbox") - call CheckStop(.not.(present(iloc).and.present(jloc)),& - "Wrong options for coord_in_"//trim(domain)) - if(in) in=(i==iloc).and.(j==jloc) - case default - call CheckStop("Unsupporter coord_in_"//trim(domain)) - endselect - endfunction coord_in_domain - function coord_in_processor(lon,lat,iloc,jloc,iglob,jglob) result(in) - !-------------------------------------------------------------------! - ! Is coord (lon/lat) is inside local domain? - !-------------------------------------------------------------------! - real, intent(inout) :: lon,lat - integer, intent(out),optional:: iloc,jloc,iglob,jglob - logical :: in - in=coord_in_domain("processor",lon,lat,iloc,jloc,iglob,jglob) - endfunction coord_in_processor - function coord_in_gridbox(lon,lat,iloc,jloc,iglob,jglob) result(in) - !-------------------------------------------------------------------! - ! Is coord (lon/lat) is inside gridbox(iloc,jloc)? - !-------------------------------------------------------------------! - real, intent(inout) :: lon,lat - integer, intent(inout) :: iloc,jloc - integer, intent(out),optional:: iglob,jglob - logical :: in - in=coord_in_domain("gridbox",lon,lat,iloc,jloc,iglob,jglob) - endfunction coord_in_gridbox - - subroutine Alloc_GridFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND) - - integer, intent(in)::LIMAX,LJMAX,KMAX_MID,KMAX_BND - - allocate(i_fdom(0:LIMAX+1)) - allocate(j_fdom(0:LJMAX+1)) - allocate(glon(LIMAX,LJMAX)) - allocate(glat(LIMAX,LJMAX)) - allocate(gl_stagg(0:LIMAX,0:LJMAX)) - allocate(gb_stagg(0:LIMAX,0:LJMAX)) - allocate(xm_i(0:LIMAX+1,0:LJMAX+1)) - allocate(xm_j(0:LIMAX+1,0:LJMAX+1)) - allocate(xm2(0:LIMAX+1,0:LJMAX+1)) - allocate(xmd(0:LIMAX+1,0:LJMAX+1)) - allocate(xm2ji(0:LJMAX+1,0:LIMAX+1)) - allocate(xmdji(0:LJMAX+1,0:LIMAX+1)) - allocate(GridArea_m2(LIMAX,LJMAX)) - allocate(z_bnd(LIMAX,LJMAX,KMAX_BND)) - allocate(z_mid(LIMAX,LJMAX,KMAX_MID)) - - end subroutine Alloc_GridFields - - subroutine make_vertical_levels_interpolation_coeff - !make interpolation coefficients to convert the levels defined in meteo - !into the levels defined in Vertical_levels.txt - integer ::k,k_met - real ::p_met,p_mod,p1,p2 - if(.not. allocated(k1_met))allocate(k1_met(KMAX_MID),k2_met(KMAX_MID),x_k1_met(KMAX_MID)) - if(.not. allocated(A_bnd_met))then - allocate(A_bnd_met(KMAX_MID+1),B_bnd_met(KMAX_MID+1)) - A_bnd_met=A_bnd - B_bnd_met=B_bnd - endif - - if(me_mpi==0)then - - !only me=0 has the values for A_bnd_met and B_bnd_met - do k=1,KMAX_MID - P_mod=A_mid(k)+Pref*B_mid(k) - !find the lowest met level higher than the model level - !do k_met=1,KMAX_MET - k_met=KMAX_MET-1 - p_met=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) - do while(p_met>P_mod.and.k_met>1) - ! write(*,*)P_mod,p_met - k_met=k_met-1 - p_met=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) - enddo - k1_met(k)=k_met - k2_met(k)=k_met+1 - k_met=k1_met(k) - p1=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) - k_met=k2_met(k) - p2=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) - x_k1_met(k)=(p_mod-p2)/(p1-p2) - write(*,77)k, ' interpolated from levels ', k1_met(k),' and ',k2_met(k),P_mod,p1,p2,x_k1_met(k) -77 format(I4,A,I3,A,I3,13f11.3) - if(x_k1_met(k)<-0.00001 .or. (1.0-x_k1_met(k))<-0.00001)then - write(*,*)'WARNING: Extrapolation of data. This is NOT recommended for several metfields' - endif - - enddo + do i = 1, imax + + dx = i - xp ! ds - changed + rp = sqrt(dx*dx+dy2) ! => distance to pole + rb = 90.0 - om2 * atan(rp/AN) ! => latitude + rl = 0.0 + if (rp > 1.0e-10) rl = fi + om*atan2(dx,dy) + if (rl < glmin) rl = rl + 360.0 + if (rl > glmax) rl = rl - 360.0 + glon(i,j)=rl ! longitude + glat(i,j)=rb ! latitude + end do ! i + end do ! j + +end subroutine ij2lbm + +subroutine ij2lb(i,j,lon,lat,fi,an,xp,yp) + !-------------------------------------------------------------------! + ! calculates lon and lat (geographical coord.) + ! from i,j coordinates in polar stereographic projection + ! + ! input: i,j + ! xp,yp: coord. of the polar point. + ! an: number of grid-distances from pole to equator. + ! fi: rotational angle for the x,y grid (at i=0). + ! imax,jmax: number of points in x- og y- direction + ! glmin: gives min.value of geographical lenght + ! => glmin <= l <= glmin+360. + ! (example glmin = -180. or 0.) + ! if "geopos","georek" is used + ! then glmin must be the lenght i(1,1) in the + ! geographical grid (gl1 to "geopos") + ! output: lon: longitude glmin <= lon <= glmin+360. + ! lat: latitude -90. <= lat <= +90. + !-------------------------------------------------------------------! + + integer :: i, j + real :: lon,lat + real :: fi, an, xp, yp + real :: om, om2, glmin, glmax,dy, dy2,rp,rb, rl, dx, dr + real, parameter :: PI=3.14159265358979323 + + glmin = -180.0 + + glmax = glmin + 360.0 + dr = PI/180.0 ! degrees to radians + om = 180.0/PI ! radians to degrees (om=Norwegian omvendt?) + om2 = om * 2.0 + + dy = yp - j + dy2 = dy*dy + + dx = i - xp ! ds - changed + rp = sqrt(dx*dx+dy2) ! => distance to pole + rb = 90.0 - om2 * atan(rp/AN) ! => latitude + rl = 0.0 + if (rp > 1.0e-10) rl = fi + om*atan2(dx,dy) + if (rl < glmin) rl = rl + 360.0 + if (rl > glmax) rl = rl - 360.0 + lon=rl ! longitude + lat=rb ! latitude +end subroutine ij2lb + +subroutine ij2ijm(in_field,imaxin,jmaxin,out_field,imaxout,jmaxout, & + fiin,anin,xpin,ypin,fiout,anout,xpout,ypout) + ! Converts data (in_field) stored in polar stereo coordinates + ! with parameters "fiin,anin,xpin,ypin," + ! into data (out_field) in polar stereo coordinates with parameters + ! "fiout,anout,xpout,ypout" + + integer, intent(in) :: imaxin,jmaxin,imaxout,jmaxout + real, intent(in) :: fiin,anin,xpin,ypin,fiout,anout,xpout,ypout + real, intent(in) :: in_field(imaxin,jmaxin)! Field to be transformed + real, intent(out) :: out_field(imaxout,jmaxout)! Field to be transformed + + real, allocatable,dimension(:,:) :: x,y,glat,glon + integer alloc_err,i,j,i2,j2 + logical :: interpolate + real :: f11,f12,f21,f22 + + interpolate = .true. + + allocate(x(imaxout,jmaxout), stat=alloc_err) + allocate(y(imaxout,jmaxout), stat=alloc_err) + allocate(glat(imaxout,jmaxout), stat=alloc_err) + allocate(glon(imaxout,jmaxout), stat=alloc_err) + if ( alloc_err/=0 ) WRITE(*,*) 'MPI_ABORT: ', "ij2ij alloc failed" + if ( alloc_err/=0 ) call MPI_ABORT(MPI_COMM_CALC,9,IERROR) + + ! find longitude, latitude of wanted area + call ij2lbm(imaxout,jmaxout,glon,glat,fiout,anout,xpout,ypout) + + ! find corresponding coordinates (i,j) in in_field coordinates + call lb2ijm(imaxout,jmaxout,glon,glat,x,y,fiin,anin,xpin,ypin) + + + ! check if the corners of the domain are inside the area covered by the + ! in_grid: (In principle we should test for all i,j , but test the corners + ! should be good enough in practice) + + if(int(x(1,1)) < 1 .or. int(x(1,1))+1 > imaxin .or. & + int(x(imaxout,1)) < 1 .or. int(x(imaxout,1))+1 > imaxin .or. & + int(x(1,jmaxout)) < 1 .or. int(x(1,jmaxout))+1 > imaxin .or. & + int(x(imaxout,jmaxout)) < 1 .or. & + int(x(imaxout,jmaxout))+1 > imaxin .or. & + int(y(1,1)) < 1 .or. int(y(1,1))+1 > jmaxin .or. & + int(y(imaxout,1)) < 1 .or. int(y(imaxout,1))+1 > jmaxin .or. & + int(y(1,jmaxout)) < 1 .or. int(y(1,jmaxout))+1 > jmaxin .or. & + int(y(imaxout,jmaxout)) < 1 .or. & + int(y(imaxout,jmaxout))+1 > jmaxin ) then + write(*,*)'Did not find all the necessary data in in_field' + write(*,*)'values needed: ' + write(*,*)x(1,1),y(1,1) + write(*,*)x(imaxout,1),y(imaxout,1) + write(*,*)x(1,jmaxout),y(1,jmaxout) + write(*,*)x(imaxout,jmaxout),y(imaxout,jmaxout) + write(*,*)'max values found: ',imaxin ,jmaxin + write(*,*) 'MPI_ABORT: ', "ij2ij: area to small" + call MPI_ABORT(MPI_COMM_CALC,9,IERROR) + end if + + + ! interpolate fields if required + + if(interpolate)then + do j = 1, jmaxout + do i = 1,imaxout + i2=int(x(i,j)) + j2=int(y(i,j)) + f11=(1.-(x(i,j)-i2))*(1.-(y(i,j)-j2)) + f12=(1.-(x(i,j)-i2))*((y(i,j)-j2)) + f21=((x(i,j)-i2))*(1.-(y(i,j)-j2)) + f22=((x(i,j)-i2))*((y(i,j)-j2)) + + out_field(i,j) = & + f11 * in_field(i2,j2) + & + f12 * in_field(i2,j2+1) + & + f21 * in_field(i2+1,j2) + & + f22 * in_field(i2+1,j2+1) + + end do + end do + else + do j = 1, jmaxout + do i = 1,imaxout + out_field(i,j) =in_field(nint(x(i,j)),nint(y(i,j))) + end do + end do + end if + + deallocate(x,stat=alloc_err) + deallocate(y,stat=alloc_err) + deallocate(glat,stat=alloc_err) + deallocate(glon,stat=alloc_err) + if(alloc_err/=0)then + WRITE(*,*) 'MPI_ABORT: ', "ij2ijde-alloc_err" + call MPI_ABORT(MPI_COMM_CALC,9,IERROR) + end if + +end subroutine ij2ijm + +subroutine range_check(vname,var,vrange,fatal) + character(len=*), intent(in) :: vname + real, intent(in) :: var,vrange(0:1) + logical :: fatal + character(len=*), parameter :: & + errfmt="(A,'=',F6.2,' is out of range ',F6.2,'..',F6.2)" + character(len=len_trim(vname)+21+6*3) :: errmsg + if(varvrange(1))then + write(errmsg,errfmt)trim(vname),var,vrange + if(fatal)then + call CheckStop("range_check",trim(errmsg)) + else + write(*,*)"WARNING: ",trim(errmsg) + end if + end if +end subroutine range_check +subroutine coord_check(msg,lon,lat,fix) + !-------------------------------------------------------------------! + ! lon/lat range check. + ! Some longitude range errors can be corrected, when fix=.true. + ! Latitude range errors are always fatal. + !-------------------------------------------------------------------! + character(len=*), intent(in) :: msg + real, intent(inout) :: lon,lat + logical :: fix + call range_check(trim(msg)//" lat",lat,(/ -90.0, 90.0/),fatal=.true.) + call range_check(trim(msg)//" lon",lon,(/-180.0,180.0/),fatal=.not.fix) + if(fix)then + lon=modulo(lon+180.0,360.0)-180.0 ! lon/gl_stagg range -180 .. 180 + call range_check(trim(msg)//" lon",lon,(/-180.0,180.0/),fatal=.true.) + end if +end subroutine coord_check +function coord_in_domain(domain,lon,lat,iloc,jloc,iglob,jglob) result(in) + !-------------------------------------------------------------------! + ! Is coord (lon/lat) is inside global domain|local domain|grid cell? + !-------------------------------------------------------------------! + character(len=*), intent(in) :: domain + real, intent(inout) :: lon,lat + integer, intent(inout),optional :: iloc,jloc + integer, intent(out) ,optional :: iglob,jglob + logical :: in + integer :: i,j + call coord_check("coord_in_"//trim(domain),lon,lat,fix=.true.) + call lb2ij(lon,lat,i,j) + if(present(iglob))iglob=i + if(present(jglob))jglob=j + in=(i>=1).and.(i<=IIFULLDOM).and.(j>=1).and.(j<=JJFULLDOM) + i=max(1,min(i,IIFULLDOM));i=i_local(i) + j=max(1,min(j,JJFULLDOM));j=j_local(j) + select case(domain) + case("g","G","global","full") + if(present(iloc))iloc=i + if(present(jloc))jloc=j + case("l","L","local","processor") + if(in) in=(i>=1).and.(i<=limax).and.(j>=1).and.(j<=ljmax) + if(present(iloc))iloc=i + if(present(jloc))jloc=j + case("c","C","cell","gridbox") + call CheckStop(.not.(present(iloc).and.present(jloc)),& + "Wrong options for coord_in_"//trim(domain)) + if(in) in=(i==iloc).and.(j==jloc) + case default + call CheckStop("Unsupporter coord_in_"//trim(domain)) + end select +end function coord_in_domain +function coord_in_processor(lon,lat,iloc,jloc,iglob,jglob) result(in) + !-------------------------------------------------------------------! + ! Is coord (lon/lat) is inside local domain? + !-------------------------------------------------------------------! + real, intent(inout) :: lon,lat + integer, intent(out),optional:: iloc,jloc,iglob,jglob + logical :: in + in=coord_in_domain("processor",lon,lat,iloc,jloc,iglob,jglob) +end function coord_in_processor +function coord_in_gridbox(lon,lat,iloc,jloc,iglob,jglob) result(in) + !-------------------------------------------------------------------! + ! Is coord (lon/lat) is inside gridbox(iloc,jloc)? + !-------------------------------------------------------------------! + real, intent(inout) :: lon,lat + integer, intent(inout) :: iloc,jloc + integer, intent(out),optional:: iglob,jglob + logical :: in + in=coord_in_domain("gridbox",lon,lat,iloc,jloc,iglob,jglob) +end function coord_in_gridbox + +subroutine Alloc_GridFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND) + + integer, intent(in)::LIMAX,LJMAX,KMAX_MID,KMAX_BND + + allocate(i_fdom(0:LIMAX+1)) + allocate(j_fdom(0:LJMAX+1)) + allocate(glon(LIMAX,LJMAX)) + allocate(glat(LIMAX,LJMAX)) + allocate(gl_stagg(0:LIMAX,0:LJMAX)) + allocate(gb_stagg(0:LIMAX,0:LJMAX)) + allocate(xm_i(0:LIMAX+1,0:LJMAX+1)) + allocate(xm_j(0:LIMAX+1,0:LJMAX+1)) + allocate(xm2(0:LIMAX+1,0:LJMAX+1)) + allocate(xmd(0:LIMAX+1,0:LJMAX+1)) + allocate(xm2ji(0:LJMAX+1,0:LIMAX+1)) + allocate(xmdji(0:LJMAX+1,0:LIMAX+1)) + allocate(GridArea_m2(LIMAX,LJMAX)) + allocate(z_bnd(LIMAX,LJMAX,KMAX_BND)) + allocate(z_mid(LIMAX,LJMAX,KMAX_MID)) + +end subroutine Alloc_GridFields + +subroutine make_vertical_levels_interpolation_coeff + ! make interpolation coefficients to convert the levels defined in meteo + ! into the levels defined in Vertical_levels.txt + + integer ::k,k_met + real ::p_met,p_mod,p1,p2 + if(.not. allocated(k1_met))allocate(k1_met(KMAX_MID),k2_met(KMAX_MID),x_k1_met(KMAX_MID)) + if(.not. allocated(A_bnd_met))then + allocate(A_bnd_met(KMAX_MID+1),B_bnd_met(KMAX_MID+1)) + A_bnd_met=A_bnd + B_bnd_met=B_bnd + end if + + if(me_mpi==0)then + ! only me=0 has the values for A_bnd_met and B_bnd_met + do k=1,KMAX_MID + P_mod=A_mid(k)+Pref*B_mid(k) + !find the lowest met level higher than the model level + !do k_met=1,KMAX_MET + k_met=KMAX_MET-1 + p_met=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) + do while(p_met>P_mod.and.k_met>1) + !if(MasterProc) write(*,*)P_mod,p_met + k_met=k_met-1 + p_met=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) + end do + k1_met(k)=k_met + k2_met(k)=k_met+1 + k_met=k1_met(k) + p1=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) + k_met=k2_met(k) + p2=0.5*(A_bnd_met(k_met+1)+A_bnd_met(k_met))+Pref*0.5*(B_bnd_met(k_met+1)+B_bnd_met(k_met)) + x_k1_met(k)=(p_mod-p2)/(p1-p2) + write(*,77)k, ' interpolated from levels ', k1_met(k),' and ',k2_met(k),P_mod,p1,p2,x_k1_met(k) +77 format(I4,A,I3,A,I3,13f11.3) + if(x_k1_met(k)<-0.00001 .or. (1.0-x_k1_met(k))<-0.00001)then + write(*,*)'WARNING: Extrapolation of data. This is NOT recommended for several metfields' + end if + + end do + end if + + CALL MPI_BCAST(k1_met,4*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(k2_met,4*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + CALL MPI_BCAST(x_k1_met,8*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) + +end subroutine make_vertical_levels_interpolation_coeff + +subroutine lambert2lb(x,y,gl,gb,lon0,y0,k,F) + real, intent(in) ::x,y,lon0,y0,k,F + real, intent(out)::gl,gb + real ::r,t + r = sqrt(x*x+(y0-y)*(y0-y)) + if(k<0.0)r = -r + t = atan(x/(y0-y)) + gb = 2*180./PI*atan((F/r)**(1.0/k))-90.0 + gl = lon0 + 180./PI*t/k +end subroutine lambert2lb +subroutine lb2lambert(x,y,gl,gb,lon0,y0,k,F) + real, intent(in) ::gl,gb,lon0,y0,k,F + real, intent(out)::x,y + real ::r + r = F*tan(0.25*PI-0.5*deg2rad*gb)**k ! depends only on latitude ->reuse (about 100 cycles/operation) + x = r*sin(deg2rad*k*(gl-lon0)) + y = y0 - r*cos(deg2rad*k*(gl-lon0)) +end subroutine lb2lambert + +subroutine lb_rot2lb(xsph,ysph,xrot,yrot,grid_north_pole_longitude,grid_north_pole_latitude) + ! compute spherical coordinates as function of + ! spherical rotated coordinates + ! + ! conversion between spherical (xsph,ysph) and spherical rotated + ! (xrot,yrot) coordinates. (xcen,ycen) is the position of the + ! rotated equator/greenwich in terms of (longitude,latitude). + ! all input and output values are given in degrees. + ! + ! grid_north_pole_longitude: geographical (non-rotated) coordinates + ! of the "north pole" from the rotated grid (No polar bears there). + ! (typically out of the grid, since it is singular). + ! + ! xcen: geographical (non-rotated) coordinates of the (lon=0 lat=0) + ! point where lonlat are in the rotated grid + ! (typically in the middle of the grid, since it is "flat") + + implicit none + real :: xsph, ysph, xrot, yrot,xcen,ycen,zsycen,zcycen + real :: zsxrot,zcxrot,zsyrot,zcyrot,zsysph,zcysph,zcxmxc,zsxmxc,zxmxc + real :: grid_north_pole_longitude,grid_north_pole_latitude + real :: rad2deg,deg2rad + ! + deg2rad=3.14159265358979323/180. + rad2deg=1.0/deg2rad + + xcen=(180.+grid_north_pole_longitude)*deg2rad + ycen=(90.-grid_north_pole_latitude)*deg2rad + + zsycen = sin(ycen) + zcycen = cos(ycen) + + zsxrot = sin(xrot*deg2rad) + zcxrot = cos(xrot*deg2rad) + zsyrot = sin(yrot*deg2rad) + zcyrot = cos(yrot*deg2rad) + zsysph = zcycen*zsyrot + zsycen*zcyrot*zcxrot + zsysph = amax1(zsysph,-1.0) + zsysph = amin1(zsysph,+1.0) + ysph = asin(zsysph) + zcysph = cos(ysph) + zcxmxc = (zcycen*zcyrot*zcxrot -& + zsycen*zsyrot)/zcysph + zcxmxc = amax1(zcxmxc,-1.0) + zcxmxc = amin1(zcxmxc,+1.0) + zsxmxc = zcyrot*zsxrot/zcysph + zxmxc = acos(zcxmxc) + if (zsxmxc.lt.0.0) zxmxc = -zxmxc + xsph = (zxmxc + xcen)*rad2deg + ysph = ysph*rad2deg + +end subroutine lb_rot2lb + +subroutine lb2UTM(Long, Lat, UTMEasting, UTMNorthing, UTMZone) + ! converts lat/long to UTM coords. Equations from USGS Bulletin 1532 + ! East Longitudes are positive, West longitudes are negative. + ! North latitudes are positive, South latitudes are negative + ! Lat and Long are in decimal degrees + + ! Angle with North: (called "convergence") + ! angle = arctan(tan(lon)*sin(lat)) lon is longitude relative + ! to middle of utm zone: lon=gl-Lambda0 + ! works for northern hemisphere at least + ! u_utm = u_ll*cos(angle)+v_ll*sin(angle) + ! v_utm =-u_ll*sin(angle)+v_ll*cos(angle) + + implicit none + + real :: UTMNorthing, UTMEasting, Lat, Long + integer :: UTMZone + real :: a = 6378137.0 !WGS-84 + real :: eccSquared = 0.00669438 !WGS-84 + real :: k0 = 0.9996 + real :: LongOrigin + real :: eccPrimeSquared + real :: N, T, C, AA, M + real :: rad2deg,deg2rad + + real :: LongTemp + real :: LatRad + real :: LongRad + real :: LongOriginRad; + + rad2deg=180.0/Pi + deg2rad=Pi/180. + LatRad = Lat*deg2rad + !//Make sure the longitude is between -180.00 .. 179.9 + LongTemp = (Long+180)-int((Long+180)/360)*360-180!; // -180.00 .. 179.9; + LongRad = LongTemp*deg2rad + UTMZone = int((LongTemp + 180)/6) + 1; + + !Southern Norway, zone 32 is extended by 3 degrees to the West + if( Lat >= 56.0 .and. Lat < 64.0 .and. LongTemp >= 3.0 .and. LongTemp < 12.0 )UTMZone = 32 + + !// Special zones for Svalbard + if( Lat >= 72.0 .and. Lat < 84.0 ) then + if( LongTemp >= 0.0 .and. LongTemp < 9.0 )then + UTMZone = 31 + else if( LongTemp >= 9.0 .and. LongTemp < 21.0 )then + UTMZone = 33 + else if( LongTemp >= 21.0 .and. LongTemp < 33.0 )then + UTMZone = 35 + else if( LongTemp >= 33.0 .and. LongTemp < 42.0 )then + UTMZone = 37 endif + endif + LongOrigin = (UTMZone - 1)*6 - 180 + 3! //+3 puts origin in middle of zone + LongOriginRad = LongOrigin * deg2rad + + !//compute the UTM Zone from the latitude and longitude + + eccPrimeSquared = (eccSquared)/(1-eccSquared) + + N = a/sqrt(1-eccSquared*sin(LatRad)*sin(LatRad)) + T = tan(LatRad)*tan(LatRad) + C = eccPrimeSquared*cos(LatRad)*cos(LatRad) + AA = cos(LatRad)*(LongRad-LongOriginRad) + + M = a*((1 - eccSquared/4 - 3*eccSquared*eccSquared/64 & + - 5*eccSquared*eccSquared*eccSquared/256)*LatRad & + - (3*eccSquared/8 + 3*eccSquared*eccSquared/32 & + + 45*eccSquared*eccSquared*eccSquared/1024)*sin(2*LatRad)& + + (15*eccSquared*eccSquared/256 & + + 45*eccSquared*eccSquared*eccSquared/1024)*sin(4*LatRad) & + - (35*eccSquared*eccSquared*eccSquared/3072)*sin(6*LatRad)) + + UTMEasting = k0*N*(AA+(1-T+C)*AA*AA*AA/6& + +(5-18*T+T*T+72*C-58*eccPrimeSquared)*AA*AA*AA*AA*AA/120)+ 500000.0 + + UTMNorthing = (k0*(M+N*tan(LatRad)*(AA*AA/2+(5-T+9*C+4*C*C)*AA*AA*AA*AA/24+& + (61-58*T+T*T+600*C-330*eccPrimeSquared)*AA*AA*AA*AA*AA*AA/720))) + if(Lat < 0)UTMNorthing =UTMNorthing + 10000000.0!; //10000000 meter offset for southern hemisphere + +end subroutine lb2UTM + +subroutine UTM2lb(UTMEasting, UTMNorthing, UTMZone, Long, Lat ) + ! converts UTM coords to lat/long. Equations from USGS Bulletin 1532 + ! East Longitudes are positive, West longitudes are negative. + ! North latitudes are positive, South latitudes are negative + ! Lat and Long are in decimal degrees. + + implicit none + + real :: UTMNorthing, UTMEasting, Lat, Long + integer :: UTMZone + real :: k0 = 0.9996 + real :: a = 6378137.0 !WGS-84 + real :: eccSquared = 0.00669438 !WGS-84 + real :: eccPrimeSquared + real :: e1,rad2deg + real :: N1, T1, C1, R1, D, M + real :: LongOrigin + real :: mu, phi1, phi1Rad + real :: x, y, ww + !char* ZoneLetter; + integer :: NorthernHemisphere !1 for northern hemispher, 0 for southern + + rad2deg=180.0/Pi + + x = UTMEasting - 500000.0 !remove 500,000 meter offset for longitude + y = UTMNorthing + + NorthernHemisphere = 1 !point is in northern hemisphere + + LongOrigin = (UTMZone - 1)*6 - 180 + 3 !+3 puts origin in middle of zone + + e1 = (1-sqrt(1-eccSquared))/(1+sqrt(1-eccSquared)) + + eccPrimeSquared = (eccSquared)/(1-eccSquared) + + M = y / k0 + mu = M/(a*(1-eccSquared/4-3*eccSquared*eccSquared/64-5*eccSquared*eccSquared*eccSquared/256)) + + phi1Rad = mu + (3*e1/2-27*e1*e1*e1/32)*sin(2*mu)+ (21*e1*e1/16-55*e1*e1*e1*e1/32)*sin(4*mu)+(151*e1*e1*e1/96)*sin(6*mu) + phi1 = phi1Rad*rad2deg + + N1 = a/sqrt(1-eccSquared*sin(phi1Rad)*sin(phi1Rad)) + T1 = tan(phi1Rad)*tan(phi1Rad) + C1 = eccPrimeSquared*cos(phi1Rad)*cos(phi1Rad) + ww = 1-eccSquared*sin(phi1Rad)*sin(phi1Rad) + R1 = a*(1-eccSquared)/(ww*sqrt(ww)) + D = x/(N1*k0) + + Lat = phi1Rad - (N1*tan(phi1Rad)/R1)*(D*D/2-(5+3*T1+10*C1-4*C1*C1-9*eccPrimeSquared)*D*D*D*D/24& + +(61+90*T1+298*C1+45*T1*T1-252*eccPrimeSquared-3*C1*C1)*D*D*D*D*D*D/720) + Lat = Lat * rad2deg + + Long = (D-(1+2*T1+C1)*D*D*D/6+(5-2*C1+28*T1-3*C1*C1+8*eccPrimeSquared+24*T1*T1)& + *D*D*D*D*D/120)/cos(phi1Rad) + Long = LongOrigin + Long * rad2deg + +end subroutine UTM2lb + +subroutine nf90_get_var_extended(ncFileID,varID,Var,i0,i1,j0,j1,ishift_in,jshift_in) + ! fetch a 2D array over an extended subdomain. + ! i.e. extended arrays are overlapping, and parts outside the fulldomain + ! are extrapolated linearly. + implicit none + integer, intent(in) :: ncFileID,varID,i0,i1,j0,j1 + real, intent(inout) :: Var(i0:i1,j0:j1) !the extended local array + integer, optional, intent(in)::ishift_in,jshift_in + + integer ::iloc_start,iloc_end,jloc_start,jloc_end + integer ::i,j,ishift,jshift + + iloc_start=i0 + iloc_end=i1 + jloc_start=j0 + jloc_end=j1 + ishift=0 + jshift=0 + if(present(ishift_in))ishift=ishift_in + if(present(jshift_in))jshift=jshift_in + + if(iloc_start+IRUNBEG+gi0-2<1)iloc_start=1!first cell (in i direction) + if(iloc_end+IRUNBEG+gi0-2>IIFULLDOM)iloc_end=IIFULLDOM+2-gi0-IRUNBEG!last cell + if(jloc_start+JRUNBEG+gj0-2<1)jloc_start=1!first cell (in j direction) + if(jloc_end+JRUNBEG+gj0-2>JJFULLDOM)jloc_end=JJFULLDOM+2-gj0-JRUNBEG!last cell + + call check(nf90_get_var(ncFileID, varID, Var(iloc_start:iloc_end,jloc_start:jloc_end) & + ,start=(/iloc_start+IRUNBEG+gi0-2+ishift,jloc_start+JRUNBEG+gj0-2+jshift/),& + count=(/iloc_end-iloc_start+1, jloc_end-jloc_start+1/))) + + !extrapolate if needed at fulldomain boundaries + do i=iloc_start-1,i0,-1 + do j=jloc_start,jloc_end + Var(i,j)=2.0*Var(i+1,j)-Var(i+2,j) + end do + end do + do i=iloc_end+1,i1 + do j=jloc_start,jloc_end + Var(i,j)=2.0*Var(i-1,j)-Var(i-2,j) + end do + end do + do i=i0,i1!now they are all defined + do j=jloc_start-1,j0,-1 + Var(i,j)=2.0*Var(i,j+1)-Var(i,j+2) + end do + end do + do i=i0,i1!now they are all defined + do j=jloc_end+1,j1 + Var(i,j)=2.0*Var(i,j-1)-Var(i,j-2) + end do + end do - CALL MPI_BCAST(k1_met,4*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(k2_met,4*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - CALL MPI_BCAST(x_k1_met,8*KMAX_MID,MPI_BYTE,0,MPI_COMM_WORLD,IERROR) - - end subroutine make_vertical_levels_interpolation_coeff - - subroutine lb_rot2lb(xsph,ysph,xrot,yrot,grid_north_pole_longitude,grid_north_pole_latitude) - ! - ! compute spherical coordinates as function of - ! spherical rotated coordinates - ! - ! conversion between spherical (xsph,ysph) and spherical rotated - ! (xrot,yrot) coordinates. (xcen,ycen) is the position of the - ! rotated equator/greenwich in terms of (longitude,latitude). - ! all input and output values are given in degrees. - ! - ! grid_north_pole_longitude: geographical (non-rotated) coordinates of the "north pole" from the rotated grid (No polar bears there). - ! (typically out of the grid, since it is singular). - ! - ! xcen: geographical (non-rotated) coordinates of the (lon=0 lat=0) point where lonlat are in the rotated grid - ! (typically in the middle of the grid, since it is "flat") - ! - implicit none - real :: xsph, ysph, xrot, yrot,xcen,ycen,zsycen,zcycen - real :: zsxrot,zcxrot,zsyrot,zcyrot,zsysph,zcysph,zcxmxc,zsxmxc,zxmxc - real :: grid_north_pole_longitude,grid_north_pole_latitude - real :: rad2deg,deg2rad - ! - deg2rad=3.14159265358979323/180. - rad2deg=1.0/deg2rad - - xcen=(180.+grid_north_pole_longitude)*deg2rad - ycen=(90.-grid_north_pole_latitude)*deg2rad - - zsycen = sin(ycen) - zcycen = cos(ycen) - - zsxrot = sin(xrot*deg2rad) - zcxrot = cos(xrot*deg2rad) - zsyrot = sin(yrot*deg2rad) - zcyrot = cos(yrot*deg2rad) - zsysph = zcycen*zsyrot + zsycen*zcyrot*zcxrot - zsysph = amax1(zsysph,-1.0) - zsysph = amin1(zsysph,+1.0) - ysph = asin(zsysph) - zcysph = cos(ysph) - zcxmxc = (zcycen*zcyrot*zcxrot -& - zsycen*zsyrot)/zcysph - zcxmxc = amax1(zcxmxc,-1.0) - zcxmxc = amin1(zcxmxc,+1.0) - zsxmxc = zcyrot*zsxrot/zcysph - zxmxc = acos(zcxmxc) - if (zsxmxc.lt.0.0) zxmxc = -zxmxc - xsph = (zxmxc + xcen)*rad2deg - ysph = ysph*rad2deg - - end subroutine lb_rot2lb - - - subroutine nf90_get_var_extended(ncFileID,varID,Var,i0,i1,j0,j1,ishift_in,jshift_in) - - !fetch a 2D array over an extended subdomain. - !i.e. extended arrays are overlapping, and parts outside the fulldomain are extrapolated linearly. - implicit none - integer, intent(in) ::ncFileID,varID - real, intent(inout) ::Var(i0:i1,j0:j1)!the extended local array - integer, intent(in)::i0,i1,j0,j1 - integer, optional, intent(in)::ishift_in,jshift_in - - integer ::iloc_start,iloc_end,jloc_start,jloc_end - integer ::i,j,ishift,jshift - - iloc_start=i0 - iloc_end=i1 - jloc_start=j0 - jloc_end=j1 - ishift=0 - jshift=0 - if(present(ishift_in))ishift=ishift_in - if(present(jshift_in))jshift=jshift_in - - if(iloc_start+IRUNBEG+gi0-2<1)iloc_start=1!first cell (in i direction) - if(iloc_end+IRUNBEG+gi0-2>IIFULLDOM)iloc_end=IIFULLDOM+2-gi0-IRUNBEG!last cell - if(jloc_start+JRUNBEG+gj0-2<1)jloc_start=1!first cell (in j direction) - if(jloc_end+JRUNBEG+gj0-2>JJFULLDOM)jloc_end=JJFULLDOM+2-gj0-JRUNBEG!last cell - - call check(nf90_get_var(ncFileID, varID, Var(iloc_start:iloc_end,jloc_start:jloc_end) & - ,start=(/iloc_start+IRUNBEG+gi0-2+ishift,jloc_start+JRUNBEG+gj0-2+jshift/),& - count=(/iloc_end-iloc_start+1, jloc_end-jloc_start+1/))) - - !extrapolate if needed at fulldomain boundaries - do i=iloc_start-1,i0,-1 - do j=jloc_start,jloc_end - Var(i,j)=2.0*Var(i+1,j)-Var(i+2,j) - enddo - enddo - do i=iloc_end+1,i1 - do j=jloc_start,jloc_end - Var(i,j)=2.0*Var(i-1,j)-Var(i-2,j) - enddo - enddo - do i=i0,i1!now they are all defined - do j=jloc_start-1,j0,-1 - Var(i,j)=2.0*Var(i,j+1)-Var(i,j+2) - enddo - enddo - do i=i0,i1!now they are all defined - do j=jloc_end+1,j1 - Var(i,j)=2.0*Var(i,j-1)-Var(i,j-2) - enddo - enddo - - end subroutine nf90_get_var_extended +end subroutine nf90_get_var_extended subroutine RestrictDomain(DOMAIN) integer, dimension(4), intent(inout):: DOMAIN @@ -1925,7 +2260,557 @@ subroutine RestrictDomain(DOMAIN) if(any([DOMAIN==0,DOMAIN(1)>DOMAIN(2),DOMAIN(3)>DOMAIN(4)]))then write(*,"(A,'=[',I0,3(',',I0),']')")'Inconsistent DOMAIN',DOMAIN call CheckStop('Inconsistent DOMAIN') - endif -endsubroutine RestrictDomain -endmodule GridValues_ml -!============================================================================== + end if +end subroutine RestrictDomain + +subroutine extendarea_N(f,h,thick,Size1,Size2,debug_flag) + ! returns extended array array, reading neighbour procs as needed + ! size of h MUST be as declared below + + integer, intent(in) :: thick,Size1,Size2 + real, intent(in) :: f(Size1,LIMAX,LJMAX,Size2) + real, intent(inout) :: h(Size1,1-thick:LIMAX+thick,1-thick:LJMAX+thick,Size2) + logical, intent(in), optional :: debug_flag + logical :: mydebug = .false. + + real, dimension(Size1,LIMAX,thick,Size2) :: f_south,f_north + real, dimension(Size1,thick,1-thick:LJMAX+thick,Size2) :: f_west,f_east + + integer :: iif,jjf,i,j,iifl,jjfl,i1,i2 + if ( present(debug_flag) ) mydebug = debug_flag + + ! readneighbours twice + iifl=limax+2*thick + jjfl=ljmax+2*thick + if(mydebug .and. MasterProc ) write(*,*) "DEBUG extendarea", iif,jjf,thick + + call readneighbors_N(f,f_south,f_north,f_west,f_east,thick,Size1,Size2) + + do i2=1,Size2 + do j=1,ljmax + do i=1,limax + do i1=1,Size1 + h(i1,i,j,i2) = f(i1,i,j,i2) + enddo + end do + end do + end do + do i2=1,Size2 + do j=1,thick + do i=1,limax + do i1=1,Size1 + h(i1,i,j-thick,i2) = f_south(i1,i,j,i2) + end do + end do + end do + end do + + do i2=1,Size2 + do j=1,thick + do i=1,limax + do i1=1,Size1 + h(i1,i,ljmax+j,i2) = f_north(i1,i,j,i2) + end do + end do + end do + end do + + do i2=1,Size2 + do j=1-thick,ljmax+thick + do i=1,thick + do i1=1,Size1 + h(i1,i-thick,j,i2) = f_west(i1,i,j,i2) + end do + end do + end do + end do + + do i2=1,Size2 + do j=1-thick,ljmax+thick + do i=1,thick + do i1=1,Size1 + h(i1,limax+i,j,i2) = f_east(i1,i,j,i2) + end do + end do + end do + end do + +end subroutine extendarea_N + +subroutine readneighbors_N(data,data_south,data_north,data_west,data_east,thick,Size1,Size2) + ! Read data at the other side of the boundaries + ! + ! thick is the number of gridcells in each direction to be transferred + ! Note that we also fetch data from processors in the "diagonal" + ! directions + ! + ! Written by Peter January 2017; remote neighbors June 2017 + + ! Note, + ! The data_west(jj,:)=data(1,j) is not a bug: when there is no west + ! neighbour, + ! the data is simply copied from the nearest points: data_west(jj,:) should + ! be =data(-thick+1:0,j), but since this data does not exist, we + ! put it =data(1,j). + + implicit none + integer, intent(in) :: thick,Size1,Size2 + real,intent(in), dimension(Size1,LIMAX,LJMAX,Size2) ::data + real,intent(out), dimension(Size1,LIMAX,thick,Size2) ::data_south,data_north + real,intent(out), dimension(Size1,thick,1-thick:LJMAX+thick,Size2) ::data_west,data_east + real, dimension(Size1,LIMAX,min(thick,MAXLJMAX),Size2) ::data_south_snd,data_north_snd + real, dimension(Size1,min(thick,MAXLIMAX),1-thick:LJMAX+thick,Size2) ::data_west_snd,data_east_snd + real, dimension(Size1,LIMAX,min(MAXLJMAX,thick),Size2) ::data_sn_rcv + real, dimension(Size1,min(MAXLIMAX,thick),1-thick:LJMAX+thick,Size2) ::data_we_rcv + + integer :: msgnr + integer :: i,it,j,jj,jt,i1,i2,n + integer :: mythick,myithick,myjthick,totthick,ineighbor,limaxloc,ljmaxloc + + !check that limax and ljmax are large enough. Can only read neighboring subdomain + ! call CheckStop(limax < thick, "ERROR readneighbors_N in Met_ml") + ! call CheckStop(ljmax < thick, "ERROR readneighbors_N in Met_ml") + limaxloc = min(MAXLIMAX,thick)!array size common for all + ljmaxloc = min(MAXLJMAX,thick)!array size common for all + + msgnr=1 + myjthick = min(thick,LJMAX) + myithick = min(thick,LIMAX) + ! data_south_snd(:,:,:,:)=data(:,:,1:thick,:) + ! data_north_snd(:,:,:,:)=data(:,:,max(1,ljmax-thick+1):ljmax,:) + do i2=1,Size2 + do jt=1,myjthick + do i=1,limax + do i1=1,Size1 + data_south_snd(i1,i,jt,i2)=data(i1,i,jt,i2) + end do + end do + end do + end do + do i2=1,Size2 + do jt=1,myjthick + do i=1,limax + do i1=1,Size1 + data_north_snd(i1,i,jt,i2)=data(i1,i,LJMAX-myjthick+jt,i2) + end do + end do + end do + end do + + if(neighbor(SOUTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor-NPROCX + if(ineighbor<0) exit + enddo + + endif + end if + if(neighbor(NORTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor+NPROCX + if(ineighbor>=NPROC) exit + enddo + + endif + end if + + if(neighbor(SOUTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor-NPROCX + if(ineighbor<0)then + !must fill remainder data, even if out of rundomain + do i2=1,Size2 + do jt=1,thick-totthick + do i=1,limax + do i1=1,Size1 + data_south(i1,i,jt,i2)=data_south(i1,i,thick-totthick+1,i2) + end do + end do + end do + end do + exit + endif + enddo + endif + else + do i2=1,Size2 + do jt=1,thick + do i=1,limax + do i1=1,Size1 + data_south(i1,i,jt,i2)=data(i1,i,1,i2) + end do + end do + end do + end do + end if + + if(neighbor(NORTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor+NPROCX + if(ineighbor>=NPROC)then + do i2=1,Size2 + do jt=totthick+1,thick + do i=1,limax + do i1=1,Size1 + data_north(i1,i,jt,i2) = data_north(i1,i,totthick,i2) + end do + end do + end do + end do + exit + endif + enddo + endif + else + do i2=1,Size2 + do jt=1,thick + do i=1,limax + do i1=1,Size1 + data_north(i1,i,jt,i2)=data(i1,i,ljmax,i2) + end do + end do + end do + end do + end if + + jj=0 + do i2=1,Size2 + do jt=1,thick + do it=1,myithick + do i1=1,Size1 + data_west_snd(i1,it,jt-thick,i2)=data_south(i1,it,jt,i2) + data_east_snd(i1,it,jt-thick,i2)=data_south(i1,limax-myithick+it,jt,i2) + end do + end do + end do + do j=1,ljmax + do it=1,myithick + do i1=1,Size1 + data_west_snd(i1,it,j,i2)=data(i1,it,j,i2) + data_east_snd(i1,it,j,i2)=data(i1,limax-myithick+it,j,i2) + end do + end do + end do + do jt=1,thick + do it=1,myithick + do i1=1,Size1 + data_west_snd(i1,it,ljmax+jt,i2)=data_north(i1,it,jt,i2) + data_east_snd(i1,it,ljmax+jt,i2)=data_north(i1,limax-myithick+it,jt,i2) + end do + end do + end do + end do + + if(neighbor(WEST) >= 0 )then + + if(thick=thick) exit + ineighbor=ineighbor-1 + if( (ineighbor/NPROCX)/=(me/NPROCX) .or. ineighbor<0) exit + enddo + endif + end if + if(neighbor(EAST) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor+1 + if( (ineighbor/NPROCX)/=(me/NPROCX)) exit + enddo + endif + end if + + + + if(neighbor(WEST) >= 0 )then + if(thick=thick)exit + ineighbor=ineighbor-1 + if((ineighbor/NPROCX)/=(me/NPROCX).or. ineighbor<0)then + do i2=1,Size2 + do it=1-thick,LJMAX+thick + do jt=1,thick-totthick + do i1=1,Size1 + data_west(i1,jt,it,i2)=data_west(i1,thick-totthick+1,it,i2) + end do + end do + end do + end do + exit + endif + enddo + endif + else + + do i2=1,Size2 + do jt=1,thick + do it=1,thick + do i1=1,Size1 + data_west(i1,it,jt-thick,i2)=data_south(i1,1,jt,i2) + end do + end do + end do + + do j=1,ljmax + do it=1,thick + do i1=1,Size1 + data_west(i1,it,j,i2)=data(i1,1,j,i2) + end do + end do + end do + do jt=1,thick + do it=1,thick + do i1=1,Size1 + data_west(i1,it,ljmax+jt,i2)=data_north(i1,1,jt,i2) + end do + end do + end do + + end do + end if + if(neighbor(EAST) >= 0 )then + if(thick=thick)exit + ineighbor=ineighbor+1 + if((ineighbor/NPROCX)/=(me/NPROCX))then + do i2=1,Size2 + do it=1-thick,LJMAX+thick + do jt=totthick+1,thick + do i1=1,Size1 + data_east(i1,jt,it,i2)=data_east(i1,totthick,it,i2) + end do + end do + end do + end do + exit + endif + enddo + endif + else + do i2=1,Size2 + do jt=1,thick + do it=1,thick + do i1=1,Size1 + data_east(i1,it,jt-thick,i2)=data_south(i1,limax,jt,i2) + end do + end do + end do + + do j=1,ljmax + do it=1,thick + do i1=1,Size1 + data_east(i1,it,j,i2)=data(i1,limax,j,i2) + end do + end do + end do + + do jt=1,thick + do it=1,thick + do i1=1,Size1 + data_east(i1,it,ljmax+jt,i2)=data_north(i1,limax,jt,i2) + end do + end do + end do + end do + end if +! if(me==9)then +! write(*,*)'DATA 9 EAST' +! 54 format(200I7) +! do j=1-thick,ljmax+thick +! write(*,54)(nint(data_east(1,i,j,1)),i=1,thick) +! enddo +! write(*,*)'DATA 9 WEST' +! do j=1-thick,ljmax+thick +! write(*,54)(nint(data_west(1,i,j,1)),i=1,thick) +! enddo +! endif + + if(neighbor(SOUTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor-NPROCX + if(ineighbor<0) exit + enddo + endif + end if + if(neighbor(NORTH) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor+NPROCX + if(ineighbor>=NPROC) exit + enddo + endif + end if + if(neighbor(WEST) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor-1 + if( (ineighbor/NPROCX)/=(me/NPROCX).or. ineighbor<0) exit + enddo + end if + end if + if(neighbor(EAST) >= 0 )then + if(thick=thick) exit + ineighbor=ineighbor+1 + if( (ineighbor/NPROCX)/=(me/NPROCX)) exit + enddo + end if + end if + +end subroutine readneighbors_N + +end module GridValues_ml diff --git a/ISOFWD.f90 b/ISOFWD.f90 deleted file mode 100644 index 76ce188..0000000 --- a/ISOFWD.f90 +++ /dev/null @@ -1,18736 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program is distributed in the hope that it will be useful, -!* but WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP1F -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF -! AN AMMONIUM-SULFATE AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY -! THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISRP1F (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - -! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** - - CALL INIT1 (WI, RHI, TEMPI) - -! *** CALCULATE SULFATE RATIO ******************************************* - - SULRAT = W(3)/W(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR - - IF (2.0 <= SULRAT) THEN - DC = W(3) - 2.001D0*W(2) ! For numerical stability - W(3) = W(3) + MAX(-DC, ZERO) - - IF(METSTBL == 1) THEN - SCASE = 'A2' - CALL CALCA2 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH42S4) THEN - SCASE = 'A1' - CALL CALCA1 ! NH42SO4 ; case A1 - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'A2' - CALL CALCA2 ! Only liquid ; case A2 - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case B1 - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case B2 - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case B3 - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case B4 - ENDIF - ENDIF - CALL CALCNH3 - - ! *** SULFATE RICH (FREE ACID) - - ELSEIF (SULRAT < 1.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case C1 - - ELSEIF (DRNH4HS4 <= RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case C2 - - ENDIF - ENDIF - CALL CALCNH3 - ENDIF - -! *** RETURN POINT - - RETURN - -! *** END OF SUBROUTINE ISRP1F ***************************************** - - END SUBROUTINE ISRP1F -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP2F -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY -! THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISRP2F (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - -! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** - - CALL INIT2 (WI, RHI, TEMPI) - -! *** CALCULATE SULFATE RATIO ******************************************* - - SULRAT = W(3)/W(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR - - IF (2.0 <= SULRAT) THEN - - IF(METSTBL == 1) THEN - SCASE = 'D3' - CALL CALCD3 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'D1' - CALL CALCD1 ! NH42SO4,NH4NO3 ; case D1 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'D2' - CALL CALCD2 ! NH42S4 ; case D2 - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'D3' - CALL CALCD3 ! Only liquid ; case D3 - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - ! FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES, - ! THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. - ! SUBROUTINES CALCB? ARE CALLED, AND THEN THE NITRIC ACID IS DISSOLVED - ! FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM. - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid (metastable) - SCASE = 'E4' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case E1 - SCASE = 'E1' - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case E2 - SCASE = 'E2' - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case E3 - SCASE = 'E3' - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case E4 - SCASE = 'E4' - ENDIF - ENDIF - - CALL CALCNA ! HNO3(g) DISSOLUTION - - ! *** SULFATE RICH (FREE ACID) - ! FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES, - ! THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM - ! SUBROUTINE CALCC? IS CALLED, AND THEN THE NITRIC ACID IS DISSOLVED - ! FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM. - - ELSEIF (SULRAT < 1.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid (metastable) - SCASE = 'F2' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case F1 - SCASE = 'F1' - - ELSEIF (DRNH4HS4 <= RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case F2 - SCASE = 'F2' - ENDIF - ENDIF - - CALL CALCNA ! HNO3(g) DISSOLUTION - ENDIF - -! *** RETURN POINT - - RETURN - -! *** END OF SUBROUTINE ISRP2F ***************************************** - - END SUBROUTINE ISRP2F -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP3F -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM -! RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISRP3F (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - -! *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** - - WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 - WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 - -! *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ******** - - IF (WI(1)+WI(2)+WI(4) <= 1d-10) THEN - WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3 - WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3 - ENDIF - -! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** - - CALL ISOINIT3 (WI, RHI, TEMPI) - -! *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE ********* - - REST = 2.D0*W(2) + W(4) + W(5) - IF (W(1) > REST) THEN ! NA > 2*SO4+CL+NO3 ? - W(1) = (ONE-1D-6)*REST ! Adjust Na amount - CALL PUSHERR (0050, 'ISRP3F') ! Warning error: Na adjusted - ENDIF - -! *** CALCULATE SULFATE & SODIUM RATIOS ********************************* - - SULRAT = (W(1)+W(3))/W(2) - SODRAT = W(1)/W(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR ; SODIUM POOR - - IF (2.0 <= SULRAT .AND. SODRAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'G5' - CALL CALCG5 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'G1' - CALL CALCG1 ! NH42SO4,NH4NO3,NH4CL,NA2SO4 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'G2' - CALL CALCG2 ! NH42SO4,NH4CL,NA2SO4 - - ELSEIF (DRNH4CL <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'G3' - CALL CALCG3 ! NH42SO4,NA2SO4 - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'G4' - CALL CALCG4 ! NA2SO4 - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'G5' - CALL CALCG5 ! Only liquid - ENDIF - ENDIF - - ! *** SULFATE POOR ; SODIUM RICH - - ELSE IF (SULRAT >= 2.0 .AND. SODRAT >= 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'H6' - CALL CALCH6 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'H1' - CALL CALCH1 ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'H2' - CALL CALCH2 ! NH4CL,NA2SO4,NACL,NANO3 - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'H3' - CALL CALCH3 ! NH4CL,NA2SO4,NACL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4Cl) THEN - SCASE = 'H4' - CALL CALCH4 ! NH4CL,NA2SO4 - - ELSEIF (DRNH4Cl <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'H5' - CALL CALCH5 ! NA2SO4 - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'H6' - CALL CALCH6 ! NO SOLID - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'I6' - CALL CALCI6 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'I1' - CALL CALCI1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRNAHSO4) THEN - SCASE = 'I2' - CALL CALCI2 ! NA2SO4,(NH4)2SO4,NAHSO4,LC - - ELSEIF (DRNAHSO4 <= RH .AND. RH < DRLC) THEN - SCASE = 'I3' - CALL CALCI3 ! NA2SO4,(NH4)2SO4,LC - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'I4' - CALL CALCI4 ! NA2SO4,(NH4)2SO4 - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'I5' - CALL CALCI5 ! NA2SO4 - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'I6' - CALL CALCI6 ! NO SOLIDS - ENDIF - ENDIF - - CALL CALCNHA ! MINOR SPECIES: HNO3, HCl - CALL CALCNH3 ! NH3 - - ! *** SULFATE RICH (FREE ACID) - - ELSEIF (SULRAT < 1.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'J3' - CALL CALCJ3 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'J1' - CALL CALCJ1 ! NH4HSO4,NAHSO4 - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRNAHSO4) THEN - SCASE = 'J2' - CALL CALCJ2 ! NAHSO4 - - ELSEIF (DRNAHSO4 <= RH) THEN - SCASE = 'J3' - CALL CALCJ3 - ENDIF - ENDIF - - CALL CALCNHA ! MINOR SPECIES: HNO3, HCl - CALL CALCNH3 ! NH3 - ENDIF - -! *** RETURN POINT - - RETURN - -! *** END OF SUBROUTINE ISRP3F ***************************************** - - END SUBROUTINE ISRP3F - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE ISRP4F -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -! AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM -! RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE ISRP4F (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - real :: NAFRI, NO3FRI - -! *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** - -! WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 -! WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 - -! *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ******** - -! IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN -! WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3 -! WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3 -! ENDIF - -! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** - - CALL INIT4 (WI, RHI, TEMPI) - -! *** CHECK IF TOO MUCH SODIUM+CRUSTALS ; ADJUST AND ISSUE ERROR MESSAGE - - REST = 2.D0*W(2) + W(4) + W(5) - - IF (W(1)+W(6)+W(7)+W(8) > REST) THEN - - CCASO4I = MIN (W(2),W(6)) - FRSO4I = MAX (W(2) - CCASO4I, ZERO) - CAFRI = MAX (W(6) - CCASO4I, ZERO) - CCANO32I = MIN (CAFRI, 0.5D0*W(4)) - CAFRI = MAX (CAFRI - CCANO32I, ZERO) - NO3FRI = MAX (W(4) - 2.D0*CCANO32I, ZERO) - CCACL2I = MIN (CAFRI, 0.5D0*W(5)) - CLFRI = MAX (W(5) - 2.D0*CCACL2I, ZERO) - REST1 = 2.D0*FRSO4I + NO3FRI + CLFRI - - CNA2SO4I = MIN (FRSO4I, 0.5D0*W(1)) - FRSO4I = MAX (FRSO4I - CNA2SO4I, ZERO) - NAFRI = MAX (W(1) - 2.D0*CNA2SO4I, ZERO) - CNACLI = MIN (NAFRI, CLFRI) - NAFRI = MAX (NAFRI - CNACLI, ZERO) - CLFRI = MAX (CLFRI - CNACLI, ZERO) - CNANO3I = MIN (NAFRI, NO3FRI) - NO3FR = MAX (NO3FRI - CNANO3I, ZERO) - REST2 = 2.D0*FRSO4I + NO3FRI + CLFRI - - CMGSO4I = MIN (FRSO4I, W(8)) - FRMGI = MAX (W(8) - CMGSO4I, ZERO) - FRSO4I = MAX (FRSO4I - CMGSO4I, ZERO) - CMGNO32I = MIN (FRMGI, 0.5D0*NO3FRI) - FRMGI = MAX (FRMGI - CMGNO32I, ZERO) - NO3FRI = MAX (NO3FRI - 2.D0*CMGNO32I, ZERO) - CMGCL2I = MIN (FRMGI, 0.5D0*CLFRI) - CLFRI = MAX (CLFRI - 2.D0*CMGCL2I, ZERO) - REST3 = 2.D0*FRSO4I + NO3FRI + CLFRI - - IF (W(6) > REST) THEN ! Ca > 2*SO4+CL+NO3 ? - W(6) = (ONE-1D-6)*REST ! Adjust Ca amount - W(1)= ZERO ! Adjust Na amount - W(7)= ZERO ! Adjust K amount - W(8)= ZERO ! Adjust Mg amount - CALL PUSHERR (0051, 'ISRP4F') ! Warning error: Ca, Na, K, Mg in excess - - ELSE IF (W(1) > REST1) THEN ! Na > 2*FRSO4+FRCL+FRNO3 ? - W(1) = (ONE-1D-6)*REST1 ! Adjust Na amount - W(7)= ZERO ! Adjust K amount - W(8)= ZERO ! Adjust Mg amount - CALL PUSHERR (0052, 'ISRP4F') ! Warning error: Na, K, Mg in excess - - ELSE IF (W(8) > REST2) THEN ! Mg > 2*FRSO4+FRCL+FRNO3 ? - W(8) = (ONE-1D-6)*REST2 ! Adjust Mg amount - W(7)= ZERO ! Adjust K amount - CALL PUSHERR (0053, 'ISRP4F') ! Warning error: K, Mg in excess - - ELSE IF (W(7) > REST3) THEN ! K > 2*FRSO4+FRCL+FRNO3 ? - W(7) = (ONE-1D-6)*REST3 ! Adjust K amount - CALL PUSHERR (0054, 'ISRP4F') ! Warning error: K in excess - ENDIF - ENDIF - -! *** CALCULATE RATIOS ************************************************* - - SO4RAT = (W(1)+W(3)+W(6)+W(7)+W(8))/W(2) - CRNARAT = (W(1)+W(6)+W(7)+W(8))/W(2) - CRRAT = (W(6)+W(7)+W(8))/W(2) - -! *** FIND CALCULATION REGIME FROM (SO4RAT, CRNARAT, CRRAT, RRH) ******** - -! *** SULFATE POOR: Rso4>2; (DUST + SODIUM) POOR: R(Cr+Na)<2 - - IF (2.0 <= SO4RAT .AND. CRNARAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'O7' - CALL CALCO7 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'O1' - CALL CALCO1 ! CaSO4, NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'O2' - CALL CALCO2 ! CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4CL <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'O3' - CALL CALCO3 ! CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'O4' - CALL CALCO4 ! CaSO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'O5' - CALL CALCO5 ! CaSO4, NA2SO4, K2SO4 - - ELSEIF (DRNA2SO4 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'O6' - CALL CALCO6 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'O7' - CALL CALCO7 ! CaSO4 - ENDIF - ENDIF - - ! *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. - - ELSEIF (SO4RAT >= 2.0 .AND. CRNARAT >= 2.0) THEN - - IF (CRRAT <= 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'M8' - CALL CALCM8 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'M1' - CALL CALCM1 ! CaSO4, NH4NO3, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'M2' - CALL CALCM2 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'M3' - CALL CALCM3 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4Cl) THEN - SCASE = 'M4' - CALL CALCM4 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4Cl <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'M5' - CALL CALCM5 ! CaSO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'M6' - CALL CALCM6 ! CaSO4, NA2SO4, K2SO4 - - ELSEIF (DRNA2SO4 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'M7' - CALL CALCM7 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'M8' - CALL CALCM8 ! CaSO4 - ENDIF - ENDIF - ! CALL CALCHCO3 - - ! *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. - - ELSEIF (CRRAT > 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'P13' - CALL CALCP13 ! Only liquid (metastable) - ELSE - - IF (RH < DRCACL2) THEN - SCASE = 'P1' - CALL CALCP1 ! CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRCACL2 <= RH .AND. RH < DRMGCL2) THEN - SCASE = 'P2' - CALL CALCP2 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRMGCL2 <= RH .AND. RH < DRCANO32) THEN - SCASE = 'P3' - CALL CALCP3 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRCANO32 <= RH .AND. RH < DRMGNO32) THEN - SCASE = 'P4' - CALL CALCP4 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRMGNO32 <= RH .AND. RH < DRNH4NO3) THEN - SCASE = 'P5' - CALL CALCP5 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! ! NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'P6' - CALL CALCP6 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4CL - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'P7' - CALL CALCP7 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NACL, NH4CL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'P8' - CALL CALCP8 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NH4CL - - ELSEIF (DRNH4CL <= RH .AND. RH < DRKCL) THEN - SCASE = 'P9' - CALL CALCP9 ! CaSO4, K2SO4, KNO3, KCL, MGSO4 - - ELSEIF (DRKCL <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'P10' - CALL CALCP10 ! CaSO4, K2SO4, KNO3, MGSO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRKNO3) THEN - SCASE = 'P11' - CALL CALCP11 ! CaSO4, K2SO4, KNO3 - - ELSEIF (DRKNO3 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'P12' - CALL CALCP12 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'P13' - CALL CALCP13 ! CaSO4 - ENDIF - ENDIF - ! CALL CALCHCO3 - ENDIF - - ! *** SULFATE RICH (NO ACID): 1= 2.0) -! 2. LIQUID AEROSOL PHASE ONLY POSSIBLE - -! FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS X, THE -! AMOUNT OF HYDROGEN IONS (H+) FOUND IN THE LIQUID PHASE. -! FOR EACH ESTIMATION OF H+, FUNCTION FUNCB2A CALCULATES THE -! CONCENTRATION OF IONS FROM THE NH3(GAS) - NH4+(LIQ) EQUILIBRIUM. -! ELECTRONEUTRALITY IS USED AS THE OBJECTIVE FUNCTION. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCA2 - INCLUDE 'isrpia.inc' - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - OMELO = TINY ! Low limit: SOLUTION IS VERY BASIC - OMEHI = 2.0D0*W(2) ! High limit: FROM NH4+ -> NH3(g) + H+(aq) - -! *** CALCULATE WATER CONTENT ***************************************** - - MOLAL(5) = W(2) - MOLAL(6) = ZERO - CALL CALCMR - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = OMEHI - Y1 = FUNCA2 (X1) - IF (ABS(Y1) <= EPS) RETURN - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (OMEHI-OMELO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, OMELO) - Y2 = FUNCA2 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - IF (ABS(Y2) <= EPS) THEN - RETURN - ELSE - CALL PUSHERR (0001, 'CALCA2') ! WARNING ERROR: NO SOLUTION - RETURN - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCA2 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCA2') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCA2 (X3) - RETURN - -! *** END OF SUBROUTINE CALCA2 **************************************** - - END SUBROUTINE CALCA2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCA2 -! *** CASE A2 -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE A2 ; -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA2. - -!======================================================================= - - real FUNCTION FUNCA2 (OMEGI) - INCLUDE 'isrpia.inc' - real :: LAMDA - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - PSI = W(2) ! INITIAL AMOUNT OF (NH4)2SO4 IN SOLUTION - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - A2 = XK2*R*TEMP/XKW*(GAMA(8)/GAMA(9))**2. - A3 = XKW*RH*WATER*WATER - - LAMDA = PSI/(A1/OMEGI+ONE) - ZETA = A3/OMEGI - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = OMEGI ! HI - MOLAL (5) = MAX(PSI-LAMDA,TINY) ! SO4I - MOLAL (3) = MAX(W(3)/(ONE/A2/OMEGI + ONE), 2.*MOLAL(5)) ! NH4I - MOLAL (6) = LAMDA ! HSO4I - GNH3 = MAX (W(3)-MOLAL(3), TINY) ! NH3GI - COH = ZETA ! OHI - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 DENOM = (2.0*MOLAL(5)+MOLAL(6)) - FUNCA2= (MOLAL(3)/DENOM - ONE) + MOLAL(1)/DENOM - RETURN - -! *** END OF FUNCTION FUNCA2 ******************************************** - - END FUNCTION FUNCA2 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCA1 -! *** CASE A1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4 - -! A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4 -! IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN -! THE GAS PHASE. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCA1 - INCLUDE 'isrpia.inc' - - CNH42S4 = W(2) - GNH3 = MAX (W(3)-2.0*CNH42S4, ZERO) - RETURN - -! *** END OF SUBROUTINE CALCA1 ****************************************** - - END SUBROUTINE CALCA1 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB4 -! *** CASE B4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. LIQUID AEROSOL PHASE ONLY POSSIBLE - -! FOR CALCULATIONS, A BISECTION IS PERFORMED WITH RESPECT TO H+. -! THE OBJECTIVE FUNCTION IS THE DIFFERENCE BETWEEN THE ESTIMATED H+ -! AND THAT CALCULATED FROM ELECTRONEUTRALITY. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB4 - INCLUDE 'isrpia.inc' - -! *** SOLVE EQUATIONS ************************************************** - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE WATER CONTENT ****************************************** - - CALL CALCB1A ! GET DRY SALT CONTENT, AND USE FOR WATER. - MOLALR(13) = CLC - MOLALR(9) = CNH4HS4 - MOLALR(4) = CNH42S4 - CLC = ZERO - CNH4HS4 = ZERO - CNH42S4 = ZERO - WATER = MOLALR(13)/M0(13)+MOLALR(9)/M0(9)+MOLALR(4)/M0(4) - - MOLAL(3) = W(3) ! NH4I - - DO 20 I=1,NSWEEP - AK1 = XK1*((GAMA(8)/GAMA(7))**2.)*(WATER/GAMA(7)) - BET = W(2) - GAM = MOLAL(3) - - BB = BET + AK1 - GAM - CC =-AK1*BET - DD = BB*BB - 4.D0*CC - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (5) = MAX(TINY,MIN(0.5*(-BB + SQRT(DD)), W(2))) ! SO4I - MOLAL (6) = MAX(TINY,MIN(W(2)-MOLAL(5),W(2))) ! HSO4I - MOLAL (1) = MAX(TINY,MIN(AK1*MOLAL(6)/MOLAL(5),W(2))) ! HI - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF ( .NOT. CALAIN) GOTO 30 - CALL CALCACT - 20 END DO - - 30 RETURN - -! *** END OF SUBROUTINE CALCB4 ****************************************** - - END SUBROUTINE CALCB4 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB3 -! *** CASE B3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE -! 3. SOLIDS POSSIBLE: (NH4)2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB3 - INCLUDE 'isrpia.inc' - -! *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 *********************** - - X = MAX(2*W(2)-W(3), ZERO) ! Equivalent NH4HSO4 - Y = MAX(W(3) -W(2), ZERO) ! Equivalent NH42SO4 - -! *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 ********* - - IF (X < Y) THEN ! LC is the MIN (x,y) - SCASE = 'B3 ; SUBCASE 1' - TLC = X - TNH42S4 = Y-X - CALL CALCB3A (TLC,TNH42S4) ! LC + (NH4)2SO4 - ELSE - SCASE = 'B3 ; SUBCASE 2' - TLC = Y - TNH4HS4 = X-Y - CALL CALCB3B (TLC,TNH4HS4) ! LC + NH4HSO4 - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCB3 ****************************************** - - END SUBROUTINE CALCB3 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB3A -! *** CASE B3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH (1.0 < SULRAT < 2.0) -! 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE -! 3. SOLIDS POSSIBLE: (NH4)2SO4 - -! FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE -! AMOUNT OF SOLID (NH4)2SO4 DISSOLVED IN THE LIQUID PHASE. -! FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB3A CALCULATES THE -! AMOUNT OF H+ PRODUCED (BASED ON THE SO4 RELEASED INTO THE -! SOLUTION). THE SOLUBILITY PRODUCT OF (NH4)2SO4 IS USED AS THE -! OBJECTIVE FUNCTION. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB3A (TLC, TNH42S4) - INCLUDE 'isrpia.inc' - - CALAOU = .TRUE. ! Outer loop activity calculation flag - ZLO = ZERO ! MIN DISSOLVED (NH4)2SO4 - ZHI = TNH42S4 ! MAX DISSOLVED (NH4)2SO4 - -! *** INITIAL VALUES FOR BISECTION (DISSOLVED (NH4)2SO4 **************** - - Z1 = ZLO - Y1 = FUNCB3A (Z1, TLC, TNH42S4) - IF (ABS(Y1) <= EPS) RETURN - YLO= Y1 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** - - DZ = (ZHI-ZLO)/FLOAT(NDIV) - DO 10 I=1,NDIV - Z2 = Z1+DZ - Y2 = FUNCB3A (Z2, TLC, TNH42S4) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - Z1 = Z2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YHI= Y1 ! Save Y-value at HI position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - RETURN - - ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - Z1 = ZHI - Z2 = ZHI - GOTO 40 - - ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - Z1 = ZLO - Z2 = ZLO - GOTO 40 - ELSE - CALL PUSHERR (0001, 'CALCB3A') ! WARNING ERROR: NO SOLUTION - RETURN - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - Z3 = 0.5*(Z1+Z2) - Y3 = FUNCB3A (Z3, TLC, TNH42S4) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - Z2 = Z3 - ELSE - Y1 = Y3 - Z1 = Z3 - ENDIF - IF (ABS(Z2-Z1) <= EPS*Z1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCB3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ************************************************ - - 40 ZK = 0.5*(Z1+Z2) - Y3 = FUNCB3A (ZK, TLC, TNH42S4) - - RETURN - -! *** END OF SUBROUTINE CALCB3A ****************************************** - - END SUBROUTINE CALCB3A - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCB3A -! *** CASE B3 ; SUBCASE 1 -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B3 -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA3. - -!======================================================================= - - real FUNCTION FUNCB3A (ZK, Y, X) - INCLUDE 'isrpia.inc' - real :: KK - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - FRST = .TRUE. - CALAIN = .TRUE. - DO 20 I=1,NSWEEP - GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - DD = SQRT( (ZK+GRAT1+Y)**2. + 4.0*Y*GRAT1) - KK = 0.5*(-(ZK+GRAT1+Y) + DD ) - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = KK ! HI - MOLAL (5) = KK+ZK+Y ! SO4I - MOLAL (6) = MAX (Y-KK, TINY) ! HSO4I - MOLAL (3) = 3.0*Y+2*ZK ! NH4I - CNH42S4 = X-ZK ! Solid (NH4)2SO4 - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 30 - ENDIF - 20 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - -! C30 FUNCB3A= ( SO4I*NH4I**2.0 )/( XK7*(WATER/GAMA(4))**3.0 ) - 30 FUNCB3A= MOLAL(5)*MOLAL(3)**2.0 - FUNCB3A= FUNCB3A/(XK7*(WATER/GAMA(4))**3.0) - ONE - RETURN - -! *** END OF FUNCTION FUNCB3A ******************************************** - - END FUNCTION FUNCB3A - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB3B -! *** CASE B3 ; SUBCASE 2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH (1.0 < SULRAT < 2.0) -! 2. LIQUID PHASE ONLY IS POSSIBLE - -! SPECIATION CALCULATIONS IS BASED ON THE HSO4 <--> SO4 EQUILIBRIUM. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB3B (Y, X) - INCLUDE 'isrpia.inc' - real :: KK - - CALAOU = .FALSE. ! Outer loop activity calculation flag - FRST = .FALSE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 20 I=1,NSWEEP - GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - DD = SQRT( (GRAT1+Y)**2. + 4.0*(X+Y)*GRAT1) - KK = 0.5*(-(GRAT1+Y) + DD ) - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = KK ! HI - MOLAL (5) = Y+KK ! SO4I - MOLAL (6) = MAX (X+Y-KK, TINY) ! HSO4I - MOLAL (3) = 3.0*Y+X ! NH4I - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF ( .NOT. CALAIN) GOTO 30 - CALL CALCACT - 20 END DO - - 30 RETURN - -! *** END OF SUBROUTINE CALCB3B ****************************************** - - END SUBROUTINE CALCB3B -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB2 -! *** CASE B2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : LC, (NH4)2SO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON THE SULFATE RATIO: -! 1. WHEN BOTH LC AND (NH4)2SO4 ARE POSSIBLE (SUBROUTINE CALCB2A) -! 2. WHEN ONLY LC IS POSSIBLE (SUBROUTINE CALCB2B). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB2 - INCLUDE 'isrpia.inc' - -! *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 *********************** - - X = MAX(2*W(2)-W(3), TINY) ! Equivalent NH4HSO4 - Y = MAX(W(3) -W(2), TINY) ! Equivalent NH42SO4 - -! *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 ********* - - IF (X <= Y) THEN ! LC is the MIN (x,y) - SCASE = 'B2 ; SUBCASE 1' - CALL CALCB2A (X,Y-X) ! LC + (NH4)2SO4 POSSIBLE - ELSE - SCASE = 'B2 ; SUBCASE 2' - CALL CALCB2B (Y,X-Y) ! LC ONLY POSSIBLE - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCB2 ****************************************** - - END SUBROUTINE CALCB2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB2 -! *** CASE B2 ; SUBCASE A. - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH (1.0 < SULRAT < 2.0) -! 2. SOLID PHASE ONLY POSSIBLE -! 3. SOLIDS POSSIBLE: LC, (NH4)2SO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE - -! FOR SOLID CALCULATIONS, A MATERIAL BALANCE BASED ON THE STOICHIMETRIC -! PROPORTION OF AMMONIUM AND SULFATE IS DONE TO CALCULATE THE AMOUNT -! OF LC AND (NH4)2SO4 IN THE SOLID PHASE. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB2A (TLC, TNH42S4) - INCLUDE 'isrpia.inc' - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMLCAS) THEN - SCASE = 'B2 ; SUBCASE A1' ! SOLIDS POSSIBLE ONLY - CLC = TLC - CNH42S4 = TNH42S4 - SCASE = 'B2 ; SUBCASE A1' - ELSE - SCASE = 'B2 ; SUBCASE A2' - CALL CALCB2A2 (TLC, TNH42S4) ! LIQUID & SOLID PHASE POSSIBLE - SCASE = 'B2 ; SUBCASE A2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCB2A ***************************************** - - END SUBROUTINE CALCB2A - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB2A2 -! *** CASE B2 ; SUBCASE A2. - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH (1.0 < SULRAT < 2.0) -! 2. SOLID PHASE ONLY POSSIBLE -! 3. SOLIDS POSSIBLE: LC, (NH4)2SO4 - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB2A1) AND THE -! THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB3). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB2A2 (TLC, TNH42S4) - INCLUDE 'isrpia.inc' - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ZERO - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (DRLC-RH)/(DRLC-DRMLCAS) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CLCO = TLC ! FIRST (DRY) SOLUTION - CNH42SO = TNH42S4 - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CLC = ZERO - CNH42S4 = ZERO - CALL CALCB3 ! SECOND (LIQUID) SOLUTION - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - - MOLAL(1)= ONEMWF*MOLAL(1) ! H+ - MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + 3.D0*(CLCO-CLC)) ! NH4+ - MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4-- - MOLAL(6)= ONEMWF*(CLCO-CLC) ! HSO4- - - WATER = ONEMWF*WATER - - CLC = WF*CLCO + ONEMWF*CLC - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - - RETURN - -! *** END OF SUBROUTINE CALCB2A2 **************************************** - - END SUBROUTINE CALCB2A2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB2 -! *** CASE B2 ; SUBCASE B - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH (1.0 < SULRAT < 2.0) -! 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE -! 3. SOLIDS POSSIBLE: LC - -! FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE -! AMOUNT OF SOLID LC DISSOLVED IN THE LIQUID PHASE. -! FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB2A CALCULATES THE -! AMOUNT OF H+ PRODUCED (BASED ON THE HSO4, SO4 RELEASED INTO THE -! SOLUTION). THE SOLUBILITY PRODUCT OF LC IS USED AS THE OBJECTIVE -! FUNCTION. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB2B (TLC,TNH4HS4) - INCLUDE 'isrpia.inc' - - CALAOU = .TRUE. ! Outer loop activity calculation flag - ZLO = ZERO - ZHI = TLC ! High limit: all of it in liquid phase - -! *** INITIAL VALUES FOR BISECTION ************************************** - - X1 = ZHI - Y1 = FUNCB2B (X1,TNH4HS4,TLC) - IF (ABS(Y1) <= EPS) RETURN - YHI= Y1 ! Save Y-value at Hi position - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ************************ - - DX = (ZHI-ZLO)/NDIV - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCB2B (X2,TNH4HS4,TLC) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YLO= Y1 ! Save Y-value at LO position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - RETURN - - ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - X1 = ZHI - X2 = ZHI - GOTO 40 - - ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - X1 = ZLO - X2 = ZLO - GOTO 40 - ELSE - CALL PUSHERR (0001, 'CALCB2B') ! WARNING ERROR: NO SOLUTION - RETURN - ENDIF - -! *** PERFORM BISECTION ************************************************* - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCB2B (X3,TNH4HS4,TLC) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCB2B') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ************************************************ - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCB2B (X3,TNH4HS4,TLC) - - RETURN - -! *** END OF SUBROUTINE CALCB2B ***************************************** - - END SUBROUTINE CALCB2B - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCB2B -! *** CASE B2 ; -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B2 ; SUBCASE 2 -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCB2B. - -!======================================================================= - - real FUNCTION FUNCB2B (X,TNH4HS4,TLC) - INCLUDE 'isrpia.inc' - -! *** SOLVE EQUATIONS ************************************************** - - FRST = .TRUE. - CALAIN = .TRUE. - DO 20 I=1,NSWEEP - GRAT2 = XK1*WATER*(GAMA(8)/GAMA(7))**2./GAMA(7) - PARM = X+GRAT2 - DELTA = PARM*PARM + 4.0*(X+TNH4HS4)*GRAT2 ! Diakrinousa - OMEGA = 0.5*(-PARM + SQRT(DELTA)) ! Thetiki riza (ie:H+>0) - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = OMEGA ! HI - MOLAL (3) = 3.0*X+TNH4HS4 ! NH4I - MOLAL (5) = X+OMEGA ! SO4I - MOLAL (6) = MAX (X+TNH4HS4-OMEGA, TINY) ! HSO4I - CLC = MAX(TLC-X,ZERO) ! Solid LC - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ****************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 30 - ENDIF - 20 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************** - -! C30 FUNCB2B= ( NH4I**3.*SO4I*HSO4I )/( XK13*(WATER/GAMA(13))**5. ) - 30 FUNCB2B= (MOLAL(3)**3.)*MOLAL(5)*MOLAL(6) - FUNCB2B= FUNCB2B/(XK13*(WATER/GAMA(13))**5.) - ONE - RETURN - -! *** END OF FUNCTION FUNCB2B ******************************************* - - END FUNCTION FUNCB2B - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB1 -! *** CASE B1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : LC, (NH4)2SO4, NH4HSO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCB1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB1 - INCLUDE 'isrpia.inc' - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMLCAB) THEN - SCASE = 'B1 ; SUBCASE 1' - CALL CALCB1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'B1 ; SUBCASE 1' - ELSE - SCASE = 'B1 ; SUBCASE 2' - CALL CALCB1B ! LIQUID & SOLID PHASE POSSIBLE - SCASE = 'B1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCB1 ****************************************** - - END SUBROUTINE CALCB1 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB1A -! *** CASE B1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH -! 2. THERE IS NO LIQUID PHASE -! 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO -! BUT NOT BOTH) - -! A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE AMOUNT OF LC -! IS CALCULATED FROM THE (NH4)2SO4 AND NH4HSO4 WHICH IS LEAST -! ABUNDANT (STOICHIMETRICALLY). THE REMAINING EXCESS OF SALT -! IS MIXED WITH THE LC. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB1A - INCLUDE 'isrpia.inc' - -! *** SETUP PARAMETERS ************************************************ - - X = 2*W(2)-W(3) ! Equivalent NH4HSO4 - Y = W(3)-W(2) ! Equivalent (NH4)2SO4 - -! *** CALCULATE COMPOSITION ******************************************* - - IF (X <= Y) THEN ! LC is the MIN (x,y) - CLC = X ! NH4HSO4 >= (NH4)2S04 - CNH4HS4 = ZERO - CNH42S4 = Y-X - ELSE - CLC = Y ! NH4HSO4 < (NH4)2S04 - CNH4HS4 = X-Y - CNH42S4 = ZERO - ENDIF - RETURN - -! *** END OF SUBROUTINE CALCB1 ****************************************** - - END SUBROUTINE CALCB1A - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCB1B -! *** CASE B1 ; SUBCASE 2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO -! BUT NOT BOTH) - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB1A) AND THE -! THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB2). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCB1B - INCLUDE 'isrpia.inc' - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ZERO - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (DRNH4HS4-RH)/(DRNH4HS4-DRMLCAB) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CALL CALCB1A - CLCO = CLC ! FIRST (DRY) SOLUTION - CNH42SO = CNH42S4 - CNH4HSO = CNH4HS4 - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CLC = ZERO - CNH42S4 = ZERO - CNH4HS4 = ZERO - CALL CALCB2 ! SECOND (LIQUID) SOLUTION - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - - MOLAL(1)= ONEMWF*MOLAL(1) ! H+ - MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + (CNH4HSO-CNH4HS4) & - + 3.D0*(CLCO-CLC)) ! NH4+ - MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4-- - MOLAL(6)= ONEMWF*(CNH4HSO-CNH4HS4 + CLCO-CLC) ! HSO4- - - WATER = ONEMWF*WATER - - CLC = WF*CLCO + ONEMWF*CLC - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 - - RETURN - -! *** END OF SUBROUTINE CALCB1B ***************************************** - - END SUBROUTINE CALCB1B - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCC2 -! *** CASE C2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS ONLY A LIQUID PHASE - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCC2 - INCLUDE 'isrpia.inc' - real :: LAMDA, KAPA - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ************************************************** - - LAMDA = W(3) ! NH4HSO4 INITIALLY IN SOLUTION - PSI = W(2)-W(3) ! H2SO4 IN SOLUTION - DO 20 I=1,NSWEEP - PARM = WATER*XK1/GAMA(7)*(GAMA(8)/GAMA(7))**2. - BB = PSI+PARM - CC =-PARM*(LAMDA+PSI) - KAPA = 0.5*(-BB+SQRT(BB*BB-4.0*CC)) - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL(1) = PSI+KAPA ! HI - MOLAL(3) = LAMDA ! NH4I - MOLAL(5) = KAPA ! SO4I - MOLAL(6) = MAX(LAMDA+PSI-KAPA, TINY) ! HSO4I - CH2SO4 = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3), ZERO) ! Free H2SO4 - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF ( .NOT. CALAIN) GOTO 30 - CALL CALCACT - 20 END DO - - 30 RETURN - -! *** END OF SUBROUTINE CALCC2 ***************************************** - - END SUBROUTINE CALCC2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCC1 -! *** CASE C1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE: NH4HSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCC1 - INCLUDE 'isrpia.inc' - real :: KLO, KHI - - CALAOU = .TRUE. ! Outer loop activity calculation flag - KLO = TINY - KHI = W(3) - -! *** INITIAL VALUES FOR BISECTION ************************************* - - X1 = KLO - Y1 = FUNCC1 (X1) - IF (ABS(Y1) <= EPS) GOTO 50 - YLO= Y1 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** - - DX = (KHI-KLO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCC1 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YHI= Y2 ! Save Y-value at HI position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - - ! *** { YLO, YHI } < 0.0 SOLUTION IS ALWAYS UNDERSATURATED WITH NH4HS04 - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - GOTO 50 - - ! *** { YLO, YHI } > 0.0 SOLUTION IS ALWAYS SUPERSATURATED WITH NH4HS04 - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - X1 = KLO - X2 = KLO - GOTO 40 - ELSE - CALL PUSHERR (0001, 'CALCC1') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION OF DISSOLVED NH4HSO4 ************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCC1 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCC1') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN *********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCC1 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCC1 ***************************************** - - END SUBROUTINE CALCC1 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCC1 -! *** CASE C1 ; -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE C1 -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCC1. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCC1 (KAPA) - INCLUDE 'isrpia.inc' - real :: KAPA, LAMDA - -! *** SOLVE EQUATIONS ************************************************** - - FRST = .TRUE. - CALAIN = .TRUE. - - PSI = W(2)-W(3) - DO 20 I=1,NSWEEP - PAR1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - PAR2 = XK12*(WATER/GAMA(9))**2.0 - BB = PSI + PAR1 - CC =-PAR1*(PSI+KAPA) - LAMDA = 0.5*(-BB+SQRT(BB*BB-4*CC)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************* - - MOLAL(1) = PSI+LAMDA ! HI - MOLAL(3) = KAPA ! NH4I - MOLAL(5) = LAMDA ! SO4I - MOLAL(6) = MAX (ZERO, PSI+KAPA-LAMDA) ! HSO4I - CNH4HS4 = MAX(W(3)-MOLAL(3), ZERO) ! Solid NH4HSO4 - CH2SO4 = MAX(PSI, ZERO) ! Free H2SO4 - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 30 - ENDIF - 20 END DO - -! *** CALCULATE ZERO FUNCTION ******************************************* - -! C30 FUNCC1= (NH4I*HSO4I/PAR2) - ONE - 30 FUNCC1= (MOLAL(3)*MOLAL(6)/PAR2) - ONE - RETURN - -! *** END OF FUNCTION FUNCC1 ******************************************** - - END FUNCTION FUNCC1 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCD3 -! *** CASE D3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. THERE IS OLNY A LIQUID PHASE - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCD3 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCD1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4NO3 ! Save from CALCD1 run - CHI2 = CNH42S4 - CHI3 = GHNO3 - CHI4 = GNH3 - - PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's - PSI2 = CHI2 - PSI3 = ZERO - PSI4 = ZERO - - MOLAL(5) = ZERO - MOLAL(6) = ZERO - MOLAL(3) = PSI1 - MOLAL(7) = PSI1 - CALL CALCMR ! Initial water - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = TINY ! Low limit - PSI4HI = CHI4 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - 60 X1 = PSI4LO - Y1 = FUNCD3 (X1) - IF (ABS(Y1) <= EPS) RETURN - YLO= Y1 ! Save Y-value at HI position - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCD3 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YHI= Y1 ! Save Y-value at Hi position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - RETURN - - ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 - ! Physically I dont know when this might happen, but I have put this - ! branch in for completeness. I assume there is no solution; all NO3 goes to the - ! gas phase. - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - P4 = TINY ! PSI4LO ! CHI4 - YY = FUNCD3(P4) - GOTO 50 - - ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 - ! This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates - ! and goes to the gas phase ; so I redefine the LO and HI limits of PSI4 - ! and proceed again with root tracking. - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - PSI4HI = PSI4LO - PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates - IF (PSI4LO < -(PSI1+PSI2)) THEN - CALL PUSHERR (0001, 'CALCD3') ! WARNING ERROR: NO SOLUTION - RETURN - ELSE - MOLAL(5) = ZERO - MOLAL(6) = ZERO - MOLAL(3) = PSI1 - MOLAL(7) = PSI1 - CALL CALCMR ! Initial water - GOTO 60 ! Redo root tracking - ENDIF - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCD3 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*ABS(X1)) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCD3') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCD3 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - RETURN - -! *** END OF SUBROUTINE CALCD3 ****************************************** - - END SUBROUTINE CALCD3 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCD3 -! *** CASE D3 -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D3 ; -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD3. - -!======================================================================= - - real FUNCTION FUNCD3 (P4) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - PSI4 = P4 - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A2 = XK7*(WATER/GAMA(4))**3.0 - A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A7 = XKW *RH*WATER*WATER - - PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4) - PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4) - PSI3 = MIN(MAX(PSI3, ZERO), CHI3) - - BB = PSI4 - PSI3 - ! COLD AHI = 0.5*(-BB + SQRT(BB*BB + 4.d0*A7)) ! This is correct also - ! C AHI =2.0*A7/(BB+SQRT(BB*BB + 4.d0*A7)) ! Avoid overflow when HI->0 - DENM = BB+SQRT(BB*BB + 4.d0*A7) - IF (DENM <= TINY) THEN ! Avoid overflow when HI->0 - ABB = ABS(BB) - DENM = (BB+ABB) + 2.0*A7/ABB ! Taylor expansion of SQRT - ENDIF - AHI = 2.0*A7/DENM - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = AHI ! HI - MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4I - MOLAL (5) = PSI2 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI3 + PSI1 ! NO3I - CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 - CNH4NO3 = ZERO ! Solid NH4NO3 - GHNO3 = CHI3 - PSI3 ! Gas HNO3 - GNH3 = CHI4 - PSI4 ! Gas NH3 - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 CONTINUE -! C FUNCD3= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE - FUNCD3= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCD3 ******************************************** - - END FUNCTION FUNCD3 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCD2 -! *** CASE D2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCD2 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCD1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4NO3 ! Save from CALCD1 run - CHI2 = CNH42S4 - CHI3 = GHNO3 - CHI4 = GNH3 - - PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's - PSI2 = CNH42S4 - PSI3 = ZERO - PSI4 = ZERO - - MOLAL(5) = ZERO - MOLAL(6) = ZERO - MOLAL(3) = PSI1 - MOLAL(7) = PSI1 - CALL CALCMR ! Initial water - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = TINY ! Low limit - PSI4HI = CHI4 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - 60 X1 = PSI4LO - Y1 = FUNCD2 (X1) - IF (ABS(Y1) <= EPS) RETURN - YLO= Y1 ! Save Y-value at HI position - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCD2 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) THEN - - ! This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat) - - IF (Y1 <= Y2) GOTO 20 ! (Y1*Y2 < ZERO) - ENDIF - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YHI= Y1 ! Save Y-value at Hi position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - RETURN - - ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 - ! Physically I dont know when this might happen, but I have put this - ! branch in for completeness. I assume there is no solution; all NO3 goes to the - ! gas phase. - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - P4 = TINY ! PSI4LO ! CHI4 - YY = FUNCD2(P4) - GOTO 50 - - ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 - ! This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates - ! and goes to the gas phase ; so I redefine the LO and HI limits of PSI4 - ! and proceed again with root tracking. - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - PSI4HI = PSI4LO - PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates - IF (PSI4LO < -(PSI1+PSI2)) THEN - CALL PUSHERR (0001, 'CALCD2') ! WARNING ERROR: NO SOLUTION - RETURN - ELSE - MOLAL(5) = ZERO - MOLAL(6) = ZERO - MOLAL(3) = PSI1 - MOLAL(7) = PSI1 - CALL CALCMR ! Initial water - GOTO 60 ! Redo root tracking - ENDIF - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCD2 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*ABS(X1)) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCD2') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = MIN(X1,X2) ! 0.5*(X1+X2) ! Get "low" side, it's acidic soln. - Y3 = FUNCD2 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - RETURN - -! *** END OF SUBROUTINE CALCD2 ****************************************** - - END SUBROUTINE CALCD2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCD2 -! *** CASE D2 -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ; -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD2. - -!======================================================================= - - real FUNCTION FUNCD2 (P4) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALL RSTGAM ! Reset activity coefficients to 0.1 - FRST = .TRUE. - CALAIN = .TRUE. - PSI4 = P4 - PSI2 = CHI2 - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A2 = XK7*(WATER/GAMA(4))**3.0 - A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A7 = XKW *RH*WATER*WATER - - IF (CHI2 > TINY .AND. WATER > TINY) THEN - PSI14 = PSI1+PSI4 - CALL POLY3 (PSI14,0.25*PSI14**2.,-A2/4.D0, PSI2, ISLV) ! PSI2 - IF (ISLV == 0) THEN - PSI2 = MIN (PSI2, CHI2) - ELSE - PSI2 = TINY - ENDIF - ENDIF - - PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4) - PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4) - ! c PSI3 = MIN(MAX(PSI3, ZERO), CHI3) - - BB = PSI4-PSI3 ! (BB > 0, acidic solution, <0 alkaline) - - ! Do not change computation scheme for H+, all others did not work well. - - DENM = BB+SQRT(BB*BB + 4.d0*A7) - IF (DENM <= TINY) THEN ! Avoid overflow when HI->0 - ABB = ABS(BB) - DENM = (BB+ABB) + 2.d0*A7/ABB ! Taylor expansion of SQRT - ENDIF - AHI = 2.d0*A7/DENM - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL (1) = AHI ! HI - MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4 - MOLAL (5) = PSI2 ! SO4 - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI3 + PSI1 ! NO3 - CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 - CNH4NO3 = ZERO ! Solid NH4NO3 - GHNO3 = CHI3 - PSI3 ! Gas HNO3 - GNH3 = CHI4 - PSI4 ! Gas NH3 - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 CONTINUE -! C FUNCD2= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE - FUNCD2= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCD2 ******************************************** - - END FUNCTION FUNCD2 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCD1 -! *** CASE D1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 - -! THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY: -! 1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCD1A) -! 2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCD1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCD1A, CALCD2 - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMASAN) THEN - SCASE = 'D1 ; SUBCASE 1' ! SOLID PHASE ONLY POSSIBLE - CALL CALCD1A - SCASE = 'D1 ; SUBCASE 1' - ELSE - SCASE = 'D1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH (RH, DRMASAN, DRNH4NO3, CALCD1A, CALCD2) - SCASE = 'D1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCD1 ****************************************** - - END SUBROUTINE CALCD1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCD1A -! *** CASE D1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 - -! THE SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3 -! IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF -! NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN -! THE SOLID PHASE. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCD1A - INCLUDE 'isrpia.inc' - -! *** SETUP PARAMETERS ************************************************ - - PARM = XK10/(R*TEMP)/(R*TEMP) - -! *** CALCULATE NH4NO3 THAT VOLATIZES ********************************* - - CNH42S4 = W(2) - X = MAX(ZERO, MIN(W(3)-2.0*CNH42S4, W(4))) ! MAX NH4NO3 - PS = MAX(W(3) - X - 2.0*CNH42S4, ZERO) - OM = MAX(W(4) - X, ZERO) - - OMPS = OM+PS - DIAK = SQRT(OMPS*OMPS + 4.0*PARM) ! DIAKRINOUSA - ZE = MIN(X, 0.5*(-OMPS + DIAK)) ! THETIKI RIZA - -! *** SPECIATION ******************************************************* - - CNH4NO3 = X - ZE ! Solid NH4NO3 - GNH3 = PS + ZE ! Gas NH3 - GHNO3 = OM + ZE ! Gas HNO3 - - RETURN - -! *** END OF SUBROUTINE CALCD1A ***************************************** - - END SUBROUTINE CALCD1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG5 -! *** CASE G5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG5 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = 0.5*W(1) - CHI2 = MAX (W(2)-CHI1, ZERO) - CHI3 = ZERO - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - CHI5 = W(4) - CHI6 = W(5) - - PSI1 = CHI1 - PSI2 = CHI2 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCG5A (X1) - IF (CHI6 <= TINY) GOTO 50 -! c IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! c IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCG5A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCG5A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCG5A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCG5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCG5A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN ! If quadrat.called - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG5 ******************************************* - - END SUBROUTINE CALCG5 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCG5A -! *** CASE G5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCG5A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A2 = XK7 *(WATER/GAMA(4))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - AKK = A4*A6 - - ! CALCULATE DISSOCIATION QUANTITIES - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - ELSE - PSI4 = TINY - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = 2.0D0*PSI1 ! NAI - MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO - MOLAL (7) = PSI5 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3 - GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3 - GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl - - CNH42S4 = ZERO ! Solid (NH4)2SO4 - CNH4NO3 = ZERO ! Solid NH4NO3 - CNH4CL = ZERO ! Solid NH4Cl - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCG5A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCG5A ******************************************* - - END FUNCTION FUNCG5A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG4 -! *** CASE G4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG4 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = 0.5*W(1) - CHI2 = MAX (W(2)-CHI1, ZERO) - CHI3 = ZERO - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - CHI5 = W(4) - CHI6 = W(5) - - PSI2 = CHI2 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCG4A (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50 -! C IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCG4A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCG4A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCG4A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCG4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCG4A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG4 ******************************************* - - END SUBROUTINE CALCG4 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCG4A -! *** CASE G4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCG4A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA, NAI, NH4I, NO3I - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A2 = XK7 *(WATER/GAMA(4))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma shankar, 19/11/2001 - PSI4 =0.5d0*(-BB - SQRT(DD)) - ELSE - PSI4 = TINY - ENDIF - - ! CALCULATE CONCENTRATIONS - - NH4I = 2.0*PSI2 + PSI4 - CLI = PSI6 - SO4I = PSI2 + PSI1 - NO3I = PSI5 - NAI = 2.0D0*PSI1 - - CALL CALCPH(2.d0*SO4I+NO3I+CLI-NAI-NH4I, HI, OHI) - - ! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = HI - MOLAL (2) = NAI - MOLAL (3) = NH4I - MOLAL (4) = CLI - MOLAL (5) = SO4I - MOLAL (6) = ZERO - MOLAL (7) = NO3I - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = MAX(CHI1-PSI1,ZERO) - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCG4A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCG4A ******************************************* - - END FUNCTION FUNCG4A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG3 -! *** CASE G3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCG1A, CALCG4 - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (W(4) > TINY .AND. W(5) > TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE - SCASE = 'G3 ; SUBCASE 1' - CALL CALCG3A - SCASE = 'G3 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'G1 ; SUBCASE 1' - CALL CALCG1A - SCASE = 'G1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMG3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCG1A - SCASE = 'G3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'G3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4) - CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4) - SCASE = 'G3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG3 ****************************************** - - END SUBROUTINE CALCG3 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG3A -! *** CASE G3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG3A - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = 0.5*W(1) - CHI2 = MAX (W(2)-CHI1, ZERO) - CHI3 = ZERO - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - CHI5 = W(4) - CHI6 = W(5) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = TINY - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCG3A (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50 -! C IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCG3A (X2) - - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCG3A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCG3A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCG3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCG3A (X3) - -! *** FINAL CALCULATIONS ************************************************* - - 50 CONTINUE - -! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT - MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion - -! *** HSO4 equilibrium - - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG3A ****************************************** - - END SUBROUTINE CALCG3A - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCG3A -! *** CASE G3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCG3A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI2 = CHI2 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A2 = XK7 *(WATER/GAMA(4))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI2 > TINY .AND. WATER > TINY) THEN - CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV) - IF (ISLV == 0) PSI2 = MIN (PSI20, CHI2) - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - MOLAL (2) = ZERO ! Na - MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3 - GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3 - GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl - - CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 - CNH4NO3 = ZERO ! Solid NH4NO3 - CNH4CL = ZERO ! Solid NH4Cl - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCG3A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCG3A ******************************************* - - END FUNCTION FUNCG3A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG2 -! *** CASE G2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCG1A, CALCG3A, CALCG4 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) > TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'G2 ; SUBCASE 1' - CALL CALCG2A - SCASE = 'G2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'G1 ; SUBCASE 1' - CALL CALCG1A - SCASE = 'G1 ; SUBCASE 1' - ENDIF - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (WATER <= TINY) THEN - IF (RH < DRMG2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCG1A - SCASE = 'G2 ; SUBCASE 2' - ELSE - IF (W(5) > TINY) THEN - SCASE = 'G2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4) - CALL CALCMDRH (RH, DRMG2, DRNH4CL, CALCG1A, CALCG3A) - SCASE = 'G2 ; SUBCASE 3' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMG3) THEN - SCASE = 'G2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4) - CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4) - SCASE = 'G2 ; SUBCASE 4' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO - 20 END DO - CALL CALCG1A - SCASE = 'G2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG2 ****************************************** - - END SUBROUTINE CALCG2 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG2A -! *** CASE G2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG2A - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = 0.5*W(1) - CHI2 = MAX (W(2)-CHI1, ZERO) - CHI3 = ZERO - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - CHI5 = W(4) - CHI6 = W(5) - - PSI6LO = TINY - PSI6HI = CHI6-TINY - - WATER = TINY - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCG2A (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! C IF (WATER .LE. TINY) GOTO 50 ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCG2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) WATER = TINY - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCG2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCG2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - IF (X3 <= TINY2) THEN ! PRACTICALLY NO NITRATES, SO DRY SOLUTION - WATER = TINY - ELSE - Y3 = FUNCG2A (X3) - ENDIF - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - -! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT - MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion - -! *** HSO4 equilibrium - - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT - MOLAL(6) = DELTA ! HSO4 AFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG2A ****************************************** - - END SUBROUTINE CALCG2A - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCG2A -! *** CASE G2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCG2A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, & - PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, & - A1, A2, A3, A4, A5, A6, A7 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI2 = CHI2 - PSI3 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A2 = XK7 *(WATER/GAMA(4))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - - DENO = MAX(CHI6-PSI6-PSI3, ZERO) - PSI5 = CHI5/((A6/A5)*(DENO/PSI6) + ONE) - - PSI4 = MIN(PSI5+PSI6,CHI4) - - IF (CHI2 > TINY .AND. WATER > TINY) THEN - CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV) - IF (ISLV == 0) PSI2 = MIN (PSI20, CHI2) - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = ZERO ! NA - MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = MAX(CHI2 - PSI2, ZERO) - CNH4NO3 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 IF (CHI4 <= TINY) THEN - FUNCG2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - ELSE - FUNCG2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - ENDIF - - RETURN - -! *** END OF FUNCTION FUNCG2A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG1 -! *** CASE G1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4CL, NA2SO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCG1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCG1A, CALCG2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMG1) THEN - SCASE = 'G1 ; SUBCASE 1' - CALL CALCG1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'G1 ; SUBCASE 1' - ELSE - SCASE = 'G1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH (RH, DRMG1, DRNH4NO3, CALCG1A, CALCG2A) - SCASE = 'G1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCG1 ****************************************** - - END SUBROUTINE CALCG1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCG1A -! *** CASE G1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 - -! SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3 -! IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF -! NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN -! THE SOLID PHASE. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCG1A - INCLUDE 'isrpia.inc' - real :: LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2 - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CNA2SO4 = MIN (0.5*W(1), W(2)) - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX(W(2) - CNA2SO4, ZERO) -! CNH42S4 = W(2) - CNA2SO4 - CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4 - -! *** CALCULATE VOLATILE SPECIES ************************************** - - ALF = W(3) - 2.0*CNH42S4 - BET = W(5) - GAM = W(4) - - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - - THETA1 = GAM - BET*(A2/A1) - THETA2 = A2/A1 - -! QUADRATIC EQUATION SOLUTION - - BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) - CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) - DD = BB*BB - 4.0D0*CC - IF (DD < ZERO) GOTO 100 ! Solve each reaction seperately - -! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID - - SQDD = SQRT(DD) - KAPA1 = 0.5D0*(-BB+SQDD) - KAPA2 = 0.5D0*(-BB-SQDD) - LAMDA1 = THETA1 + THETA2*KAPA1 - LAMDA2 = THETA1 + THETA2*KAPA2 - - IF (KAPA1 >= ZERO .AND. LAMDA1 >= ZERO) THEN - IF (ALF-KAPA1-LAMDA1 >= ZERO .AND. & - BET-KAPA1 >= ZERO .AND. GAM-LAMDA1 >= ZERO) THEN - KAPA = KAPA1 - LAMDA= LAMDA1 - GOTO 200 - ENDIF - ENDIF - - IF (KAPA2 >= ZERO .AND. LAMDA2 >= ZERO) THEN - IF (ALF-KAPA2-LAMDA2 >= ZERO .AND. & - BET-KAPA2 >= ZERO .AND. GAM-LAMDA2 >= ZERO) THEN - KAPA = KAPA2 - LAMDA= LAMDA2 - GOTO 200 - ENDIF - ENDIF - -! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA - - 100 KAPA = ZERO - LAMDA = ZERO - DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) - DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) - -! NH4CL EQUILIBRIUM - - IF (DD1 >= ZERO) THEN - SQDD1 = SQRT(DD1) - KAPA1 = 0.5D0*(ALF+BET + SQDD1) - KAPA2 = 0.5D0*(ALF+BET - SQDD1) - - IF (KAPA1 >= ZERO .AND. KAPA1 <= MIN(ALF,BET)) THEN - KAPA = KAPA1 - ELSE IF (KAPA2 >= ZERO .AND. KAPA2 <= MIN(ALF,BET)) THEN - KAPA = KAPA2 - ELSE - KAPA = ZERO - ENDIF - ENDIF - -! NH4NO3 EQUILIBRIUM - - IF (DD2 >= ZERO) THEN - SQDD2 = SQRT(DD2) - LAMDA1= 0.5D0*(ALF+GAM + SQDD2) - LAMDA2= 0.5D0*(ALF+GAM - SQDD2) - - IF (LAMDA1 >= ZERO .AND. LAMDA1 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA1 - ELSE IF (LAMDA2 >= ZERO .AND. LAMDA2 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA2 - ELSE - LAMDA = ZERO - ENDIF - ENDIF - -! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION - - IF (KAPA > ZERO .AND. LAMDA > ZERO) THEN - IF (BET < LAMDA/THETA1) THEN - KAPA = ZERO - ELSE - LAMDA= ZERO - ENDIF - ENDIF - -! *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** - - 200 CONTINUE - CNH4NO3 = LAMDA - CNH4CL = KAPA - - GNH3 = MAX(ALF - KAPA - LAMDA, ZERO) - GHNO3 = MAX(GAM - LAMDA, ZERO) - GHCL = MAX(BET - KAPA, ZERO) - - RETURN - -! *** END OF SUBROUTINE CALCG1A ***************************************** - - END SUBROUTINE CALCG1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH6 -! *** CASE H6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH6 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = W(2) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCH6A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCH6A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCH6A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCH6A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCH6') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCH6A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH6 ****************************************** - - END SUBROUTINE CALCH6 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCH6A -! *** CASE H6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCH6A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MAX(PSI5, TINY) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = BB*BB-4.d0*CC - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(PSI4,CHI4) - ELSE - PSI4 = TINY - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCH6A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCH6A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH5 -! *** CASE H5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH5 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) <= TINY .AND. W(5) <= TINY) THEN - SCASE = 'H5' - CALL CALCH1A - SCASE = 'H5' - RETURN - ENDIF - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = W(2) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCH5A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCH5A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCH5A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCH5A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCH5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCH5A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH5 ****************************************** - - END SUBROUTINE CALCH5 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCH5A -! *** CASE H5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NONE - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCH5A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MAX(PSI5, TINY) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = BB*BB-4.d0*CC - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(PSI4,CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! NA2SO4 DISSOLUTION - AA = PSI7+PSI8 - BB = AA*AA - CC =-A1/4.D0 - CALL POLY3 (AA, BB, CC, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO - MOLAL (7) = PSI5 + PSI8 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCH5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCH5A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH4 -! *** CASE H4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH4 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) <= TINY .AND. W(5) <= TINY) THEN - SCASE = 'H4' - CALL CALCH1A - SCASE = 'H4' - RETURN - ENDIF - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = W(2) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCH4A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCH4A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCH4A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCH4A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCH4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCH4A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH4 ****************************************** - - END SUBROUTINE CALCH4 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCH4A -! *** CASE H4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCH4A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MAX(PSI5, TINY) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = BB*BB-4.d0*CC - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(PSI4,CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! NA2SO4 DISSOLUTION - AA = PSI7+PSI8 - BB = AA*AA - CC =-A1/4.D0 - CALL POLY3 (AA, BB, CC, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO - MOLAL (7) = PSI5 + PSI8 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCH4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCH4A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH3 -! *** CASE H3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH3 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) <= TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE - SCASE = 'H3' - CALL CALCH1A - SCASE = 'H3' - RETURN - ENDIF - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = W(2) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCH3A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCH3A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCH3A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCH3A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCH3') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCH3A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH3 ****************************************** - - END SUBROUTINE CALCH3 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCH3A -! *** CASE H3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCH3A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MAX(PSI5, TINY) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = BB*BB-4.d0*CC - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(PSI4,CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 - PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! NA2SO4 DISSOLUTION - AA = PSI7+PSI8 - BB = AA*AA - CC =-A1/4.D0 - CALL POLY3 (AA, BB, CC, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO - MOLAL (7) = PSI5 + PSI8 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCH3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCH3A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH2 -! *** CASE H2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : NH4Cl, NA2SO4, NANO3, NACL - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A) -! 2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION) - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES H1A, H2B -! RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCH1A, CALCH3 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) > TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'H2 ; SUBCASE 1' - CALL CALCH2A - SCASE = 'H2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'H2 ; SUBCASE 1' - CALL CALCH1A - SCASE = 'H2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY .AND. RH < DRMH2) THEN ! DRY AEROSOL - SCASE = 'H2 ; SUBCASE 2' - - ELSEIF (WATER <= TINY .AND. RH >= DRMH2) THEN ! MDRH OF H2 - SCASE = 'H2 ; SUBCASE 3' - CALL CALCMDRH (RH, DRMH2, DRNANO3, CALCH1A, CALCH3) - SCASE = 'H2 ; SUBCASE 3' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH2 ****************************************** - - END SUBROUTINE CALCH2 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH2A -! *** CASE H2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH2A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI1 = W(2) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCH2A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCH2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCH2A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCH2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCH2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCH2A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH2A ****************************************** - - END SUBROUTINE CALCH2A - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCH2A -! *** CASE H2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCH2A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0 - A64 = A64*(R*TEMP*WATER)**2.0 - A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MAX(PSI5, TINY) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = BB*BB-4.d0*CC - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(PSI4,CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 - PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8 - PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) ) - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! NA2SO4 DISSOLUTION - AA = PSI7+PSI8 - BB = AA*AA - CC =-A1/4.D0 - CALL POLY3 (AA, BB, CC, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCH2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE - - RETURN - -! *** END OF FUNCTION FUNCH2A ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH1 -! *** CASE H1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCH1A, CALCH2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMH1) THEN - SCASE = 'H1 ; SUBCASE 1' - CALL CALCH1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'H1 ; SUBCASE 1' - ELSE - SCASE = 'H1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH (RH, DRMH1, DRNH4NO3, CALCH1A, CALCH2A) - SCASE = 'H1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCH1 ****************************************** - - END SUBROUTINE CALCH1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCH1A -! *** CASE H1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCH1A - INCLUDE 'isrpia.inc' - real :: LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, & - NO3FR - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CNA2SO4 = W(2) - CNH42S4 = ZERO - NAFR = MAX (W(1)-2*CNA2SO4, ZERO) - CNANO3 = MIN (NAFR, W(4)) - NO3FR = MAX (W(4)-CNANO3, ZERO) - CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5)) - CLFR = MAX (W(5)-CNACL, ZERO) - -! *** CALCULATE VOLATILE SPECIES ************************************** - - ALF = W(3) ! FREE NH3 - BET = CLFR ! FREE CL - GAM = NO3FR ! FREE NO3 - - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - - THETA1 = GAM - BET*(A2/A1) - THETA2 = A2/A1 - -! QUADRATIC EQUATION SOLUTION - - BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) - CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) - DD = BB*BB - 4.0D0*CC - IF (DD < ZERO) GOTO 100 ! Solve each reaction seperately - -! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID - - SQDD = SQRT(DD) - KAPA1 = 0.5D0*(-BB+SQDD) - KAPA2 = 0.5D0*(-BB-SQDD) - LAMDA1 = THETA1 + THETA2*KAPA1 - LAMDA2 = THETA1 + THETA2*KAPA2 - - IF (KAPA1 >= ZERO .AND. LAMDA1 >= ZERO) THEN - IF (ALF-KAPA1-LAMDA1 >= ZERO .AND. & - BET-KAPA1 >= ZERO .AND. GAM-LAMDA1 >= ZERO) THEN - KAPA = KAPA1 - LAMDA= LAMDA1 - GOTO 200 - ENDIF - ENDIF - - IF (KAPA2 >= ZERO .AND. LAMDA2 >= ZERO) THEN - IF (ALF-KAPA2-LAMDA2 >= ZERO .AND. & - BET-KAPA2 >= ZERO .AND. GAM-LAMDA2 >= ZERO) THEN - KAPA = KAPA2 - LAMDA= LAMDA2 - GOTO 200 - ENDIF - ENDIF - -! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA - - 100 KAPA = ZERO - LAMDA = ZERO - DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) - DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) - -! NH4CL EQUILIBRIUM - - IF (DD1 >= ZERO) THEN - SQDD1 = SQRT(DD1) - KAPA1 = 0.5D0*(ALF+BET + SQDD1) - KAPA2 = 0.5D0*(ALF+BET - SQDD1) - - IF (KAPA1 >= ZERO .AND. KAPA1 <= MIN(ALF,BET)) THEN - KAPA = KAPA1 - ELSE IF (KAPA2 >= ZERO .AND. KAPA2 <= MIN(ALF,BET)) THEN - KAPA = KAPA2 - ELSE - KAPA = ZERO - ENDIF - ENDIF - -! NH4NO3 EQUILIBRIUM - - IF (DD2 >= ZERO) THEN - SQDD2 = SQRT(DD2) - LAMDA1= 0.5D0*(ALF+GAM + SQDD2) - LAMDA2= 0.5D0*(ALF+GAM - SQDD2) - - IF (LAMDA1 >= ZERO .AND. LAMDA1 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA1 - ELSE IF (LAMDA2 >= ZERO .AND. LAMDA2 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA2 - ELSE - LAMDA = ZERO - ENDIF - ENDIF - -! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION - - IF (KAPA > ZERO .AND. LAMDA > ZERO) THEN - IF (BET < LAMDA/THETA1) THEN - KAPA = ZERO - ELSE - LAMDA= ZERO - ENDIF - ENDIF - -! *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** - - 200 CONTINUE - CNH4NO3 = LAMDA - CNH4CL = KAPA - - GNH3 = ALF - KAPA - LAMDA - GHNO3 = GAM - LAMDA - GHCL = BET - KAPA - - RETURN - -! *** END OF SUBROUTINE CALCH1A ***************************************** - - END SUBROUTINE CALCH1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI6 -! *** CASE I6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI6 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCI1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = CNA2SO4 - PSI5 = CNH42S4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 - CC =-A6*(PSI2 + PSI3 + PSI1) - DD = BB*BB - 4.D0*CC - PSI6 = 0.5D0*(-BB + SQRT(DD)) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = PSI6 ! HI - MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I - MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = CHI4 - PSI4 - CNH42S4 = ZERO - CNH4HS4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - - 20 RETURN - -! *** END OF SUBROUTINE CALCI6 ***************************************** - - END SUBROUTINE CALCI6 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI5 -! *** CASE I5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI5 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCI1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - -! *** IF NA2SO4(S) =0, CALL FUNCI5B FOR Y4=0 *************************** - - IF (CHI4 <= TINY) THEN - Y1 = FUNCI5A (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI4HI - Y1 = FUNCI5A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCI5A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCI5A (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCI5') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCI5A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCI5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCI5A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCI5 ***************************************** - - END SUBROUTINE CALCI5 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCI5A -! *** CASE I5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCI5A (P4) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 ! PSI3 already assigned in FUNCI5A - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5 *(WATER/GAMA(2))**3.0 - A5 = XK7 *(WATER/GAMA(4))**3.0 - A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 - CC =-A6*(PSI2 + PSI3 + PSI1) - DD = BB*BB - 4.D0*CC - PSI6 = 0.5D0*(-BB + SQRT(DD)) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = PSI6 ! HI - MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I - MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = CHI4 - PSI4 - CNH42S4 = ZERO - CNH4HS4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCI5A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCI5A ******************************************** - - END -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI4 -! *** CASE I4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI4 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCI1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - -! *** IF NA2SO4(S) =0, CALL FUNCI4B FOR Y4=0 *************************** - - IF (CHI4 <= TINY) THEN - Y1 = FUNCI4A (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI4HI - Y1 = FUNCI4A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCI4A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCI4A (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCI4') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCI4A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCI4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCI4A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCI4 ***************************************** - - END SUBROUTINE CALCI4 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCI4A -! *** CASE I4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCI4A (P4) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 ! PSI3 already assigned in FUNCI4A - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5 *(WATER/GAMA(2))**3.0 - A5 = XK7 *(WATER/GAMA(4))**3.0 - A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - A7 = SQRT(A4/A5) - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 - CC =-A6*(PSI2 + PSI3 + PSI1) - DD = BB*BB - 4.D0*CC - PSI6 = 0.5D0*(-BB + SQRT(DD)) - - PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = PSI6 ! HI - MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I - MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = CHI4 - PSI4 - CNH42S4 = CHI5 - PSI5 - CNH4HS4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCI4A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCI4A ******************************************** - - END -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI3 -! *** CASE I3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A) -! 2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B -! RESPECTIVELY - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCI1A, CALCI4 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** - - IF (CNH4HS4 > TINY .OR. CNAHSO4 > TINY) THEN - SCASE = 'I3 ; SUBCASE 1' - CALL CALCI3A ! FULL SOLUTION - SCASE = 'I3 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMI3) THEN ! SOLID SOLUTION - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCI1A - SCASE = 'I3 ; SUBCASE 2' - - ELSEIF (RH >= DRMI3) THEN ! MDRH OF I3 - SCASE = 'I3 ; SUBCASE 3' - CALL CALCMDRH (RH, DRMI3, DRLC, CALCI1A, CALCI4) - SCASE = 'I3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCI3 ****************************************** - - END SUBROUTINE CALCI3 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI3A -! *** CASE I3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI3A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A ! Needed when called from CALCMDRH - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCI1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI2LO = ZERO ! Low limit - PSI2HI = CHI2 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI2HI - Y1 = FUNCI3A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* - - IF (YHI < EPS) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI2LO) - Y2 = FUNCI3A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - IF (Y2 > EPS) Y2 = FUNCI3A (ZERO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCI3A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCI3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCI3A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCI3A ***************************************** - - END SUBROUTINE CALCI3A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCI3A -! *** CASE I3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCI3A (P2) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI2 = P2 ! Save PSI2 in COMMON BLOCK - PSI4LO = ZERO ! Low limit for PSI4 - PSI4HI = CHI4 ! High limit for PSI4 - -! *** IF NH3 =0, CALL FUNCI3B FOR Y4=0 ******************************** - - IF (CHI4 <= TINY) THEN - FUNCI3A = FUNCI3B (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI4HI - Y1 = FUNCI3B (X1) - IF (ABS(Y1) <= EPS) GOTO 50 - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ***** - - IF (YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI4LO) - Y2 = FUNCI3B (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 - - IF (Y2 > EPS) Y2 = FUNCI3B (PSI4LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCI3B (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0004, 'FUNCI3A') ! WARNING ERROR: NO CONVERGENCE - -! *** INNER LOOP CONVERGED ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCI3B (X3) - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 50 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCI3A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE - RETURN - -! *** END OF FUNCTION FUNCI3A ******************************************* - - END - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION FUNCI3B -! *** CASE I3 ; SUBCASE 2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ - -!======================================================================= - - real FUNCTION FUNCI3B (P4) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5*(WATER/GAMA(2))**3.0 - A5 = XK7*(WATER/GAMA(4))**3.0 - A6 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - A7 = SQRT(A4/A5) - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 - CC =-A6*(PSI2 + PSI3 + PSI1) - DD = BB*BB - 4.D0*CC - PSI6 = 0.5D0*(-BB + SQRT(DD)) - - PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = PSI6 ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 - PSI6, TINY) ! HSO4I - CLC = MAX(CHI2 - PSI2, ZERO) - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCI3B= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCI3B ******************************************** - - END -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI2 -! *** CASE I2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI2A) -! 2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B -! RESPECTIVELY - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCI1A, CALCI3A - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** - - IF (CNH4HS4 > TINY) THEN - SCASE = 'I2 ; SUBCASE 1' - CALL CALCI2A - SCASE = 'I2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMI2) THEN ! SOLID SOLUTION ONLY - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCI1A - SCASE = 'I2 ; SUBCASE 2' - - ELSEIF (RH >= DRMI2) THEN ! MDRH OF I2 - SCASE = 'I2 ; SUBCASE 3' - CALL CALCMDRH (RH, DRMI2, DRNAHSO4, CALCI1A, CALCI3A) - SCASE = 'I2 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCI2 ****************************************** - - END SUBROUTINE CALCI2 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI2A -! *** CASE I2 ; SUBCASE A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI2A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCI1A ! Needed when called from CALCMDRH - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCI1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI5 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI2LO = ZERO ! Low limit - PSI2HI = CHI2 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI2HI - Y1 = FUNCI2A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* - - IF (YHI < EPS) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI2LO) - Y2 = FUNCI2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - IF (Y2 > EPS) Y2 = FUNCI2A (ZERO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCI2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCI2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCI2A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCI2A ***************************************** - - END SUBROUTINE CALCI2A - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCI2A -! *** CASE I2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCI2A (P2) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - PSI2 = P2 ! Save PSI2 in COMMON BLOCK - PSI3 = CHI3 - PSI4 = CHI4 - PSI5 = CHI5 - PSI6 = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A3 = XK11*(WATER/GAMA(12))**2.0 - A4 = XK5 *(WATER/GAMA(2))**3.0 - A5 = XK7 *(WATER/GAMA(4))**3.0 - A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - A7 = SQRT(A4/A5) - - ! CALCULATE DISSOCIATION QUANTITIES - - IF (CHI5 > TINY .AND. WATER > TINY) THEN - PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 - PSI5 = MAX(MIN (PSI5, CHI5), TINY) - ENDIF - - IF (CHI4 > TINY .AND. WATER > TINY) THEN - AA = PSI2+PSI5+PSI6+PSI3 - BB = PSI3*AA - CC = 0.25D0*(PSI3*PSI3*(PSI2+PSI5+PSI6)-A4) - CALL POLY3 (AA, BB, CC, PSI4, ISLV) - IF (ISLV == 0) THEN - PSI4 = MIN (PSI4, CHI4) - ELSE - PSI4 = ZERO - ENDIF - ENDIF - - IF (CHI3 > TINY .AND. WATER > TINY) THEN - AA = 2.D0*PSI4 + PSI2 + PSI1 - PSI6 - BB = 2.D0*PSI4*(PSI2 + PSI1 - PSI6) - A3 - CC = ZERO - CALL POLY3 (AA, BB, CC, PSI3, ISLV) - IF (ISLV == 0) THEN - PSI3 = MIN (PSI3, CHI3) - ELSE - PSI3 = ZERO - ENDIF - ENDIF - - BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 - CC =-A6*(PSI2 + PSI3 + PSI1) - DD = BB*BB - 4.D0*CC - PSI6 = 0.5D0*(-BB + SQRT(DD)) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = PSI6 ! HI - MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I - MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I - CLC = CHI2 - PSI2 - CNAHSO4 = CHI3 - PSI3 - CNA2SO4 = CHI4 - PSI4 - CNH42S4 = CHI5 - PSI5 - CNH4HS4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCI2A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE - RETURN - -! *** END OF FUNCTION FUNCI2A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI1 -! *** CASE I1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCI1A, CALCI2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMI1) THEN - SCASE = 'I1 ; SUBCASE 1' - CALL CALCI1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'I1 ; SUBCASE 1' - ELSE - SCASE = 'I1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH (RH, DRMI1, DRNH4HS4, CALCI1A, CALCI2A) - SCASE = 'I1 ; SUBCASE 2' - ENDIF - -! *** AMMONIA IN GAS PHASE ********************************************** - -! CALL CALCNH3 - - RETURN - -! *** END OF SUBROUTINE CALCI1 ****************************************** - - END SUBROUTINE CALCI1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCI1A -! *** CASE I1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCI1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CNA2SO4 = 0.5D0*W(1) - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CNH42S4 = ZERO - FRSO4 = MAX(W(2)-CNA2SO4, ZERO) - - CLC = MIN(W(3)/3.D0, FRSO4/2.D0) - FRSO4 = MAX(FRSO4-2.D0*CLC, ZERO) - FRNH4 = MAX(W(3)-3.D0*CLC, ZERO) - - IF (FRSO4 <= TINY) THEN - CLC = MAX(CLC - FRNH4, ZERO) - CNH42S4 = 2.D0*FRNH4 - - ELSEIF (FRNH4 <= TINY) THEN - CNH4HS4 = 3.D0*MIN(FRSO4, CLC) - CLC = MAX(CLC-FRSO4, ZERO) - IF (CNA2SO4 > TINY) THEN - FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - CNAHSO4 = 2.D0*FRSO4 - CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) - ENDIF - ENDIF - -! *** CALCULATE GAS SPECIES ********************************************* - - GHNO3 = W(4) - GHCL = W(5) - GNH3 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCI1A ***************************************** - - END SUBROUTINE CALCI1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCJ3 -! *** CASE J3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS ONLY A LIQUID PHASE - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCJ3 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 - CHI1 = W(1) ! NA TOTAL as NaHSO4 - CHI2 = W(3) ! NH4 TOTAL as NH4HSO4 - PSI1 = CHI1 - PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = A3+LAMDA ! KAPA - CC =-A3*(LAMDA + PSI1 + PSI2) - DD = BB*BB-4.D0*CC - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = LAMDA + KAPA ! HI - MOLAL (2) = PSI1 ! NAI - MOLAL (3) = PSI2 ! NH4I - MOLAL (4) = ZERO ! CLI - MOLAL (5) = KAPA ! SO4I - MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I - MOLAL (7) = ZERO ! NO3I - - CNAHSO4 = ZERO - CNH4HS4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 50 - ENDIF - 10 END DO - - 50 RETURN - -! *** END OF SUBROUTINE CALCJ3 ****************************************** - - END SUBROUTINE CALCJ3 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCJ2 -! *** CASE J2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NAHSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCJ2 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, & - A1, A2, A3 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - CHI1 = W(1) ! NA TOTAL - CHI2 = W(3) ! NH4 TOTAL - PSI1LO = TINY ! Low limit - PSI1HI = CHI1 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI1HI - Y1 = FUNCJ2 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 **** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCJ2 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCJ2 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCJ2') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCJ2 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCJ2') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCJ2 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCJ2 ****************************************** - - END SUBROUTINE CALCJ2 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCJ2 -! *** CASE J2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCJ2 (P1) - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, & - A1, A2, A3 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 - PSI1 = P1 - PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK11 *(WATER/GAMA(12))**2.0 - A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = A3+LAMDA ! KAPA - CC =-A3*(LAMDA + PSI1 + PSI2) - DD = BB*BB-4.D0*CC - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (1) = LAMDA + KAPA ! HI - MOLAL (2) = PSI1 ! NAI - MOLAL (3) = PSI2 ! NH4I - MOLAL (4) = ZERO ! CLI - MOLAL (5) = KAPA ! SO4I - MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I - MOLAL (7) = ZERO ! NO3I - - CNAHSO4 = MAX(CHI1-PSI1,ZERO) - CNH4HS4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCJ2 = MOLAL(2)*MOLAL(6)/A1 - ONE - -! *** END OF FUNCTION FUNCJ2 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCJ1 -! *** CASE J1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCJ1 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, & - A1, A2, A3 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - CHI1 = W(1) ! Total NA initially as NaHSO4 - CHI2 = W(3) ! Total NH4 initially as NH4HSO4 - - PSI1LO = TINY ! Low limit - PSI1HI = CHI1 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI1HI - Y1 = FUNCJ1 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 **** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCJ1 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCJ1 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCJ1') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCJ1 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCJ1') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCJ1 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCJ1 ****************************************** - - END SUBROUTINE CALCJ1 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCJ1 -! *** CASE J1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION FUNCJ1 (P1) - INCLUDE 'isrpia.inc' - real :: LAMDA, KAPA - COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, & - A1, A2, A3 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 - PSI1 = P1 - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK11 *(WATER/GAMA(12))**2.0 - A2 = XK12 *(WATER/GAMA(09))**2.0 - A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - PSI2 = 0.5*(-(LAMDA+PSI1) + SQRT((LAMDA+PSI1)**2.D0+4.D0*A2)) ! PSI2 - PSI2 = MIN (PSI2, CHI2) - - BB = A3+LAMDA ! KAPA - CC =-A3*(LAMDA + PSI2 + PSI1) - DD = BB*BB-4.D0*CC - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = LAMDA + KAPA ! HI - MOLAL (2) = PSI1 ! NAI - MOLAL (3) = PSI2 ! NH4I - MOLAL (4) = ZERO - MOLAL (5) = KAPA ! SO4I - MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I - MOLAL (7) = ZERO - - CNAHSO4 = MAX(CHI1-PSI1,ZERO) - CNH4HS4 = MAX(CHI2-PSI2,ZERO) - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCJ1 = MOLAL(2)*MOLAL(6)/A1 - ONE - -! *** END OF FUNCTION FUNCJ1 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO7 -! *** CASE O7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO7 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - PSI1 = CHI1 - PSI2 = CHI2 - PSI3 = ZERO - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCO7 (X1) - IF (CHI6 <= TINY) GOTO 50 -! c IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! c IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO7 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCO7 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO7 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO7') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCO7 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN ! If quadrat.called - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO7 ******************************************* - - END SUBROUTINE CALCO7 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCO7 -! *** CASE O7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO7 (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = 2.0D0*PSI1 ! Na+ - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg - - ! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI9 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCO7 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCO7 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO6 -! *** CASE O6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO6 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - - PSI1 = CHI1 - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCO6 (X1) - IF (CHI6 <= TINY) GOTO 50 -! c IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! c IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO6 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCO6 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO6 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO6') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCO6 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN ! If quadrat.called - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO6 ******************************************* - - END SUBROUTINE CALCO6 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCO6 -! *** CASE O6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 , K2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO6 (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK17 *(WATER/GAMA(17))**3.0 - - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! PSI7 - CALL POLY3 (PSI1+PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV == 0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF - - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = 2.0D0*PSI1 ! Na+ - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg - - - ! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCO6 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCO6 ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO5 -! *** CASE O5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO5 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - PSI1 = ZERO - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCO5 (X1) - IF (CHI6 <= TINY) GOTO 50 -! c IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! c IF (WATER .LE. TINY) RETURN ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO5 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCO5 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO5 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCO5 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN ! If quadrat.called - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO5 ******************************************* - - END SUBROUTINE CALCO5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCO5 -! *** CASE O5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO5 (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK17 *(WATER/GAMA(17))**3.0 - - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! PSI7 - CALL POLY3 ((PSI2+PSI8)/(SQRT(A1/A7)+1.0), ZERO, & - -A7/4.D0/(SQRT(A1/A7)+1.0), PSI7, ISLV) - IF (ISLV == 0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF - - IF (CHI1 >= TINY) THEN ! PSI1 - PSI1 = SQRT(A1/A7)*PSI7 - PSI1 = MIN(PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = 2.0D0*PSI1 ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CaI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! Mg - - - ! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNA2SO4 = MAX(CHI1 - PSI1, TINY) - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCO5 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCO5 ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO4 -! *** CASE O4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NA2SO4, K2SO4, MGSO4, CASO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO4 - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - PSI2 = CHI2 - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - - WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21) - WATER = MAX (WATER , TINY) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCO4 (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! C IF (WATER .LE. TINY) GOTO 50 ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO4 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCO4 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO4 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCO4 (X3) - -! *** FINAL CALCULATIONS ********************************************** - - 50 CONTINUE - -! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT - MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion - -! *** HSO4 equilibrium - - - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT - MOLAL(6) = DELTA ! HSO4 AFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO4 ****************************************** - - END SUBROUTINE CALCO4 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCO4 -! *** CASE O4 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO4 (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI2 = CHI2 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK17 *(WATER/GAMA(17))**3.0 - ! A8 = XK23 *(WATER/GAMA(21))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - IF (CHI5 >= TINY) THEN - PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) - PSI5 = MIN (PSI5,CHI5) - ELSE - PSI5 = TINY - ENDIF - - ! C IF(CHI4.GT.TINY) THEN - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MAX (MIN (PSI4,CHI4), ZERO) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV == 0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - MOLAL (2) = ZERO ! NAI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI - - - ! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, TINY) - CMGSO4 = ZERO - CCASO4 = CHI9 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCO4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! C FUNCO4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCO4 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO3 -! *** CASE O3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO4 - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (W(4) > TINY .AND. W(5) > TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE - SCASE = 'O3 ; SUBCASE 1' - CALL CALCO3A - SCASE = 'O3 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A - SCASE = 'O1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMO3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCO1A - SCASE = 'O3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'O3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO3, DRNH42S4, CALCO1A, CALCO4) - SCASE = 'O3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO3 ****************************************** - - END SUBROUTINE CALCO3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO3A -! *** CASE O3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MGSO4, CASO4 -! 4. Completely dissolved: NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO3A - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY - - WATER = TINY - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCO3A (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI7.LE.TINY) GOTO 50 -! C IF (WATER .LE. TINY) GOTO 50 ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO3A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCO3A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO3A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCO3A (X3) - -! *** FINAL CALCULATIONS ************************************************* - - 50 CONTINUE - -! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (max (PSI1, zero), CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT - MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion - -! *** HSO4 equilibrium - - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT - MOLAL(6) = DELTA ! HSO4 AFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO3A ****************************************** - - END SUBROUTINE CALCO3A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCO3A -! *** CASE O3; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MgSO4, CaSO4 -! 4. Completely dissolved: NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO3A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI2 = CHI2 - PSI8 = CHI8 - PSI3 = ZERO - PSI6 = X - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0D0 - A2 = XK7 *(WATER/GAMA(4))**3.0D0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0 - A7 = XK17 *(WATER/GAMA(17))**3.0D0 - ! A8 = XK23 *(WATER/GAMA(21))**2.0D0 - A65 = A6/A5 - - ! CALCULATE DISSOCIATION QUANTITIES - - DENO = MAX(CHI6-PSI6-PSI3, ZERO) - PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6) - PSI5 = MIN(MAX(PSI5,ZERO),CHI5) - - ! C IF(CHI4.GT.TINY) THEN ! PSI4 - IF(W(2) > TINY) THEN ! Accounts for NH3 evaporation - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 - DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 - PSI4 =0.5d0*(-BB - SQRT(DD)) - ELSE - PSI4 = TINY - ENDIF - PSI4 = MIN (MAX (PSI4,ZERO), CHI4) - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV == 0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF - - IF (CHI2 > TINY .AND. WATER > TINY) THEN - CALL POLY3 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ & - PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) & - /4.D0,PSI20, ISLV) - IF (ISLV == 0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2) - ENDIF - ! PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4) - ! PSI2 = MIN (MAX(PSI2, ZERO), CHI2) - ! ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = ZERO ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CNH42S4 = MAX(CHI2 - PSI2, ZERO) - CNH4NO3 = ZERO - CNH4Cl = ZERO - CK2SO4 = MAX(CHI7 - PSI7, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI9 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 20 FUNCO3A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - - RETURN - -! *** END OF FUNCTION FUNCO3A ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO2 -! *** CASE O2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO3A, CALCO4 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) > TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'O2 ; SUBCASE 1' - CALL CALCO2A - SCASE = 'O2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A - SCASE = 'O1 ; SUBCASE 1' - ENDIF - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (WATER <= TINY) THEN - IF (RH < DRMO2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCO1A - SCASE = 'O2 ; SUBCASE 2' - ELSE - IF (W(5) > TINY) THEN - SCASE = 'O2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO2, DRNH4CL, CALCO1A, CALCO3A) - SCASE = 'O2 ; SUBCASE 3' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMO3) THEN - SCASE = 'O2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4) - CALL CALCMDRH2 (RH, DRMO3, DRNH42S4, CALCO1A, CALCO4) - SCASE = 'O2 ; SUBCASE 4' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO - 20 END DO - CALL CALCO1A - SCASE = 'O2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO2 ****************************************** - - END SUBROUTINE CALCO2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO2A -! *** CASE O2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4 -! 4. Completely dissolved: NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO2A - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************* - - CALAOU = .TRUE. - CHI9 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX (W(2)-CHI9, ZERO) - CAFR = MAX (W(6)-CHI9, ZERO) - CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI7, ZERO) - SO4FR = MAX (SO4FR - CHI7, ZERO) - CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4 - NAFR = MAX (W(1) - 2.D0*CHI1, ZERO) - SO4FR = MAX (SO4FR - CHI1, ZERO) - CHI8 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CHI8, ZERO) - SO4FR = MAX(SO4FR - CHI8, ZERO) - CHI3 = ZERO - CHI5 = W(4) - CHI6 = W(5) - CHI2 = MAX (SO4FR, ZERO) - CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) - - PSI8 = CHI8 - PSI6LO = TINY - PSI6HI = CHI6-TINY - - WATER = TINY - -! *** INITIAL VALUES FOR BISECTION ************************************* - - X1 = PSI6LO - Y1 = FUNCO2A (X1) - IF (CHI6 <= TINY) GOTO 50 -! C IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 -! C IF (WATER .LE. TINY) GOTO 50 ! No water - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCO2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) WATER = TINY - GOTO 50 - -! *** PERFORM BISECTION ************************************************ - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCO2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCO2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN *********************************************** - - 40 X3 = 0.5*(X1+X2) - IF (X3 <= TINY2) THEN ! PRACTICALLY NO NITRATES, SO DRY SOLUTION - WATER = TINY - ELSE - Y3 = FUNCO2A (X3) - ENDIF - -! *** FINAL CALCULATIONS ************************************************* - - 50 CONTINUE - -! *** Na2SO4 DISSOLUTION - - IF (CHI1 > TINY .AND. WATER > TINY) THEN ! PSI1 - CALL POLY3 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1, CHI1) - ELSE - PSI1 = ZERO - ENDIF - ELSE - PSI1 = ZERO - ENDIF - MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT - MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion - -! *** HSO4 equilibrium - - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT - MOLAL(6) = DELTA ! HSO4 AFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO2A ****************************************** - - END SUBROUTINE CALCO2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCO2A -! *** CASE O2; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4 -! 4. Completely dissolved: NH4NO3 -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCO2A (X) - INCLUDE 'isrpia.inc' - - real :: LAMDA - COMMON /CASEO/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, & - PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, & - A5, A6, A7, A8, A9 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI2 = CHI2 - PSI3 = ZERO - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0D0 - A2 = XK7 *(WATER/GAMA(4))**3.0D0 - A3 = XK6 /(R*TEMP*R*TEMP) - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0 - A65 = A6/A5 - A7 = XK17 *(WATER/GAMA(17))**3.0D0 - ! A8 = XK23 *(WATER/GAMA(21))**2.0D0 - - DENO = MAX(CHI6-PSI6-PSI3, ZERO) - PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6) - PSI5 = MIN(PSI5,CHI5) - - PSI4 = MIN(PSI5+PSI6,CHI4) - - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! PSI7 - CALL POLY3 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV) - IF (ISLV == 0) THEN - PSI7 = MAX (MIN (PSI7, CHI7), ZERO) - ELSE - PSI7 = ZERO - ENDIF - ELSE - PSI7 = ZERO - ENDIF - - IF (CHI2 > TINY .AND. WATER > TINY) THEN - CALL POLY3 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ & - PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) & - /4.D0,PSI20, ISLV) - IF (ISLV == 0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2) - ENDIF - ! PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4) - ! PSI2 = MIN (PSI2, CHI2) - ! ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (2) = ZERO ! NaI - MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I - MOLAL (4) = PSI6 ! CLI - MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I - MOLAL (6) = ZERO ! HSO4 - MOLAL (7) = PSI5 ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = 2.0D0*PSI7 ! KI - MOLAL (10)= PSI8 ! MGI - - ! C MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - -MOLAL(9)-2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CNH42S4 = MAX(CHI2 - PSI2, ZERO) - CNH4NO3 = ZERO - CK2SO4 = MAX(CHI7 - PSI7, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI9 - - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************* - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ************************** - - -! 0 IF (CHI4.LE.TINY) THEN -! FUNCO2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE -! ELSE - 20 FUNCO2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE -! ENDIF - - RETURN - -! *** END OF FUNCTION FUNCO2A **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO1 -! *** CASE O1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCO1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCO1A, CALCO2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMO1) THEN - SCASE = 'O1 ; SUBCASE 1' - CALL CALCO1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'O1 ; SUBCASE 1' - ELSE - SCASE = 'O1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMO1, DRNH4NO3, CALCO1A, CALCO2A) - SCASE = 'O1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCO1 ****************************************** - - END SUBROUTINE CALCO1 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCO1A -! *** CASE O1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3 -! IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF -! NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN -! THE SOLID PHASE. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCO1A - INCLUDE 'isrpia.inc' - real :: LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2 - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*W(1), SO4FR) ! CNA2SO4 - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX(SO4FR - CNA2SO4, ZERO) - CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - - CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4 - -! *** CALCULATE VOLATILE SPECIES ************************************** - - ALF = W(3) - 2.0D0*CNH42S4 - BET = W(5) - GAM = W(4) - - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - print *, A2 - - THETA1 = GAM - BET*(A2/A1) - THETA2 = A2/A1 - -! QUADRATIC EQUATION SOLUTION - - BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) - CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) - DD = BB*BB - 4.0D0*CC - IF (DD < ZERO) GOTO 100 ! Solve each reaction seperately - -! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID - - SQDD = SQRT(DD) - KAPA1 = 0.5D0*(-BB+SQDD) - KAPA2 = 0.5D0*(-BB-SQDD) - LAMDA1 = THETA1 + THETA2*KAPA1 - LAMDA2 = THETA1 + THETA2*KAPA2 - - IF (KAPA1 >= ZERO .AND. LAMDA1 >= ZERO) THEN - IF (ALF-KAPA1-LAMDA1 >= ZERO .AND. & - BET-KAPA1 >= ZERO .AND. GAM-LAMDA1 >= ZERO) THEN - KAPA = KAPA1 - LAMDA= LAMDA1 - GOTO 200 - ENDIF - ENDIF - - IF (KAPA2 >= ZERO .AND. LAMDA2 >= ZERO) THEN - IF (ALF-KAPA2-LAMDA2 >= ZERO .AND. & - BET-KAPA2 >= ZERO .AND. GAM-LAMDA2 >= ZERO) THEN - KAPA = KAPA2 - LAMDA= LAMDA2 - GOTO 200 - ENDIF - ENDIF - -! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA - - 100 KAPA = ZERO - LAMDA = ZERO - DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) - DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) - -! NH4CL EQUILIBRIUM - - IF (DD1 >= ZERO) THEN - SQDD1 = SQRT(DD1) - KAPA1 = 0.5D0*(ALF+BET + SQDD1) - KAPA2 = 0.5D0*(ALF+BET - SQDD1) - - IF (KAPA1 >= ZERO .AND. KAPA1 <= MIN(ALF,BET)) THEN - KAPA = KAPA1 - ELSE IF (KAPA2 >= ZERO .AND. KAPA2 <= MIN(ALF,BET)) THEN - KAPA = KAPA2 - ELSE - KAPA = ZERO - ENDIF - ENDIF - -! NH4NO3 EQUILIBRIUM - - IF (DD2 >= ZERO) THEN - SQDD2 = SQRT(DD2) - LAMDA1= 0.5D0*(ALF+GAM + SQDD2) - LAMDA2= 0.5D0*(ALF+GAM - SQDD2) - - IF (LAMDA1 >= ZERO .AND. LAMDA1 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA1 - ELSE IF (LAMDA2 >= ZERO .AND. LAMDA2 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA2 - ELSE - LAMDA = ZERO - ENDIF - ENDIF - -! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION - - IF (KAPA > ZERO .AND. LAMDA > ZERO) THEN - IF (BET < LAMDA/THETA1) THEN - KAPA = ZERO - ELSE - LAMDA= ZERO - ENDIF - ENDIF - -! *** CALCULATE COMPOSITION OF VOLATILE SPECIES ************************ - - 200 CONTINUE - CNH4NO3 = LAMDA - CNH4CL = KAPA - - GNH3 = MAX(ALF - KAPA - LAMDA, ZERO) - GHNO3 = MAX(GAM - LAMDA, ZERO) - GHCL = MAX(BET - KAPA, ZERO) - - RETURN - -! *** END OF SUBROUTINE CALCO1A ***************************************** - - END SUBROUTINE CALCO1A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM8 -! *** CASE M8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM8 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM8 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM8 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM8 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM8 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM8') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM8 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM8 ****************************************** - - END SUBROUTINE CALCM8 - - - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM8 -! *** CASE M8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM8 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = CHI9 - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - ! A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - ! A7 = XK8 *(WATER/GAMA(1))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI11 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM8 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM8 ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM7 -! *** CASE M7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM7 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM7 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM7 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM7 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM7 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM7') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM7 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM7 ****************************************** - - END SUBROUTINE CALCM7 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM7 -! *** CASE M7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM7 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - ! A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - ! A7 = XK8 *(WATER/GAMA(1))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM7 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM7 ******************************************* - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM6 -! *** CASE M6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM6 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM6 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM6 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM6 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM6 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM6') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM6 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM6 ****************************************** - - END SUBROUTINE CALCM6 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM6 -! *** CASE M6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM6 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - ! A7 = XK8 *(WATER/GAMA(1))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.0+RIZ)*(PSI7+PSI8)) & - /(1.0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* & - (PSI7+PSI8)**2.0*(1.0+RIZ))/(1.0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) & - -A1/4.D0)/(1.0+RIZ) - ! AA = PSI7+PSI8+PSI9+PSI10 - ! BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. - ! CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 - - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - ! IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN - ! PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - ! PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ! ELSE - ! PSI9 = ZERO - ! ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (PSI9,CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM6 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM6 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM5 -! *** CASE M5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM5 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM5 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM5 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM5 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM5 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM5 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM5 ****************************************** - - END SUBROUTINE CALCM5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM5 -! *** CASE M5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM5 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - ! A7 = XK8 *(WATER/GAMA(1))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.0+RIZ)*(PSI7+PSI8)) & - /(1.0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* & - (PSI7+PSI8)**2.0*(1.0+RIZ))/(1.0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) & - -A1/4.D0)/(1.0+RIZ) - ! AA = PSI7+PSI8+PSI9+PSI10 - ! BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. - ! CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 - - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - IF (CHI9 >= TINY .AND. WATER > TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF - - ! IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - ! CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - ! IF (ISLV.EQ.0) THEN - ! PSI9 = MIN (PSI9,CHI9) - ! ELSE - ! PSI9 = ZERO - ! ENDIF - ! ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM5 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM5 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM4 -! *** CASE M4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL -! 4. Completely dissolved: NH4NO3, NANO3, NACL - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM4 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) <= TINY .AND. W(5) <= TINY) THEN - SCASE = 'M4 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M4 ; SUBCASE 1' - RETURN - ENDIF - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM4 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM4 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM4 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM4 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM4 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM4 ****************************************** - - END SUBROUTINE CALCM4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM4 -! *** CASE M4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL -! 4. Completely dissolved: NH4NO3, NANO3, NACL - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM4 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A3 = XK6 /(R*TEMP*R*TEMP) - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - ! A7 = XK8 *(WATER/GAMA(1))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.0+RIZ)*(PSI7+PSI8)) & - /(1.0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* & - (PSI7+PSI8)**2.0*(1.0+RIZ))/(1.0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) & - -A1/4.D0)/(1.0+RIZ) - ! AA = PSI7+PSI8+PSI9+PSI10 - ! BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. - ! CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 - - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - IF (CHI9 >= TINY .AND. WATER > TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF - - ! IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - ! CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - ! IF (ISLV.EQ.0) THEN - ! PSI9 = MIN (PSI9,CHI9) - ! ELSE - ! PSI9 = ZERO - ! ENDIF - ! ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM4 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM3 -! *** CASE M3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL -! 4. Completely dissolved: NH4NO3, NANO3 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM3 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - IF (W(4) <= TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE - SCASE = 'M3 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M3 ; SUBCASE 1' - RETURN - ENDIF - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM3 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM3 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM3 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM3 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM3') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM3 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM3 ****************************************** - - END SUBROUTINE CALCM3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM3 -! *** CASE M3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL -! 4. Completely dissolved: NH4NO3, NANO3 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM3 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A3 = XK6 /(R*TEMP*R*TEMP) - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A10 = XK23 *(WATER/GAMA(21))**2.0 - ! A8 = XK9 *(WATER/GAMA(3))**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF - - ! IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - ! VITA = 2.D0*PSI1+PSI8+PSI6 ! AN DE DOULEPSEI KALA VGALE PSI1 APO DW - ! GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7 - ! DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO) - ! PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - ! PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ! ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 - PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - !C - - IF (CHI1 > TINY .AND. WATER > TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.0+RIZ)*(PSI7+PSI8)) & - /(1.0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* & - (PSI7+PSI8)**2.0*(1.0+RIZ))/(1.0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) & - -A1/4.D0)/(1.0+RIZ) - ! AA = PSI7+PSI8+PSI9+PSI10 - ! BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. - ! CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 - - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - IF (CHI9 >= TINY) THEN - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF - - ! IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - ! CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - ! IF (ISLV.EQ.0) THEN - ! PSI9 = MIN (PSI9,CHI9) - ! ELSE - ! PSI9 = ZERO - ! ENDIF - ! ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = ZERO - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCM3 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM3 ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM2 -! *** CASE M2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A) -! 2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION) - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES M1A, M2B -! RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCM1A, CALCM3 - -! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** - - CALL CALCM1A - - IF (CNH4NO3 > TINY) THEN ! NO3 EXISTS, WATER POSSIBLE - SCASE = 'M2 ; SUBCASE 1' - CALL CALCM2A - SCASE = 'M2 ; SUBCASE 1' - ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE - SCASE = 'M2 ; SUBCASE 1' - CALL CALCM1A - SCASE = 'M2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY .AND. RH < DRMM2) THEN ! DRY AEROSOL - SCASE = 'M2 ; SUBCASE 2' - - ELSEIF (WATER <= TINY .AND. RH >= DRMM2) THEN ! MDRH OF M2 - SCASE = 'M2 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRMM2, DRNANO3, CALCM1A, CALCM3) - SCASE = 'M2 ; SUBCASE 3' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM2 ****************************************** - - END SUBROUTINE CALCM2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM2A -! *** CASE M2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -! 4. Completely dissolved: NH4NO3 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM2A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2)-CHI11, ZERO) - CAFR = MAX(W(6)-CHI11, ZERO) - CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7)-2.D0*CHI9, ZERO) - SO4FR = MAX(SO4FR-CHI9, ZERO) - CHI10 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8)-CHI10, ZERO) - SO4FR = MAX(SO4FR-CHI10, ZERO) - CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4 - CHI2 = ZERO ! CNH42S4 - CHI3 = ZERO ! CNH4CL - FRNA = MAX (W(1)-2.D0*CHI1, ZERO) - CHI8 = MIN (FRNA, W(4)) ! CNANO3 - CHI4 = W(3) ! NH3(g) - CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) - CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL - CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCM2A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCM2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCM2A (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCM2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCM2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCM2A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM2A ****************************************** - - END SUBROUTINE CALCM2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCM2A -! *** CASE M2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -! 4. Completely dissolved: NH4NO3 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCM2A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = CHI1 - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK5 *(WATER/GAMA(2))**3.0 - A3 = XK6 /(R*TEMP*R*TEMP) - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0 - A64 = A64*(R*TEMP*WATER)**2.0 - ! A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,TINY),CHI4) - ELSE - PSI4 = TINY - ENDIF - - ! IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION - ! VITA = 2.D0*PSI1+PSI8+PSI6 - ! GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7 - ! DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO) - ! PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - ! PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ! ENDIF - !C - ! IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION - ! BIT = 2.D0*PSI1+PSI7+PSI5 - ! GKAM = PSI5*(2.D0*PSI1+PSI8)-A8 - ! DIA = BIT**2.0 - 4.0D0*GKAM - ! PSI8 = 0.5D0*( -BIT + SQRT(DIA) ) - ! PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ! ENDIF - !C - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 - PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8 - PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) ) - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - IF (CHI1 > TINY .AND. WATER > TINY) THEN !NA2SO4 - RIZ = SQRT(A9/A1) - AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.0+RIZ)*(PSI7+PSI8)) & - /(1.0+RIZ) - BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* & - (PSI7+PSI8)**2.0*(1.0+RIZ))/(1.0+RIZ) - CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) & - -A1/4.D0)/(1.0+RIZ) - - ! AA = PSI7+PSI8+PSI9+PSI10 - ! BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2. - ! CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0 - !C - CALL POLY3 (AA,BB,CC,PSI1,ISLV) - IF (ISLV == 0) THEN - PSI1 = MIN (PSI1,CHI1) - ELSE - PSI1 = ZERO - ENDIF - ENDIF - - IF (CHI9 >= TINY .AND. WATER > TINY) THEN - ! PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8) - PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ELSE - PSI9 = ZERO - ENDIF - - ! IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4 - ! CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV) - ! IF (ISLV.EQ.0) THEN - ! PSI9 = MAX (MIN (PSI9,CHI9), ZERO) - ! ELSE - ! PSI9 = ZERO - ! ENDIF - ! ENDIF - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 ! CLI - MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 ! NO3I - MOLAL (8) = PSI11 ! CAI - MOLAL (9) = 2.D0*PSI9 ! KI - MOLAL (10)= PSI10 ! MGI - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNACL = MAX(CHI7 - PSI7, ZERO) - CNANO3 = MAX(CHI8 - PSI8, ZERO) - CNA2SO4 = MAX(CHI1 - PSI1, ZERO) - CK2SO4 = MAX(CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCM2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE - 20 FUNCM2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCM2A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM1 -! *** CASE M1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCM1A, CALCM2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMM1) THEN - SCASE = 'M1 ; SUBCASE 1' - CALL CALCM1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'M1 ; SUBCASE 1' - ELSE - SCASE = 'M1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMM1, DRNH4NO3, CALCM1A, CALCM2A) - SCASE = 'M1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCM1 ****************************************** - - END SUBROUTINE CALCM1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCM1A -! *** CASE M1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 - -! *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCM1A - INCLUDE 'isrpia.inc' - real :: LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, & - NO3FR - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - SO4FR = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNA2SO4 = MAX (SO4FR,ZERO) ! CNA2SO4 - NAFR = MAX (W(1)-2.D0*CNA2SO4, ZERO) - CNANO3 = MIN (NAFR, W(4)) ! CNANO3 - NO3FR = MAX (W(4)-CNANO3, ZERO) - CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5)) ! CNACL - CLFR = MAX (W(5)-CNACL, ZERO) - -! *** CALCULATE VOLATILE SPECIES ************************************** - - ALF = W(3) ! FREE NH3 - BET = CLFR ! FREE CL - GAM = NO3FR ! FREE NO3 - - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - - THETA1 = GAM - BET*(A2/A1) - THETA2 = A2/A1 - -! QUADRATIC EQUATION SOLUTION - - BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) - CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) - DD = BB*BB - 4.0D0*CC - IF (DD < ZERO) GOTO 100 ! Solve each reaction seperately - -! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID - - SQDD = SQRT(DD) - KAPA1 = 0.5D0*(-BB+SQDD) - KAPA2 = 0.5D0*(-BB-SQDD) - LAMDA1 = THETA1 + THETA2*KAPA1 - LAMDA2 = THETA1 + THETA2*KAPA2 - - IF (KAPA1 >= ZERO .AND. LAMDA1 >= ZERO) THEN - IF (ALF-KAPA1-LAMDA1 >= ZERO .AND. & - BET-KAPA1 >= ZERO .AND. GAM-LAMDA1 >= ZERO) THEN - KAPA = KAPA1 - LAMDA= LAMDA1 - GOTO 200 - ENDIF - ENDIF - - IF (KAPA2 >= ZERO .AND. LAMDA2 >= ZERO) THEN - IF (ALF-KAPA2-LAMDA2 >= ZERO .AND. & - BET-KAPA2 >= ZERO .AND. GAM-LAMDA2 >= ZERO) THEN - KAPA = KAPA2 - LAMDA= LAMDA2 - GOTO 200 - ENDIF - ENDIF - -! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA - - 100 KAPA = ZERO - LAMDA = ZERO - DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) - DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) - -! NH4CL EQUILIBRIUM - - IF (DD1 >= ZERO) THEN - SQDD1 = SQRT(DD1) - KAPA1 = 0.5D0*(ALF+BET + SQDD1) - KAPA2 = 0.5D0*(ALF+BET - SQDD1) - - IF (KAPA1 >= ZERO .AND. KAPA1 <= MIN(ALF,BET)) THEN - KAPA = KAPA1 - ELSE IF (KAPA2 >= ZERO .AND. KAPA2 <= MIN(ALF,BET)) THEN - KAPA = KAPA2 - ELSE - KAPA = ZERO - ENDIF - ENDIF - -! NH4NO3 EQUILIBRIUM - - IF (DD2 >= ZERO) THEN - SQDD2 = SQRT(DD2) - LAMDA1= 0.5D0*(ALF+GAM + SQDD2) - LAMDA2= 0.5D0*(ALF+GAM - SQDD2) - - IF (LAMDA1 >= ZERO .AND. LAMDA1 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA1 - ELSE IF (LAMDA2 >= ZERO .AND. LAMDA2 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA2 - ELSE - LAMDA = ZERO - ENDIF - ENDIF - -! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION - - IF (KAPA > ZERO .AND. LAMDA > ZERO) THEN - IF (BET < LAMDA/THETA1) THEN - KAPA = ZERO - ELSE - LAMDA= ZERO - ENDIF - ENDIF - -! *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** - - 200 CONTINUE - CNH4NO3 = LAMDA - CNH4CL = KAPA - - GNH3 = ALF - KAPA - LAMDA - GHNO3 = GAM - LAMDA - GHCL = BET - KAPA - - RETURN - -! *** END OF SUBROUTINE CALCM1A ***************************************** - - END SUBROUTINE CALCM1A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP13 -! *** CASE P13 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP13 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP13 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP13 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP13 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP13 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP13') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP13 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP13 ****************************************** - - END SUBROUTINE CALCP13 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP13 -! *** CASE P13 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP13 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = CHI9 - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = CHI13 - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - ! *** CALCULATE SPECIATION ********************************************* - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - - ! *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP13 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP13 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP13 ******************************************* - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP12 -! *** CASE P12 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP12 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP12 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP12 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP12 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP12 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP12') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP12 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP12 ****************************************** - - END SUBROUTINE CALCP12 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP12 -! *** CASE P12 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP12 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = CHI13 - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN(MAX(PSI5, TINY),CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP12 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP12 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP12 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP11 -! *** CASE P11 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP11 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP11 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP11 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP11 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP11 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP11') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP11 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP11 ****************************************** - - END SUBROUTINE CALCP11 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP11 -! *** CASE P11 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP11 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 =0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP11 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP11 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP11 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP10 -! *** CASE P10 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP10 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP10 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP10 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP10 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP10 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP10') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP10 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP10 ****************************************** - - END SUBROUTINE CALCP10 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP10 -! *** CASE P10 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP10 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = CHI14 - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 =0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP10 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP10 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP10 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP9 -! *** CASE P9 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP9 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP9 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP9 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP9 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP9 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP9') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP9 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP9 ****************************************** - - END SUBROUTINE CALCP9 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP9 -! *** CASE P9 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP9 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP9 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP9 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP9 ******************************************* - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP8 -! *** CASE P8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP8 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP8 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP8 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP8 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP8 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP8') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP8 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP8 ****************************************** - - END SUBROUTINE CALCP8 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP8 -! *** CASE P8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP8 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = CHI7 - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - ! CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP8 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP8 ******************************************* - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP7 -! *** CASE P7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP7 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP7 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP7 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP7 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP7 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP7') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP7 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP7 ****************************************** - - END SUBROUTINE CALCP7 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP7 -! *** CASE P7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP7 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = CHI8 - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - ! CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = ZERO - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP7 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP7 ******************************************* - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP6 -! *** CASE P6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP6 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP6 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP6 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP6 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP6 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP6') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP6 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP6 ****************************************** - - END SUBROUTINE CALCP6 - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP6 -! *** CASE P6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NH4NO3 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP6 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - & - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - ! VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 - ! GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 - ! DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) - ! PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- & - PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - CNH4NO3 = ZERO - ! CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP6 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP6 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP5 -! *** CASE P5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -! NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP5 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP6 - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (W(4) > TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'P5 ; SUBCASE 1' - CALL CALCP5A - SCASE = 'P5 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP5) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCP1A - SCASE = 'P5 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P5 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP5, DRNH4NO3, CALCP1A, CALCP6) - SCASE = 'P5 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP5 ****************************************** - - END SUBROUTINE CALCP5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP5A -! *** CASE P5A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP5A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP5 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP5 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP5 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP5 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP5 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP5A ****************************************** - - END SUBROUTINE CALCP5A - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP5 -! *** CASE P5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP5 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) & - - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - ! VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 - ! GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 - ! DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) - ! PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- & - PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - !C - !C *** CALCULATE H+ ***************************************************** - !C - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNH4NO3 = ZERO - ! CNH4CL = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** NH4NO3(s) calculations - - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3 > A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21 > ZERO .AND. PSI21 > ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22 > ZERO .AND. PSI22 > ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP5 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP5 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP4 -! *** CASE P4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP4 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP5A - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (W(4) > TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'P4 ; SUBCASE 1' - CALL CALCP4A - SCASE = 'P4 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP4) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCP1A - SCASE = 'P4 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P4 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP4, DRMGNO32, CALCP1A, CALCP5A) - SCASE = 'P4 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP4 ****************************************** - - END SUBROUTINE CALCP4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP4A -! *** CASE P4A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2 -! 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP4A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP4 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP4 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP4 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP4 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP4 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP4A ****************************************** - - END SUBROUTINE CALCP4A - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP4 -! *** CASE P4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2 -! 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP4 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) & - - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - ! VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 - ! GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 - ! DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) - ! PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- & - PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNH4CL = ZERO - ! CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** NH4NO3(s) calculations - - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3 > A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21 > ZERO .AND. PSI21 > ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22 > ZERO .AND. PSI22 > ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP4 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP4 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP3 -! *** CASE P3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP4A - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (W(4) > TINY .AND. W(5) > TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE - SCASE = 'P3 ; SUBCASE 1' - CALL CALCP3A - SCASE = 'P3 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A - SCASE = 'P1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCP1A - SCASE = 'P3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'P3 ; SUBCASE 3' ! MDRH REGION (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP3, DRCANO32, CALCP1A, CALCP4A) - SCASE = 'P3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP3 ****************************************** - - END SUBROUTINE CALCP3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP3A -! *** CASE P3A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -! 4. Completely dissolved: CACL2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP3A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP3 (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP3 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP3 (PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP3 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP3') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP3 (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP3A ****************************************** - - END SUBROUTINE CALCP3A - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP3 -! *** CASE P3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -! 4. Completely dissolved: CACL2, MGCL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP3 (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) & - - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - ! VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 - ! GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 - ! DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) - ! PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- & - PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNH4CL = ZERO - ! CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** NH4NO3(s) calculations - - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3 > A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21 > ZERO .AND. PSI21 > ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22 > ZERO .AND. PSI22 > ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI2, TINY) - GHCL = MAX(GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP3 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP3 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP2 -! *** CASE P2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. CACL2(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -! 2. CACL2(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. CACL2(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES P1A, P2B -! RESPECTIVELY -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - - SUBROUTINE CALCP2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP3A, CALCP4A, CALCP5A, CALCP6 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCP1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** - - IF (CCACL2 > TINY) THEN - SCASE = 'P2 ; SUBCASE 1' - CALL CALCP2A - SCASE = 'P2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCP1A - SCASE = 'P2 ; SUBCASE 2' - ELSE - IF (CMGCL2 > TINY) THEN - SCASE = 'P2 ; SUBCASE 3' ! MDRH (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MGCL2, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP2, DRMGCL2, CALCP1A, CALCP3A) - SCASE = 'P2 ; SUBCASE 3' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP3 .AND. RH < DRMP4) THEN - SCASE = 'P2 ; SUBCASE 4' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, CANO32, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP3, DRCANO32, CALCP1A, CALCP4A) - SCASE = 'P2 ; SUBCASE 4' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP4 .AND. RH < DRMP5) THEN - SCASE = 'P2 ; SUBCASE 5' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! MGNO32, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP4, DRMGNO32, CALCP1A, CALCP5A) - SCASE = 'P2 ; SUBCASE 5' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP5) THEN - SCASE = 'P2 ; SUBCASE 6' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRH2 (RH, DRMP5, DRNH4NO3, CALCP1A, CALCP6) - SCASE = 'P2 ; SUBCASE 6' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO - 20 END DO - CALL CALCP1A - SCASE = 'P2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP2 ****************************************** - - END SUBROUTINE CALCP2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP2A -! *** CASE P2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, MG(NO3)2, CA(NO3)2 -! 4. Completely dissolved: CACL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP2A - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. - CHI11 = MIN (W(2), W(6)) ! CCASO4 - FRCA = MAX (W(6) - CHI11, ZERO) - FRSO4 = MAX (W(2) - CHI11, ZERO) - CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4 - FRK = MAX (W(7) - 2.D0*CHI9, ZERO) - FRSO4 = MAX (FRSO4 - CHI9, ZERO) - CHI10 = FRSO4 ! CMGSO4 - FRMG = MAX (W(8) - CHI10, ZERO) - CHI7 = MIN (W(1), W(5)) ! CNACL - FRNA = MAX (W(1) - CHI7, ZERO) - FRCL = MAX (W(5) - CHI7, ZERO) - CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32 - FRCA = MAX (FRCA - CHI12, ZERO) - FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO) - CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2 - FRCA = MAX (FRCA - CHI17, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI17, ZERO) - CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32 - FRMG = MAX (FRMG - CHI15, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO) - CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2 - FRMG = MAX (FRMG - CHI16, ZERO) - FRCL = MAX (FRCL - 2.D0*CHI16, ZERO) - CHI8 = MIN (FRNA, FRNO3) ! CNANO3 - FRNA = MAX (FRNA - CHI8, ZERO) - FRNO3 = MAX (FRNO3 - CHI8, ZERO) - CHI14 = MIN (FRK, FRCL) ! CKCL - FRK = MAX (FRK - CHI14, ZERO) - FRCL = MAX (FRCL - CHI14, ZERO) - CHI13 = MIN (FRK, FRNO3) ! CKNO3 - FRK = MAX (FRK - CHI13, ZERO) - FRNO3 = MAX (FRNO3 - CHI13, ZERO) - - CHI5 = FRNO3 ! HNO3(g) - CHI6 = FRCL ! HCL(g) - CHI4 = W(3) ! NH3(g) - - CHI3 = ZERO ! CNH4CL - CHI1 = ZERO - CHI2 = ZERO - - PSI6LO = TINY - PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI6LO - Y1 = FUNCP2A (X1) - IF (ABS(Y1) <= EPS .OR. CHI6 <= TINY) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNCP2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) EPS) Y2 = FUNCP2A(PSI6LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCP2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCP2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCP2A (X3) - -! *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* - - 50 CONTINUE - IF (MOLAL(1) > TINY .AND. MOLAL(5) > TINY) THEN - CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) - MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT - MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT - MOLAL(6) = DELTA ! HSO4 EFFECT - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCP2A ****************************************** - - END SUBROUTINE CALCP2A - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCP2A -! *** CASE P2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, MG(NO3)2, CA(NO3)2, MGCL2 -! 4. Completely dissolved: CACL2 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCP2A (X) - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = X - PSI1 = ZERO - PSI2 = ZERO - PSI3 = ZERO - PSI7 = ZERO - PSI8 = ZERO - PSI9 = ZERO - PSI10 = CHI10 - PSI11 = ZERO - PSI12 = CHI12 - PSI13 = ZERO - PSI14 = ZERO - PSI15 = CHI15 - PSI16 = CHI16 - PSI17 = CHI17 - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 - A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 - A9 = XK17 *(WATER/GAMA(17))**3.0 - A13 = XK19 *(WATER/GAMA(19))**2.0 - A14 = XK20 *(WATER/GAMA(20))**2.0 - A7 = XK8 *(WATER/GAMA(1))**2.0 - A8 = XK9 *(WATER/GAMA(3))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) & - - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3) - PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + & - & 2.D0*PSI16 + 2.D0*PSI17) - PSI5 = MIN (MAX (PSI5, TINY) , CHI5) - - IF (W(3) > TINY .AND. WATER > TINY) THEN ! First try 3rd order soln - BB =-(CHI4 + PSI6 + PSI5 + 1.0/A4) - CC = CHI4*(PSI5+PSI6) - DD = MAX(BB*BB-4.d0*CC,ZERO) - PSI4 =0.5d0*(-BB - SQRT(DD)) - PSI4 = MIN(MAX(PSI4,ZERO),CHI4) - ELSE - PSI4 = TINY - ENDIF - - IF (CHI13 > TINY .AND. WATER > TINY) THEN !KNO3 - VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9 - GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13 - DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO) - PSI13 = 0.5d0*(-VHTA + SQRT(DELTA)) - PSI13 = MIN(MAX(PSI13,ZERO),CHI13) - ENDIF - - IF (CHI14 > TINY .AND. WATER > TINY) THEN !KCL - PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - & - PSI6-PSI7-2.D0*PSI16-2.D0*PSI17 - PSI14 = MIN (MAX (PSI14, ZERO), CHI14) - ENDIF - - IF (CHI9 > TINY .AND. WATER > TINY) THEN !K2SO4 - BBP = PSI10+PSI13+PSI14 - CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10) - DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0 - CALL POLY3 (BBP, CCP, DDP, PSI9, ISLV) - IF (ISLV == 0) THEN - PSI9 = MIN (MAX(PSI9,ZERO) , CHI9) - ELSE - PSI9 = ZERO - ENDIF - ENDIF - - IF (CHI7 > TINY .AND. WATER > TINY) THEN ! NACL DISSOLUTION - VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17 - GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7 - DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO) - PSI7 = 0.5D0*( -VITA + SQRT(DIAK) ) - PSI7 = MAX(MIN(PSI7, CHI7), ZERO) - ENDIF - - IF (CHI8 > TINY .AND. WATER > TINY) THEN ! NANO3 DISSOLUTION - ! VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15 - ! GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8 - ! DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO) - ! PSI8 = 0.5D0*( -VIT + SQRT(DIA) ) - PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- & - PSI5-2.D0*PSI12-PSI13-2.D0*PSI15 - PSI8 = MAX(MIN(PSI8, CHI8), ZERO) - ENDIF - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL (2) = PSI8 + PSI7 ! NAI - MOLAL (3) = PSI4 ! NH4I - MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI - MOLAL (5) = PSI9 + PSI10 ! SO4I - MOLAL (6) = ZERO ! HSO4I - MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I - MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI - MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI - MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI - - ! *** CALCULATE H+ ***************************************************** - - ! REST = 2.D0*W(2) + W(4) + W(5) - !C - ! DELT1 = 0.0d0 - ! DELT2 = 0.0d0 - ! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN - !C - !C *** CALCULATE EQUILIBRIUM CONSTANTS ********************************** - !C - ! ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O - ! ALFA2 = XK27*(WATER/1.0) ! HCO3- - !C - ! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq) - !C - ! DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X) - ! DELT1 = 0.5*(-ALFA1 + DIAK) - ! DELT1 = MIN ( MAX (DELT1, ZERO), X) - ! DELT2 = ALFA2 - ! DELT2 = MIN ( DELT2, DELT1) - ! MOLAL(1) = DELT1 + DELT2 ! H+ - ! ELSE - !C - !C *** NO EXCESS OF CRUSTALS CALCULATE H+ ******************************* - !C - SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) & - - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8) - CALL CALCPH (SMIN, HI, OHI) - MOLAL (1) = HI - ! ENDIF - - GNH3 = MAX(CHI4 - PSI4, TINY) - GHNO3 = MAX(CHI5 - PSI5, TINY) - GHCL = MAX(CHI6 - PSI6, TINY) - - ! CNH4CL = ZERO - ! CNH4NO3 = ZERO - CNACL = MAX (CHI7 - PSI7, ZERO) - CNANO3 = MAX (CHI8 - PSI8, ZERO) - CK2SO4 = MAX (CHI9 - PSI9, ZERO) - CMGSO4 = ZERO - CCASO4 = CHI11 - CCANO32 = ZERO - CKNO3 = MAX (CHI13 - PSI13, ZERO) - CKCL = MAX (CHI14 - PSI14, ZERO) - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - ! *** NH4Cl(s) calculations - - A3 = XK6 /(R*TEMP*R*TEMP) - IF (GNH3*GHCL > A3) THEN - DELT = MIN(GNH3, GHCL) - BB = -(GNH3+GHCL) - CC = GNH3*GHCL-A3 - DD = BB*BB - 4.D0*CC - PSI31 = 0.5D0*(-BB + SQRT(DD)) - PSI32 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI31 > ZERO .AND. PSI31 > ZERO) THEN - PSI3 = PSI31 - ELSEIF (DELT-PSI32 > ZERO .AND. PSI32 > ZERO) THEN - PSI3 = PSI32 - ELSE - PSI3 = ZERO - ENDIF - ELSE - PSI3 = ZERO - ENDIF - PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX(GNH3 - PSI3, TINY) - GHCL = MAX(GHCL - PSI3, TINY) - CNH4CL = PSI3 - - ! *** NH4NO3(s) calculations - - A2 = XK10 /(R*TEMP*R*TEMP) - IF (GNH3*GHNO3 > A2) THEN - DELT = MIN(GNH3, GHNO3) - BB = -(GNH3+GHNO3) - CC = GNH3*GHNO3-A2 - DD = BB*BB - 4.D0*CC - PSI21 = 0.5D0*(-BB + SQRT(DD)) - PSI22 = 0.5D0*(-BB - SQRT(DD)) - IF (DELT-PSI21 > ZERO .AND. PSI21 > ZERO) THEN - PSI2 = PSI21 - ELSEIF (DELT-PSI22 > ZERO .AND. PSI22 > ZERO) THEN - PSI2 = PSI22 - ELSE - PSI2 = ZERO - ENDIF - ELSE - PSI2 = ZERO - ENDIF - PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO) - - ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - GNH3 = MAX (GNH3 - PSI2, TINY) - GHCL = MAX (GHNO3 - PSI2, TINY) - CNH4NO3 = PSI2 - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - -! 0 FUNCP2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE - 20 FUNCP2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE - - RETURN - -! *** END OF FUNCTION FUNCP2A ******************************************* - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP1 -! *** CASE P1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCP1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCP1A, CALCP2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMP1) THEN - SCASE = 'P1 ; SUBCASE 1' - CALL CALCP1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'P1 ; SUBCASE 1' - ELSE - SCASE = 'P1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRMP1, DRCACL2, CALCP1A, CALCP2A) - SCASE = 'P1 ; SUBCASE 2' - ENDIF - - - RETURN - -! *** END OF SUBROUTINE CALCP1 ****************************************** - - END SUBROUTINE CALCP1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCP1A -! *** CASE P1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCP1A - INCLUDE 'isrpia.inc' - real :: LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, & - NO3FR - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CCASO4 = MIN (W(2), W(6)) !SOLID CASO4 - CAFR = MAX (W(6) - CCASO4, ZERO) - SO4FR = MAX (W(2) - CCASO4, ZERO) - CK2SO4 = MIN (SO4FR, 0.5D0*W(7)) !SOLID K2SO4 - FRK = MAX (W(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CMGSO4 = SO4FR !SOLID MGSO4 - FRMG = MAX (W(8) - CMGSO4, ZERO) - CNACL = MIN (W(1), W(5)) !SOLID NACL - NAFR = MAX (W(1) - CNACL, ZERO) - CLFR = MAX (W(5) - CNACL, ZERO) - CCANO32 = MIN (CAFR, 0.5D0*W(4)) !SOLID CA(NO3)2 - CAFR = MAX (CAFR - CCANO32, ZERO) - NO3FR = MAX (W(4) - 2.D0*CCANO32, ZERO) - CCACL2 = MIN (CAFR, 0.5D0*CLFR) !SOLID CACL2 - CAFR = MAX (CAFR - CCACL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CCACL2, ZERO) - CMGNO32 = MIN (FRMG, 0.5D0*NO3FR) !SOLID MG(NO3)2 - FRMG = MAX (FRMG - CMGNO32, ZERO) - NO3FR = MAX (NO3FR - 2.D0*CMGNO32, ZERO) - CMGCL2 = MIN (FRMG, 0.5D0*CLFR) !SOLID MGCL2 - FRMG = MAX (FRMG - CMGCL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CMGCL2, ZERO) - CNANO3 = MIN (NAFR, NO3FR) !SOLID NANO3 - NAFR = MAX (NAFR - CNANO3, ZERO) - NO3FR = MAX (NO3FR - CNANO3, ZERO) - CKCL = MIN (FRK, CLFR) !SOLID KCL - FRK = MAX (FRK - CKCL, ZERO) - CLFR = MAX (CLFR - CKCL, ZERO) - CKNO3 = MIN (FRK, NO3FR) !SOLID KNO3 - FRK = MAX (FRK - CKNO3, ZERO) - NO3FR = MAX (NO3FR - CKNO3, ZERO) - -! *** CALCULATE VOLATILE SPECIES ************************************** - - ALF = W(3) ! FREE NH3 - BET = CLFR ! FREE CL - GAM = NO3FR ! FREE NO3 - - RTSQ = R*TEMP*R*TEMP - A1 = XK6/RTSQ - A2 = XK10/RTSQ - - THETA1 = GAM - BET*(A2/A1) - THETA2 = A2/A1 - -! QUADRATIC EQUATION SOLUTION - - BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) - CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) - DD = BB*BB - 4.0D0*CC - IF (DD < ZERO) GOTO 100 ! Solve each reaction seperately - -! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID - - SQDD = SQRT(DD) - KAPA1 = 0.5D0*(-BB+SQDD) - KAPA2 = 0.5D0*(-BB-SQDD) - LAMDA1 = THETA1 + THETA2*KAPA1 - LAMDA2 = THETA1 + THETA2*KAPA2 - - IF (KAPA1 >= ZERO .AND. LAMDA1 >= ZERO) THEN - IF (ALF-KAPA1-LAMDA1 >= ZERO .AND. & - BET-KAPA1 >= ZERO .AND. GAM-LAMDA1 >= ZERO) THEN - KAPA = KAPA1 - LAMDA= LAMDA1 - GOTO 200 - ENDIF - ENDIF - - IF (KAPA2 >= ZERO .AND. LAMDA2 >= ZERO) THEN - IF (ALF-KAPA2-LAMDA2 >= ZERO .AND. & - BET-KAPA2 >= ZERO .AND. GAM-LAMDA2 >= ZERO) THEN - KAPA = KAPA2 - LAMDA= LAMDA2 - GOTO 200 - ENDIF - ENDIF - -! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA - - 100 KAPA = ZERO - LAMDA = ZERO - DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) - DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) - -! NH4CL EQUILIBRIUM - - IF (DD1 >= ZERO) THEN - SQDD1 = SQRT(DD1) - KAPA1 = 0.5D0*(ALF+BET + SQDD1) - KAPA2 = 0.5D0*(ALF+BET - SQDD1) - - IF (KAPA1 >= ZERO .AND. KAPA1 <= MIN(ALF,BET)) THEN - KAPA = KAPA1 - ELSE IF (KAPA2 >= ZERO .AND. KAPA2 <= MIN(ALF,BET)) THEN - KAPA = KAPA2 - ELSE - KAPA = ZERO - ENDIF - ENDIF - -! NH4NO3 EQUILIBRIUM - - IF (DD2 >= ZERO) THEN - SQDD2 = SQRT(DD2) - LAMDA1= 0.5D0*(ALF+GAM + SQDD2) - LAMDA2= 0.5D0*(ALF+GAM - SQDD2) - - IF (LAMDA1 >= ZERO .AND. LAMDA1 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA1 - ELSE IF (LAMDA2 >= ZERO .AND. LAMDA2 <= MIN(ALF,GAM)) THEN - LAMDA = LAMDA2 - ELSE - LAMDA = ZERO - ENDIF - ENDIF - -! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION - - IF (KAPA > ZERO .AND. LAMDA > ZERO) THEN - IF (BET < LAMDA/THETA1) THEN - KAPA = ZERO - ELSE - LAMDA= ZERO - ENDIF - ENDIF - -! *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** - - 200 CONTINUE - CNH4NO3 = LAMDA - CNH4CL = KAPA - - GNH3 = ALF - KAPA - LAMDA - GHNO3 = GAM - LAMDA - GHCL = BET - KAPA - - RETURN - -! *** END OF SUBROUTINE CALCP1A ***************************************** - - END SUBROUTINE CALCP1A - -!====================================================================== - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCL9 -! *** CASE L9 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : CASO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4, K2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL9 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = CNA2SO4 - PSI5 = CNH42S4 - PSI6 = CK2SO4 - PSI7 = CMGSO4 - PSI8 = CKHSO4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = PSI2 + PSI3 + PSI1 + PSI8 - LAMDA ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = ZERO - - CALL CALCMR ! Water content - - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - - 20 RETURN - -! *** END OF SUBROUTINE CALCL9 ***************************************** - - END SUBROUTINE CALCL9 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCL8 -! *** CASE L8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL8 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = CNA2SO4 - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = CMGSO4 - PSI8 = CKHSO4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI6LO = ZERO ! Low limit - PSI6HI = CHI6 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - IF (CHI6 <= TINY) THEN - Y1 = FUNCL8 (ZERO) - GOTO 50 - ENDIF - - X1 = PSI6HI - Y1 = FUNCL8 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCL8 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCL8 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL8') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL8 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL8') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL8 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL8 ***************************************** - - END SUBROUTINE CALCL8 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL8 -! *** CASE L8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4 - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL8 (P6) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI6 = P6 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = ZERO - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A6 = XK17*(WATER/GAMA(17))**3.0 - FUNCL8 = MOLAL(9)*MOLAL(9)*MOLAL(5)/A6 - ONE - RETURN - -! *** END OF FUNCTION FUNCL8 **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL7 -! *** CASE L7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL7 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = CMGSO4 - PSI8 = CKHSO4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - IF (CHI4 <= TINY) THEN - Y1 = FUNCL7 (ZERO) - GOTO 50 - ENDIF - - X1 = PSI4HI - Y1 = FUNCL7 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCL7 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCL7 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL7') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL7 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL7') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL7 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL7 ***************************************** - - END SUBROUTINE CALCL7 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL7 -! *** CASE L7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4 - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL7 (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5 *(WATER/GAMA(2))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL7 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCL7 **************************************** - - END - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL6 -! *** CASE L6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL6 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = ZERO - PSI8 = CKHSO4 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - IF (CHI4 <= TINY) THEN - Y1 = FUNCL6 (ZERO) - GOTO 50 - ENDIF - - X1 = PSI4HI - Y1 = FUNCL6 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 ********* - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCL6 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCL6 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL6') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL6 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL6') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL6 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL6 ***************************************** - - END SUBROUTINE CALCL6 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL6 -! *** CASE L6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, NA2SO4 - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL6 (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5*(WATER/GAMA(2))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - PSI7 = CHI7 - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = BB*BB - 4.D0*CC - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = ZERO - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL6 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCL6 **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL5 -! *** CASE L5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL5 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = CNH42S4 - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - - -! *** INITIAL VALUES FOR BISECTION ************************************ - - IF (CHI4 <= TINY) THEN - Y1 = FUNCL5 (ZERO) - GOTO 50 - ENDIF - - X1 = PSI4HI - Y1 = FUNCL5 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ********* - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI4LO) - Y2 = FUNCL5 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCL5 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL5') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL5 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL5') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL5 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL5 ***************************************** - - END SUBROUTINE CALCL5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL5 -! *** CASE L5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4 - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL5 (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5*(WATER/GAMA(2))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - PSI7 = CHI7 - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = ZERO - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = MAX(CHI8 - PSI8, ZERO) - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL5 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - - RETURN - -! *** END OF FUNCTION FUNCL5 **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL4 -! *** CASE L4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL4 - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = CLC - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI4LO = ZERO ! Low limit - PSI4HI = CHI4 ! High limit - - IF (CHI4 <= TINY) THEN - Y1 = FUNCL4 (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI4HI - Y1 = FUNCL4 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ********* - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCL4 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 ** - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCL4 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCL4') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL4 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL4') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL4 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL4 ***************************************** - - END SUBROUTINE CALCL4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL4 -! *** CASE L4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4 -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL4 (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5*(WATER/GAMA(2))**3.0 - A5 = XK7*(WATER/GAMA(4))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) & ! psi5 - /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) - - PSI7 = CHI7 - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = ZERO - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = ZERO - CKHSO4 = MAX(CHI8 - PSI8, ZERO) - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL4 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCL4 **************************************** - - END -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL3 -! *** CASE L3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A) -! 2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B -! RESPECTIVELY - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL4 - -! *** FIND DRY COMPOSITION ********************************************* - - CALL CALCL1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************* - - IF (CNH4HS4 > TINY .OR. CNAHSO4 > TINY) THEN - SCASE = 'L3 ; SUBCASE 1' - CALL CALCL3A ! FULL SOLUTION - SCASE = 'L3 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRML3) THEN ! SOLID SOLUTION - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCL1A - SCASE = 'L3 ; SUBCASE 2' - - ELSEIF (RH >= DRML3) THEN ! MDRH OF L3 - SCASE = 'L3 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRML3, DRLC, CALCL1A, CALCL4) - SCASE = 'L3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCL3 ***************************************** - - END SUBROUTINE CALCL3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL3A -! *** CASE L3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL3A - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = CNAHSO4 - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI2LO = ZERO ! Low limit - PSI2HI = CHI2 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI2HI - Y1 = FUNCL3A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* - - IF (YHI < EPS) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI2LO) - Y2 = FUNCL3A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - IF (Y2 > EPS) Y2 = FUNCL3A (ZERO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL3A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL3A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL3A ***************************************** - - END SUBROUTINE CALCL3A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCL3A -! *** CASE L3 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL3A (P2) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - - PSI2 = P2 ! Save PSI2 in COMMON BLOCK - PSI4LO = ZERO ! Low limit for PSI4 - PSI4HI = CHI4 ! High limit for PSI4 - -! *** IF NH3 =0, CALL FUNCL3B FOR Y4=0 ******************************** - - IF (CHI4 <= TINY) THEN - FUNCL3A = FUNCL3B (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI4HI - Y1 = FUNCL3B (X1) - IF (ABS(Y1) <= EPS) GOTO 50 - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ********* - - IF (YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI4LO) - Y2 = FUNCL3B (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 - - IF (Y2 > EPS) Y2 = FUNCL3B (PSI4LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL3B (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0004, 'FUNCL3A') ! WARNING ERROR: NO CONVERGENCE - -! *** INNER LOOP CONVERGED ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL3B (X3) - -! *** CALCULATE FUNCTION VALUE FOR INTERNAL LOOP *************************** - - 50 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCL3A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE - RETURN - -! *** END OF FUNCTION FUNCL3A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** FUNCTION FUNCL3B -! *** CASE L3 ; SUBCASE 2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4 - -! SOLUTION IS SAVED IN COMMON BLOCK /CASE/ -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL3B (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 - - FRST = .TRUE. - CALAIN = .TRUE. - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK5*(WATER/GAMA(2))**3.0 - A5 = XK7*(WATER/GAMA(4))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) & ! psi5 - /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) - - PSI7 = CHI7 - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = MAX(CHI2 - PSI2, ZERO) - CNAHSO4 = ZERO - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = MAX(CHI7 - PSI7, ZERO) - CKHSO4 = MAX(CHI8 - PSI8, ZERO) - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL3B = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCL3B **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL2 -! *** CASE L2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -! 2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES L1A, L2B -! RESPECTIVELY - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL3A - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCL1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** - - IF (CNH4HS4 > TINY) THEN - SCASE = 'L2 ; SUBCASE 1' - CALL CALCL2A - SCASE = 'L2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRML2) THEN ! SOLID SOLUTION ONLY - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCL1A - SCASE = 'L2 ; SUBCASE 2' - - ELSEIF (RH >= DRML2) THEN ! MDRH OF L2 - SCASE = 'L2 ; SUBCASE 3' - CALL CALCMDRH2 (RH, DRML2, DRNAHSO4, CALCL1A, CALCL3A) - SCASE = 'L2 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCL2 ****************************************** - - END SUBROUTINE CALCL2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL2A -! *** CASE L2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL2A - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = CNH4HS4 ! Save from CALCL1 run - CHI2 = CLC - CHI3 = CNAHSO4 - CHI4 = CNA2SO4 - CHI5 = CNH42S4 - CHI6 = CK2SO4 - CHI7 = CMGSO4 - CHI8 = CKHSO4 - - - PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's - PSI2 = ZERO - PSI3 = ZERO - PSI4 = ZERO - PSI5 = ZERO - PSI6 = ZERO - PSI7 = ZERO - PSI8 = ZERO - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI2LO = ZERO ! Low limit - PSI2HI = CHI2 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI2HI - Y1 = FUNCL2A (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ********* - - IF (YHI < EPS) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI2LO) - Y2 = FUNCL2A (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 - - IF (Y2 > EPS) Y2 = FUNCL2A (ZERO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL2A (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCL2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL2A (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCL2A ***************************************** - - END SUBROUTINE CALCL2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCL2A -! *** CASE L2 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL2A (P2) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - - PSI2 = P2 ! Save PSI3 in COMMON BLOCK - PSI4LO = ZERO ! Low limit for PSI4 - PSI4HI = CHI4 ! High limit for PSI4 - -! *** IF NH3 =0, CALL FUNCL3B FOR Y4=0 ******************************** - - - IF (CHI4 <= TINY) THEN - FUNCL2A = FUNCL2B (ZERO) - GOTO 50 - ENDIF - -! *** INITIAL VALUES FOR BISECTION ************************************ - - - X1 = PSI4HI - Y1 = FUNCL2B (X1) - - IF (ABS(Y1) <= EPS) GOTO 50 - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* - - IF (YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, PSI4LO) - Y2 = FUNCL2B (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC - - IF (Y2 > EPS) Y2 = FUNCL2B (PSI4LO) - GOTO 50 - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCL2B (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0004, 'FUNCL2A') ! WARNING ERROR: NO CONVERGENCE - -! *** INNER LOOP CONVERGED ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCL2B (X3) - -! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** - - 50 A2 = XK13*(WATER/GAMA(13))**5.0 - FUNCL2A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE - RETURN - -! *** END OF FUNCTION FUNCL2A ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCL2B -! *** CASE L2 ; SUBCASE 2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -! 4. COMPLETELY DISSOLVED: NH4HSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCL2B (P4) - INCLUDE 'isrpia.inc' - real :: LAMDA - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - PSI4 = P4 ! Save PSI4 in COMMON BLOCK - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - PSI3 = CHI3 - PSI5 = CHI5 - LAMDA = ZERO - PSI6 = CHI6 - PSI8 = CHI8 - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A3 = XK11*(WATER/GAMA(12))**2.0 - A4 = XK5*(WATER/GAMA(2))**3.0 - A5 = XK7*(WATER/GAMA(4))**3.0 - A6 = XK17*(WATER/GAMA(17))**3.0 - A8 = XK18*(WATER/GAMA(18))**2.0 - A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0) - - ! CALCULATE DISSOCIATION QUANTITIES - - PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) & ! psi5 - /2.D0/SQRT(A4/A5) - PSI5 = MAX (MIN (PSI5, CHI5), ZERO) - - IF (CHI3 > TINY .AND. WATER > TINY) THEN - AA = 2.D0*PSI4 + PSI2 + PSI1 + PSI8 - LAMDA - BB = 2.D0*PSI4*(PSI2 + PSI1 + PSI8 - LAMDA) - A3 - CC = ZERO - CALL POLY3 (AA, BB, CC, PSI3, ISLV) - IF (ISLV == 0) THEN - PSI3 = MIN (PSI3, CHI3) - ELSE - PSI3 = ZERO - ENDIF - ENDIF - - PSI7 = CHI7 - - BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA - CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - LAMDA= 0.5D0*(-BB + SQRT(DD)) - LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1) - - ! PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6 - ! PSI6 = MIN (MAX (PSI6, ZERO), CHI6) - - IF (CHI6 > TINY .AND. WATER > TINY) THEN - AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA - BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA) - CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6) - CALL POLY3 (AA, BB, CC, PSI6, ISLV) - IF (ISLV == 0) THEN - PSI6 = MIN (PSI6, CHI6) - ELSE - PSI6 = ZERO - ENDIF - ENDIF - - BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA ! PSI8 - CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8 - DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO) - PSI8 = 0.5D0*(-BITA + SQRT(DELT)) - PSI8 = MIN(MAX (PSI8, ZERO), CHI8) - - ! *** CALCULATE SPECIATION ******************************************** - - MOLAL(1) = LAMDA ! HI - MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI - MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I - MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I - MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I - MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI - MOLAL(10)= PSI7 ! MGI - - CLC = MAX(CHI2 - PSI2, ZERO) - CNAHSO4 = MAX(CHI3 - PSI3, ZERO) - CNA2SO4 = MAX(CHI4 - PSI4, ZERO) - CNH42S4 = MAX(CHI5 - PSI5, ZERO) - CNH4HS4 = ZERO - CK2SO4 = MAX(CHI6 - PSI6, ZERO) - CMGSO4 = MAX(CHI7 - PSI7, ZERO) - CKHSO4 = MAX(CHI8 - PSI8, ZERO) - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 A4 = XK5 *(WATER/GAMA(2))**3.0 - FUNCL2B = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCL2B **************************************** - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL1 -! *** CASE L1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCL1A, CALCL2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRML1) THEN - SCASE = 'L1 ; SUBCASE 1' - CALL CALCL1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'L1 ; SUBCASE 1' - ELSE - SCASE = 'L1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRH2 (RH, DRML1, DRNH4HS4, CALCL1A, CALCL2A) - SCASE = 'L1 ; SUBCASE 2' - ENDIF - -! *** AMMONIA IN GAS PHASE ********************************************** - -! CALL CALCNH3 - - RETURN - -! *** END OF SUBROUTINE CALCL1 ****************************************** - - END SUBROUTINE CALCL1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCL1A -! *** CASE L1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCL1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE NON VOLATILE SOLIDS *********************************** - - CCASO4 = MIN (W(6), W(2)) ! CCASO4 - FRSO4 = MAX(W(2) - CCASO4, ZERO) - CAFR = MAX(W(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*W(7), FRSO4) ! CK2SO4 - FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO) - FRSO4 = MAX(FRSO4 - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*W(1), FRSO4) ! CNA2SO4 - FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO) - FRSO4 = MAX(FRSO4 - CNA2SO4, ZERO) - CMGSO4 = MIN (W(8), FRSO4) ! CMGSO4 - FRMG = MAX(W(8) - CMGSO4, ZERO) - FRSO4 = MAX(FRSO4 - CMGSO4, ZERO) - - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CNH42S4 = ZERO - CKHSO4 = ZERO - - CLC = MIN(W(3)/3.D0, FRSO4/2.D0) - FRSO4 = MAX(FRSO4-2.D0*CLC, ZERO) - FRNH4 = MAX(W(3)-3.D0*CLC, ZERO) - - IF (FRSO4 <= TINY) THEN - CLC = MAX(CLC - FRNH4, ZERO) - CNH42S4 = 2.D0*FRNH4 - - ELSEIF (FRNH4 <= TINY) THEN - CNH4HS4 = 3.D0*MIN(FRSO4, CLC) - CLC = MAX(CLC-FRSO4, ZERO) - ! IF (CK2SO4.GT.TINY) THEN - ! FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - ! CKHSO4 = 2.D0*FRSO4 - ! CK2SO4 = MAX(CK2SO4-FRSO4, ZERO) - ! ENDIF - ! IF (CNA2SO4.GT.TINY) THEN - ! FRSO4 = MAX(FRSO4-CKHSO4/2.D0, ZERO) - ! CNAHSO4 = 2.D0*FRSO4 - ! CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) - ! ENDIF - - IF (CNA2SO4 > TINY) THEN - FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - CNAHSO4 = 2.D0*FRSO4 - CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) - ENDIF - IF (CK2SO4 > TINY) THEN - FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) - CKHSO4 = 2.D0*FRSO4 - CK2SO4 = MAX(CK2SO4-FRSO4, ZERO) - ENDIF - ENDIF - -! *** CALCULATE GAS SPECIES ******************************************** - - GHNO3 = W(4) - GHCL = W(5) - GNH3 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCL1A ***************************************** - - END SUBROUTINE CALCL1A - - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCK4 -! *** CASE K4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCK4 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 - - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED - PSI3 = CHI3 ! ALL KHSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = MAX(LAMDA + KAPA, TINY) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA + PSI1 + PSI2 + PSI3 - KAPA, ZERO) ! HSO4I - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 ! MGI - - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CKHSO4 = ZERO - CCASO4 = W(6) - CMGSO4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - - 20 RETURN - -! *** END OF SUBROUTINE CALCK4 - - END SUBROUTINE CALCK4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCK3 -! *** CASE K3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : KHSO4, CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCK3 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 - - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI3HI - Y1 = FUNCK3 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCK3 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCK3 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK3') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCK3 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCK3') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCK3 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCK3 ****************************************** - - END SUBROUTINE CALCK3 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE FUNCK3 -! *** CASE K3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : KHSO4, CaSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCK3 (P1) - INCLUDE 'isrpia.inc' - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED - - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO - MOLAL (8) = ZERO - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 - - CNH4HS4 = ZERO - CNAHSO4 = ZERO - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCK3 = MOLAL(9)*MOLAL(6)/A3 - ONE - -! *** END OF FUNCTION FUNCK3 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCK2 -! *** CASE K2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCK2 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MgSO4 - - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI3HI - Y1 = FUNCK2 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCK2 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCK2 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK2') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCK2 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCK2') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCK2 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCK2 ****************************************** - - END SUBROUTINE CALCK2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCK2 -! *** CASE K2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCK2 (P1) - INCLUDE 'isrpia.inc' - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A2 = XK11 *(WATER/GAMA(12))**2.0 - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - PSI2 = A2/A3*PSI3 ! PSI2 - PSI2 = MIN(MAX(PSI2, ZERO),CHI2) - - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO - MOLAL (8) = ZERO - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 - - CNH4HS4 = ZERO - CNAHSO4 = CHI2-PSI2 - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCK2 = MOLAL(9)*MOLAL(6)/A3 - ONE - -! *** END OF FUNCTION FUNCK2 ******************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCK1 -! *** CASE K1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCK1 - INCLUDE 'isrpia.inc' - - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - - CALAOU = .TRUE. ! Outer loop activity calculation flag - CHI1 = W(3) ! Total NH4 initially as NH4HSO4 - CHI2 = W(1) ! Total NA initially as NaHSO4 - CHI3 = W(7) ! Total K initially as KHSO4 - CHI4 = W(8) ! Total Mg initially as MGSO4 - - PSI3LO = TINY ! Low limit - PSI3HI = CHI3 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI3HI - Y1 = FUNCK1 (X1) - YHI= Y1 ! Save Y-value at HI position - -! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 **** - - IF (ABS(Y1) <= EPS .OR. YHI < ZERO) GOTO 50 - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI3HI-PSI3LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1-DX - Y2 = FUNCK1 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4 - - YLO= Y1 ! Save Y-value at Hi position - IF (YLO > ZERO .AND. YHI > ZERO) THEN - Y3 = FUNCK1 (ZERO) - GOTO 50 - ELSE IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCK1') ! WARNING ERROR: NO SOLUTION - GOTO 50 - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCK1 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCK1') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCK1 (X3) - - 50 RETURN - -! *** END OF SUBROUTINE CALCK1 ****************************************** - - END SUBROUTINE CALCK1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE FUNCK1 -! *** CASE K1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE super RICH, FREE ACID (SO4RAT < 1.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - real FUNCTION FUNCK1 (P1) - INCLUDE 'isrpia.inc' - real :: LAMDA, KAPA - COMMON /CASEK/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, & - A1, A2, A3, A4 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - - LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4 - PSI3 = P1 - PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A1 = XK12 *(WATER/GAMA(09))**2.0 - A2 = XK11 *(WATER/GAMA(12))**2.0 - A3 = XK18 *(WATER/GAMA(18))**2.0 - A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 - - PSI1 = A1/A3*PSI3 ! PSI1 - PSI1 = MIN(MAX(PSI1, ZERO),CHI1) - - PSI2 = A2/A3*PSI3 ! PSI2 - PSI2 = MIN(MAX(PSI2, ZERO),CHI2) - - BB = A4+LAMDA+PSI4 ! KAPA - CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4 - DD = MAX(BB*BB-4.D0*CC, ZERO) - KAPA = 0.5D0*(-BB+SQRT(DD)) - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI - MOLAL (2) = PSI2 ! NAI - MOLAL (3) = PSI1 ! NH4I - MOLAL (4) = ZERO ! CLI - MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I - MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I - MOLAL (7) = ZERO ! NO3I - MOLAL (8) = ZERO ! CAI - MOLAL (9) = PSI3 ! KI - MOLAL (10)= PSI4 ! MGI - - CNH4HS4 = CHI1-PSI1 - CNAHSO4 = CHI2-PSI2 - CKHSO4 = CHI3-PSI3 - CCASO4 = W(6) - CMGSO4 = ZERO - - CALL CALCMR ! Water content - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCK1 = MOLAL(9)*MOLAL(6)/A3 - ONE - -! *** END OF FUNCTION FUNCK1 **************************************** - - END - diff --git a/InterpolationRoutines_ml.f90 b/InterpolationRoutines_ml.f90 index 678e286..b9ded07 100644 --- a/InterpolationRoutines_ml.f90 +++ b/InterpolationRoutines_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -199,7 +199,7 @@ function inside_1234(x1,x2,x3,x4,y1,y2,y3,y4,x,y) result(inside) ((x2-x3)*(y-y3)-(x-x3)*(y2-y3))*((x4-x1)*(y-y1)-(x-x1)*(y4-y1))>0)& then inside=.true. - endif + end if end function inside_1234 @@ -214,7 +214,7 @@ function great_circle_distance(fi1,lambda1,fi2,lambda2) result(dist) cos(DEG2RAD*lambda1)*cos(DEG2RAD*lambda2)*& sin(DEG2RAD*0.5*(fi1-fi2))**2)) -endfunction great_circle_distance +end function great_circle_distance !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Nearest4interp(glon, glat, values_grid, & dlon,dlat,values_data, NXD,NYD,& @@ -254,9 +254,9 @@ subroutine Nearest4interp(glon, glat, values_grid, & print "(12x,a)" , "-------------------------------------------------" do j = NYD, 1, -1 print "(f9.1,9f10.3)", dlat(1,j), ( values_data(i,j), i = 1, NXD) - enddo + end do print "(12x,a)" , "-------------------------------------------------" - endif + end if call grid2grid_coeff( & glon,glat, & @@ -276,17 +276,17 @@ subroutine Nearest4interp(glon, glat, values_grid, & if ( values_data(ii,jj) > Undefined ) then values_grid(i,j)=values_grid(i,j)+ww(k)*values_data(ii,jj) sumWeights =sumWeights +ww(k) - endif - enddo + end if + end do if(sumWeights>1.0e-9) then values_grid(i,j)= values_grid(i,j)/sumWeights else values_grid(i,j)= Undef - endif + end if - enddo - enddo + end do + end do if(debug)then print *, " " @@ -296,10 +296,10 @@ subroutine Nearest4interp(glon, glat, values_grid, & print "(12x,a)" , "--------------------------------------------------" do j = NYG, 1, -1 print "(f9.1,9f10.3)", glat(1,j), ( values_grid(i,j), i = 1, NXG) - enddo + end do print "(12x,a)" , "--------------------------------------------------" - endif -endsubroutine Nearest4interp + end if +end subroutine Nearest4interp !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine grid2grid_coeff(glon,glat,IIij,JJij,Weight,& @@ -331,9 +331,9 @@ subroutine grid2grid_coeff(glon,glat,IIij,JJij,Weight,& call point2grid_coeff(glon(i,j),glat(i,j),& IIij(:,i,j),JJij(:,i,j),Weight(:,i,j),& dlon,dlat,NXD,NYD,all((/debug,i==debug_li,j==debug_lj/))) - enddo - enddo -endsubroutine grid2grid_coeff + end do + end do +end subroutine grid2grid_coeff subroutine point2grid_coeff(glon,glat,IIij,JJij,Weight,dlon,dlat,NXD,NYD,debug) real, intent(in) :: glon,glat ! lat/long of target grid integer, intent(in) :: NXD,NYD ! dimension of data grid @@ -357,8 +357,8 @@ subroutine point2grid_coeff(glon,glat,IIij,JJij,Weight,dlon,dlat,NXD,NYD,debug) JJij(n:4)=EOSHIFT(JJij(n:4),-1,BOUNDARY=JJ) ! if(debug) write(*,"(a,2i4,f10.3,2i4,4f9.3,4es12.3)") "DEBUG-g2g", & ! II,JJ,DD,IIij(1),JJij(1),dlon(II,JJ),dlat(II,JJ),glon,glat,dist(:) - enddo ! II - enddo ! JJ + end do ! II + end do ! JJ Weight(1)=1.0-3.0*dist(1)/sum(dist(1:4)) Weight(2)=(1.0-Weight(1))*(1.0-2.0*dist(2)/sum(dist(2:4))) @@ -367,7 +367,7 @@ subroutine point2grid_coeff(glon,glat,IIij,JJij,Weight,dlon,dlat,NXD,NYD,debug) if(debug) write(*,"(a,I1,2es12.3)") & "DEBUG-g2gFinal",0,sum(dist),sum(Weight),& ("DEBUG-g2gFinal",n,dist(n),Weight(n),n=1,4) -endsubroutine point2grid_coeff +end subroutine point2grid_coeff subroutine Averageconserved_interpolate(Start,Endval,Average,Nvalues,i,x) !this routine interpolates a function, and evaluate it at i @@ -398,7 +398,7 @@ subroutine Averageconserved_interpolate(Start,Endval,Average,Nvalues,i,x) Middle=2.0*Average-(Start+Endval)*0.5 else Middle=(2.0*Nvalues*Average-(Nvalues-1)*(Start+Endval)*0.5)/(Nvalues+1) - endif + end if !B) Evaluate the function at i @@ -419,7 +419,7 @@ subroutine Averageconserved_interpolate(Start,Endval,Average,Nvalues,i,x) else !should not be possible stop - endif + end if end subroutine Averageconserved_interpolate diff --git a/Io_Nums_ml.f90 b/Io_Nums_ml.f90 index cf83c14..f1edaa6 100644 --- a/Io_Nums_ml.f90 +++ b/Io_Nums_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/Io_Progs_ml.f90 b/Io_Progs_ml.f90 index a861a10..5308487 100644 --- a/Io_Progs_ml.f90 +++ b/Io_Progs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -114,7 +114,6 @@ subroutine read_line(io_in,txt,status,label,printif) character(len=*), intent(inout) :: txt character(len=len(txt)+30) :: errmsg integer, intent(out) :: status - integer :: INFO character(len=*), intent(in), optional :: label logical, intent(in), optional :: printif ! Can switch debug printouts logical :: ok2print @@ -133,21 +132,21 @@ subroutine read_line(io_in,txt,status,label,printif) write(unit=errmsg,fmt=*) "ERROR? Increase MAXLINELEN for IO", & io_in, len_trim(txt), "txt = " call CheckStop ( errmsg // txt ) - endif + end if if ( DEBUG%IOPROG ) then ! nb already MasterProc if( ok2print ) write(unit=*,fmt="(a,i3,2a,i5,a,a,i4)") & "IOREADLINE ", io_in, trim(label2), " Len ", len_trim(txt), & "TXT:" // trim(txt), " Stat ", status - endif - endif + end if + end if call MPI_BCAST( txt, len(txt), MPI_CHARACTER, 0, MPI_COMM_CALC,IERROR) call MPI_BCAST( status, 1, MPI_INTEGER, 0, MPI_COMM_CALC,IERROR) if ( DEBUG%IOPROG .and. me==1 ) then write(unit=errmsg,fmt=*) "proc(me) ", me, " BCAST_LINE:" // trim(txt) write(unit=*,fmt=*) trim(errmsg) - endif + end if CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) end subroutine read_line @@ -207,9 +206,9 @@ subroutine open_file(io_num,mode,fname,needed,skip,iostat) if ( present( skip ) ) then ! Read (skip) some lines at start of file do i = 1, skip read(unit=io_num,fmt=*) - enddo - endif ! skip - endif + end do + end if ! skip + end if case ("w") if ( .not. fexist ) then ! Super-fussy coding! open(unit=io_num,file=fname,action="write",& @@ -217,7 +216,7 @@ subroutine open_file(io_num,mode,fname,needed,skip,iostat) else open(unit=io_num,file=fname,action="write",& status="replace",position="rewind",iostat=ios) - endif + end if write(unit=6,fmt=*) "File created: ", trim(fname) case default print *, "OPEN FILE: Incorrect mode: ", trim(mode) @@ -288,15 +287,15 @@ subroutine Read_Headers(io_num,io_msg,NHeaders,NKeys,Headers,Keyvalues,& if ( xHeaders(i)(1:1) /= "#" .and. len_trim(xHeaders(i)) > 0 ) then NHeaders = NHeaders + 1 Headers(i) = xHeaders(i) - endif - enddo + end if + end do do i = NHeaders+1, size(Headers) Headers(i) = "" ! Remove trailing txt - enddo + end do if ( DEBUG%IOPROG .and. MasterProc ) then write(*,*) "Read_Headers sizes: ", size(xHeaders) , NHeaders write(*,*) "New inputline ", trim( inputline ) - endif + end if cycle elseif ( inputline(1:3) == ":: " ) then ! WILL DO LATER @@ -311,13 +310,13 @@ subroutine Read_Headers(io_num,io_msg,NHeaders,NKeys,Headers,Keyvalues,& do i = 1, ncheck call CheckStop( KeyValue(KeyValues,CheckValues(i)%key),& CheckValues(i)%value ,"Comparing Values: "//CheckValues(i)%key) - enddo - endif + end do + end if if ( MasterProc .and. DEBUG%IOPROG ) then write(*,*) "DATA LINE" // trim(inputline) write(*,*)("HEADER CHECK ", i, Headers(i), i = 1, NHeaders) - endif + end if return elseif ( index(inputline,"#SKIP") > 0 ) then ! Comments @@ -331,8 +330,8 @@ subroutine Read_Headers(io_num,io_msg,NHeaders,NKeys,Headers,Keyvalues,& else call CheckStop( NHeaders < 1,& "GOT TO END - NO #HEADER or #DATA STATEMENT MAYBE?") - endif - enddo + end if + end do io_msg = "GOT TO END - NO #DATA STATEMENT MAYBE?" end subroutine Read_Headers !------------------------------------------------------------------------- @@ -360,7 +359,7 @@ subroutine Read2D(fname,data2d,idata2d) if ( MasterProc ) then call open_file(IO_TMP,"r",fname,needed=.true.) call CheckStop(ios,"open_file error on " // fname ) - endif + end if call Read_Headers(IO_TMP,errmsg,NHeaders,NKeys,Headers,Keyvalues) @@ -378,7 +377,7 @@ subroutine Read2D(fname,data2d,idata2d) if ( DEBUG%IOPROG .and. MasterProc ) then write(*,*) "Read2D Headers" // fname, NHeaders, Headers(1) ! call WriteArray(Headers,NHeaders,"Read2D Headers") - endif + end if READLOOP: do call read_line(IO_TMP,txtinput,ios,"ReadLine for "//trim(fname)) @@ -391,7 +390,7 @@ subroutine Read2D(fname,data2d,idata2d) if( MasterProc ) write(*,*) "WARNING: Input Data in ",& trim(fname)," coords outside fulldomain: ", i_fdom, j_fdom cycle READLOOP - endif + end if i = i_local(i_fdom) ! Convert to local coordinates j = j_local(j_fdom) @@ -405,8 +404,8 @@ subroutine Read2D(fname,data2d,idata2d) else data2d(i,j) = tmp end if - endif ! i,j - enddo READLOOP + end if ! i,j + end do READLOOP if ( MasterProc ) then close(IO_TMP) @@ -446,14 +445,14 @@ subroutine Read2DN(fname,Ndata,data2d,CheckValues,HeadersRead) if ( present(HeadersRead) ) then ! Headers have already been read Start_Needed = .false. NHeaders = -1 ! not set in this case - endif + end if !====================================================================== if ( Start_Needed ) then if ( MasterProc ) then call open_file(IO_TMP,"r",fname,needed=.true.) call CheckStop(ios,"ios error on Inputs.landuse") - endif + end if call Read_Headers(IO_TMP,errmsg,NHeaders,NKeys,Headers,Keyvalues) @@ -469,21 +468,21 @@ subroutine Read2DN(fname,Ndata,data2d,CheckValues,HeadersRead) do i = 1, ncheck call CheckStop( KeyValue(KeyValues,CheckValues(i)%key),& CheckValues(i)%value ,"Comparing Values: " // CheckValues(i)%key ) - enddo - endif + end do + end if ! The first two columns are assumed for now to be ix,iy, hence: Headers(1:Ndata) = Headers(3:Ndata+2) NHeaders = NHeaders -2 - endif ! Start_Needed + end if ! Start_Needed !====================================================================== if ( DEBUG%IOPROG .and. MasterProc ) then write(*,*) "Read2DN for ", fname, "Start_Needed ", Start_Needed, " NHeader", NHeaders write(*,*)("Read2D Headers" // fname, i, " Len ", len_trim(Headers(i)), & " H: ", trim(Headers(i)),i = 1, NHeaders) !call WriteArray(Headers,NHeaders,"Read2D Headers") - endif + end if do call read_line(IO_TMP,txtinput,ios,"ReadLine for "//fname, & @@ -498,7 +497,7 @@ subroutine Read2DN(fname,Ndata,data2d,CheckValues,HeadersRead) if( MasterProc ) write(*,*) "WARNING: Input Data in ",& trim(fname)," coords outside fulldomain: ", i_fdom, j_fdom cycle - endif + end if i = i_local(i_fdom) ! Convert to local coordinates j = j_local(j_fdom) @@ -506,8 +505,8 @@ subroutine Read2DN(fname,Ndata,data2d,CheckValues,HeadersRead) if ( DEBUG%IOPROG .and. i_fdom==DEBUG%IJ(1) .and. j_fdom == DEBUG%IJ(2) )& write(*,*)"READ TXTINPUT", me, i_fdom, j_fdom, " => ", i,j,tmp(1) data2d(i,j,1:Ndata) = tmp(1:Ndata) - endif ! i,j - enddo + end if ! i,j + end do if ( MasterProc ) then close(IO_TMP) @@ -530,7 +529,7 @@ subroutine datewrite_ia (txt,ii,array,txt_pattern) write(*,"(a,3i3,i5,1x, i0, 20es14.5)") "dw:" // trim(txt), & current_date%month, current_date%day, current_date%hour, & current_date%seconds, ii, array - endif + end if end subroutine datewrite_ia subroutine datewrite_a (txt,array,txt_pattern) ! to write out date + supplied data array @@ -546,7 +545,7 @@ subroutine datewrite_a (txt,array,txt_pattern) write(*,"(a,3i3,i5,1x, 20es11.3)") "dw:" // trim(txt), & current_date%month, current_date%day, current_date%hour, & current_date%seconds, array - endif + end if end subroutine datewrite_a subroutine datewrite_iia (txt,ii,array,txt_pattern) ! to write out date, integer + supplied data array @@ -570,7 +569,7 @@ subroutine datewrite_iia (txt,ii,array,txt_pattern) write(*,"(a,3i3,i5,1x, 5i5, 20es11.2)") "dw:" // trim(txt), & current_date%month, current_date%day, current_date%hour, & current_date%seconds, iout, array - endif + end if end subroutine datewrite_iia !------------------------------------------------------------------------- subroutine Self_Test() @@ -616,7 +615,7 @@ subroutine Self_Test() close(IO_IN) print *, "PROCESSOR ", me, "OPENS FILE for TEST READS " call open_file(IO_IN,"r","Self_Test_INPUT.csv",needed=.true.) - endif ! MasterProc + end if ! MasterProc print "(/,a)", "Self-test - Read_Headers ========================" call Read_Headers(IO_IN,msg,NHeaders,NKeyValues, Headers, KeyValues) @@ -632,7 +631,7 @@ subroutine Self_Test() do i = 1, NHeaders print *, "Headers ", i, trim(Headers(i)) end do - endif ! me + end if ! me print "(/,a,/,a,/)", "Self-test - Now read data =========================",& " REMINDER - WAS: mm yy dd v1 v2 #Total #HEADERS" @@ -647,8 +646,8 @@ subroutine Self_Test() test_data(1), test_data(2) else print *, "Read failed. Maybe wrong dimensions?" - endif - enddo + end if + end do end subroutine Self_Test !------------------------------------------------------------------------- end module Io_Progs_ml diff --git a/KeyValueTypes.f90 b/KeyValueTypes.f90 index b5a1773..c44457f 100644 --- a/KeyValueTypes.f90 +++ b/KeyValueTypes.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/LandDefs_ml.f90 b/LandDefs_ml.f90 index 271ad70..9dcc248 100644 --- a/LandDefs_ml.f90 +++ b/LandDefs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -149,44 +149,51 @@ subroutine Growing_season(lu,lat,SGS,EGS) end subroutine Growing_season !======================================================================= - subroutine Init_LandDefs(ncodes, wanted_codes) + subroutine Init_LandDefs(fname,ncodes, wanted_codes) !======================================================================= !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Reads file Inputs_LandDefs.csv and extracts land-defs. Checks that ! codes match the "wanted_codes" which have been set in Inputs-Landuse + character(len=*), intent(in) :: fname ! for LandDefs integer, intent(in) :: ncodes ! Num. land codes found in mapped data character(len=*), dimension(:), intent(in) :: wanted_codes character(len=20), dimension(25) :: Headers character(len=200) :: txtinput ! Big enough to contain one input record type(KeyVal), dimension(2) :: KeyValues ! Info on units, coords, etc. - character(len=50) :: errmsg, fname - character(len=*), parameter :: sub='Ini-LandDefs:' + character(len=50) :: errmsg + character(len=*), parameter :: dtxt='Ini-LandDefs:' integer :: n, nn, NHeaders, NKeys logical :: dbg dbg = ( DEBUG%LANDDEFS .and. MasterProc ) + if ( dbg ) then + do n = 1, size(wanted_codes) + write(*,*) dtxt//' WANTED ', n, wanted_codes(n) + end do + end if + ! Quick safety check (see Landuse_ml for explanation) call CheckStop(& maxval( len_trim(wanted_codes(:))) >= len(LandInput%code),& - sub//" increase size of character array" ) + dtxt//" increase size of character array" ) ! Read data - fname = "Inputs_LandDefs.csv" + !fname = "Inputs_LandDefs.csv" if ( MasterProc ) then - write(*,*) sub//" for Ncodes= ", ncodes + write(*,*) dtxt//" for Ncodes= ", ncodes do n = 1, ncodes - write(*,*) sub//"LC wants ",n, trim(wanted_codes(n)) + write(*,*) dtxt//"LC wants ",n, trim(wanted_codes(n)) end do call open_file(IO_TMP,"r",fname,needed=.true.) - call CheckStop(ios,sub//"open_file error on " // fname ) + call CheckStop(ios,dtxt//"open_file error on " // fname ) end if call Read_Headers(IO_TMP,errmsg,NHeaders,NKeys,Headers,Keyvalues) - call CheckStop( errmsg , sub//"Read Headers" ) + call CheckStop( errmsg , dtxt//"Read Headers" ) !------ Read in file. Lines beginning with "!" are taken as @@ -198,7 +205,7 @@ subroutine Init_LandDefs(ncodes, wanted_codes) if ( ios /= 0 ) then exit ! likely end of file end if - if ( dbg ) write(*,*) sub//' READLINE: ------ '// trim(txtinput) + if ( dbg ) write(*,*) dtxt//' READLINE: ------ '// trim(txtinput) if ( txtinput(1:1) == "#" ) then cycle end if @@ -210,7 +217,7 @@ subroutine Init_LandDefs(ncodes, wanted_codes) call CheckStop ( ios, fname // " txt error:" // trim(txtinput) ) n = find_index( LandInput%code, wanted_codes )!index in map data? if ( n < 1 ) then - if ( MasterProc ) write(*,*) sub//" skipping nn,n ",& + if ( MasterProc ) write(*,*) dtxt//" skipping nn,n ",& nn,n, trim(LandInput%code) cycle end if @@ -227,12 +234,13 @@ subroutine Init_LandDefs(ncodes, wanted_codes) if ( dbg ) then write(*,"(a)") trim(txtinput) - write(unit=*,fmt="(a,3i3,2a,2i5,f7.3,f10.3)") sub//":=> ", & + write(unit=*,fmt="(a,3i3,2a,2i5,f7.3,f10.3)") dtxt//":=> ", & n,nn, ncodes, trim(LandInput%name), trim(LandInput%code),& LandDefs(n)%SGS50,LandDefs(n)%EGS50, & LandDefs(n)%LAImax, LandDefs(n)%Emtp end if - call CheckStop( LandInput%code, wanted_codes(n), sub//"MATCHING CODES") + call CheckStop( LandInput%code, wanted_codes(n), & + dtxt//"MATCHING CODES") LandType(n)%is_water = LandInput%code == "W" LandType(n)%is_ice = LandInput%code == "ICE" @@ -241,7 +249,7 @@ subroutine Init_LandDefs(ncodes, wanted_codes) LandType(n)%flux_wanted = LandType(n)%is_iam ! default !Also: if( find_index( LandInput%code, FLUX_VEGS(:) ) > 0 ) then - if(MasterProc) write(*,*) sub//"FLUX_VEG SET:", trim(LandInput%code) + if(MasterProc) write(*,*) dtxt//"FLUX_VEG SET:", trim(LandInput%code) LandType(n)%flux_wanted = .true. end if @@ -253,9 +261,8 @@ subroutine Init_LandDefs(ncodes, wanted_codes) LandType(n)%pft = find_index( LandDefs(n)%LPJtype, PFT_CODES) - if ( dbg ) write(unit=*,fmt='(a,i3,a,i5)') sub//"PFT? ", n,& - trims(LandInput%name//':'// LandInput%code//':'// & - wanted_codes(n) ), LandType(n)%pft + if ( dbg ) write(unit=*,fmt='(a,i3,a,i5)') dtxt//"PFT? ", n,& + trim( wanted_codes(n) ), LandType(n)%pft !is_decid, is_conif used mainly for BVOC and soil-NO. Not essential ! for IAM-type landcover @@ -266,14 +273,14 @@ subroutine Init_LandDefs(ncodes, wanted_codes) LandType(n)%is_bulk = LandInput%type == "BLK" LandType(n)%is_veg = LandInput%code /= "U" .and. & LandInput%hveg_max > 0.01 ! Excludes water, ice_nwp, desert - if( LandInput%code(1:2) == "GR" ) iLC_grass = n ! for use with clover + if( LandInput%code(1:2) == "GR" ) iLC_grass = n ! for eg clover end do if ( MasterProc ) then close(unit=IO_TMP) - write(*,*) sub//"DONE NN,NCODES = ", nn, ncodes + write(*,*) dtxt//"DONE NN,NCODES = ", nn, ncodes end if - call CheckStop( nn /= ncodes, sub//" didn't find all codes") + call CheckStop( nn /= ncodes, dtxt//" didn't find all codes") end subroutine Init_LandDefs !========================================================================= @@ -287,13 +294,14 @@ function Check_LandCoverPresent_Item( descrip, txt, write_condition) result(ind) ind = 0 else ind = find_index( txt, LandDefs(:)%code ) - !if( DEBUG ) print *, "LC-CHECKING", descrip, txt, ind end if if( ind < 0 .and. write_condition .and. MasterProc ) write(*,*) & descrip // "NOT FOUND!! Skipping : " // txt end function Check_LandCoverPresent_Item !========================================================================= - function Check_LandCoverPresent_Array( descrip, n, txt, write_condition) result(ind) + function Check_LandCoverPresent_Array( descrip, n, txt, & + write_condition) result(ind) + character(len=*),intent(in) :: descrip integer, intent(in) :: n character(len=*),dimension(:),intent(in) :: txt @@ -305,7 +313,6 @@ function Check_LandCoverPresent_Array( descrip, n, txt, write_condition) result( else ind = find_index( txt(n), LandDefs(:)%code ) end if - !if( DEBUG ) print *, "LC-CHECKING", descrip, n, txt(n), ind if( ind < 0 .and. write_condition .and. MasterProc ) write(*,*) & descrip // "NOT FOUND!! Skipping : " // txt(n) end function Check_LandCoverPresent_Array diff --git a/LandPFT_ml.f90 b/LandPFT_ml.f90 index 561a714..ce03c29 100644 --- a/LandPFT_ml.f90 +++ b/LandPFT_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -50,9 +50,6 @@ module LandPFT_ml INCLUDE 'mpif.h' - INTEGER STATUS(MPI_STATUS_SIZE),INFO - - character(len=80), private :: errmsg real, public, allocatable :: pft_lai(:,:,:) real, public, allocatable :: pft_bvoc(:,:,:,:) diff --git a/Landuse_ml.f90 b/Landuse_ml.f90 index 575dfa0..783822f 100644 --- a/Landuse_ml.f90 +++ b/Landuse_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -31,6 +31,7 @@ module Landuse_ml use CheckStop_ml, only: CheckStop,StopAll use DO3SE_ml, only: fPhenology, Init_DO3SE +use emep_Config_mod, only : LandCoverInputs use GridAllocate_ml,only: GridAllocate use GridValues_ml, only: glat , glon & ! latitude, , i_fdom, j_fdom & ! coordinates @@ -44,17 +45,15 @@ module Landuse_ml NLANDUSE_EMEP use LandPFT_ml, only: MapPFT_LAI, pft_lai use ModelConstants_ml,only: DEBUG, NLANDUSEMAX, & - ! PALEO_TEST, & SEA_LIMIT, & USES, emep_debug, & - FLUX_VEGS, nFluxVegs, & + FLUX_VEGS, FLUX_IGNORE, nFluxVegs, & VEG_2dGS, VEG_2dGS_Params, & NPROC, IIFULLDOM, JJFULLDOM, & DomainName, MasterProc use MPI_Groups_ml, only : MPI_INTEGER,MPI_COMM_CALC, IERROR use Par_ml, only: LIMAX, LJMAX, & limax, ljmax, me -!use Paleo_ml, only: SetPaleo use SmallUtils_ml, only: wordsplit, find_index, NOT_FOUND, WriteArray, trims use TimeDate_ml, only: effectivdaynumber, nydays, current_date @@ -76,10 +75,9 @@ module Landuse_ml integer, public, parameter :: NLUMAX = 30 ! max no. landuse per grid integer, private, save :: NLand_codes = 0 ! no. landuse in input files -! The LC: entries in the netcdf landuse, or the -! the headers read from Inputs.Landuse define the "master-list" of -! codes for landuse. Each code must be present in the subsequent -! data files for phenology and DO3SE. +! The LC: entries in the netcdf landuse, or the headers read from +! Inputs.Landuse define the "master-list" of codes for landuse. Each code must +! be present in the subsequent data files for phenology and DO3SE. character(len=20), dimension(NLANDUSEMAX), & public, save :: Land_codes = " " ! As used @@ -116,9 +114,8 @@ module Landuse_ml real,public,save, allocatable,dimension(:,:) :: water_fraction, ice_landcover logical,public,save :: water_frac_set = .false. - character(len=80), private :: errmsg + character(len=200), private :: errmsg -! integer ::ierror,mpi_comm_calc, mpi_integer contains !========================================================================== @@ -126,14 +123,14 @@ subroutine InitLanduse(daynumber) integer, intent(in) :: daynumber logical :: filefound integer ::i,j,ilu,lu, ipar - logical :: debug_flag = .false. + logical :: dbgij ! Some config options, for veg with 2-D growing seasons ! needs map2d.. as real for ReadCDF integer :: n2dGS, n2dGSpars, i2dGS real,dimension(:,:,:),allocatable :: map2dGrowingSeasons character(len=len(VEG_2dGS_Params(1))) :: fname character(len=20) :: varname - character(len=*), parameter :: sub='InitLanduse:' + character(len=*), parameter :: dtxt='InitLanduse:' !===================================== !ALLOCATE ARRAYS @@ -148,17 +145,18 @@ subroutine InitLanduse(daynumber) if(len_trim(FLUX_VEGS(ilu))>0) nFluxVegs=nFluxVegs+1 end do - if(MasterProc) write(*,*) sub//" nFluxVegs= ",nFluxVegs + if(MasterProc) write(*,*) dtxt//" nFluxVegs= ",nFluxVegs - !ReadLandUse_CDF to be used as default when glc2000 data is improved? filefound=.false. call ReadLandUse(filefound) !=> Land_codes, Percentage cover per grid - !ReadLandUse_CDF use Max Posch 5km landuse over emep area and glc200 where this dat is not defined. + ! ReadLandUse_CDF use Max Posch 5km landuse over emep area and glc200 where + ! this data is not defined. + if(.not.filefound) then - if(MasterProc) write(*,*) sub//" Into CDF " - call ReadLandUse_CDF(filefound) !=> Land_codes, Percentage cover per grid + if(MasterProc) write(*,*) dtxt//" Into CDF " + call ReadLandUse_CDF(filefound) !=> Land_codes, % cover per grid end if @@ -172,10 +170,13 @@ subroutine InitLanduse(daynumber) call CheckStop(.not.filefound,"InitLanduse failed!") if(MasterProc) then - print *, sub//" Into Init_LandDefs ", NLand_codes - print *, sub//" Codes: ", Land_codes + write(*,*) dtxt//" Into Init_LandDefs ", NLand_codes + write(*,*) dtxt//" Codes: ", Land_codes + write(*,*) dtxt//" LandCoverInputs: ", LandCoverInputs end if - call Init_LandDefs(NLand_codes, Land_codes) ! => LandType, LandDefs + + call Init_LandDefs(LandCoverInputs%LandDefs,NLand_codes, Land_codes) + ! => LandType, LandDefs !------ 2D maps of growing season, if set in config ----------------------- @@ -199,10 +200,10 @@ subroutine InitLanduse(daynumber) i2dGS = i2dGS + 1 - call ReadField_CDF(fname,varname, map2dGrowingSeasons(1,1,i2dGS),1, & - interpol='zero_order',needed=.true.,debug_flag=.false.) ! UnDef?? + call ReadField_CDF(fname,varname, map2dGrowingSeasons(1,1,i2dGS),& + 1,interpol='zero_order',needed=.true.,debug_flag=.false.) - if( debug_proc ) write(*,"(a20,5i5)") '2dGS '//trim(varname), ilu,& + if( debug_proc ) write(*,"(a20,5i5)") '2dGS '//trim(varname),ilu,& debug_li,debug_lj, i2dGS, & nint( map2dGrowingSeasons(debug_li,debug_lj,i2dGS) ) @@ -227,7 +228,7 @@ subroutine InitLanduse(daynumber) do i = 1, limax do j = 1, ljmax - debug_flag = ( debug_proc .and. i == debug_li .and. j == debug_lj ) + dbgij = ( debug_proc .and. i == debug_li .and. j == debug_lj ) do ilu= 1, LandCover(i,j)%ncodes lu = LandCover(i,j)%codes(ilu) call CheckStop( lu < 0 .or. lu > NLANDUSEMAX , & @@ -251,11 +252,11 @@ subroutine InitLanduse(daynumber) LandCover(i,j)%SGS(ilu) = nint( map2dGrowingSeasons(i,j,4) ) LandCover(i,j)%ANTH(ilu) = nint( map2dGrowingSeasons(i,j,5) ) LandCover(i,j)%EGS(ilu) = nint( map2dGrowingSeasons(i,j,6) ) -!FUSK! +!TODO - find better solution!! LandCover(i,j)%SGS(ilu) = LandCover(i,j)%EGS(ilu) - 90 end if - if ( DEBUG%LANDUSE>0 .and. debug_flag ) & + if ( DEBUG%LANDUSE>0 .and. dbgij ) & write(*,"(a,i3,a20,3i4)")"LANDUSE: LU_SETGS", & lu, LandDefs(lu)%name,& LandCover(i,j)%SGS(ilu),LandCover(i,j)%ANTH(ilu), & @@ -291,7 +292,7 @@ subroutine InitLanduse(daynumber) if(water_fraction(i,j)>SEA_LIMIT(1).and. & water_fraction(i,j) < 0.999 ) likely_coastal(i,j) = .true. - if ( DEBUG%LANDUSE>0 .and. debug_flag ) then + if ( DEBUG%LANDUSE>0 .and. dbgij ) then write(*,"(a,2i4,f7.3,2L2)") "SEACOAST ", i_fdom(i), j_fdom(j), & water_fraction(i,j), mainly_sea(i,j), likely_coastal(i,j) end if @@ -309,8 +310,9 @@ subroutine ReadLanduse(filefound) character(len=20), dimension(NLANDUSEMAX+10) :: Headers type(KeyVal), dimension(10) :: KeyValues ! Info on units, coords, etc. character(len=50) :: fname + character(len=*), parameter :: dtxt="ReadLanduse:" integer :: NHeaders, NKeys, Nlines - logical :: debug_flag + logical :: dbgij real :: sumfrac ! Specify the assumed coords and units - Read2DN will check that the data @@ -326,7 +328,7 @@ subroutine ReadLanduse(filefound) integer, dimension(LIMAX,LJMAX,NLUMAX):: landuse_codes ! tmp, with all data if ( DEBUG%LANDUSE>0 .and. MasterProc ) & - write(*,*) "LANDUSE: Starting ReadLandUse " + write(*,*) dtxt//"LANDUSE: Starting ReadLandUse " maxlufound = 0 Nlines = 0 @@ -351,13 +353,13 @@ subroutine ReadLanduse(filefound) call Read_Headers(IO_TMP,errmsg,NHeaders,NKeys,& Headers,Keyvalues,CheckValues) - call CheckStop( errmsg , "Read Headers" // fname ) + call CheckStop( errmsg , dtxt//"Read Headers" // fname ) ! The first two columns are assumed for now to be ix,iy, hence: NHeaders = NHeaders -2 call CheckStop( NHeaders /= NLANDUSE_EMEP, & - "Inputs.Landuse not consistent with NLANDUSE_EMEP") + dtxt//"Inputs.Landuse not consistent with NLANDUSE_EMEP") NLand_codes=NHeaders @@ -365,8 +367,11 @@ subroutine ReadLanduse(filefound) do i = 1, NLand_codes Land_codes(i) = trim ( Headers(i+2) ) end do - if(MasterProc)write(*,*)NLand_codes,' landuse categories defined from Inputs.Landuse:' - if(MasterProc)write(*,fmt="(20(A,1x))")(trim(Land_codes(i)),i=1,NLand_codes) + if(MasterProc)then + write(*,*)NLand_codes,dtxt//& + ' landuse categories defined from Inputs.Landuse:' + write(*,fmt="(20(A,1x))")(trim(Land_codes(i)),i=1,NLand_codes) + end if ! Then data: @@ -385,13 +390,13 @@ subroutine ReadLanduse(filefound) if(MasterProc)Write(*,*)'Inputs.Landuse not found' return call StopAll('Inputs.Landuse not found') - endif + end if ! call printCDF('LU', landuse_in(:,:,1),'??') do i = 1, limax do j = 1, ljmax - debug_flag = ( debug_proc .and. i == debug_li .and. j == debug_lj ) + dbgij = ( debug_proc .and. i == debug_li .and. j == debug_lj ) do lu = 1, NLand_codes if ( landuse_in(i,j,lu) > 0.0 ) then @@ -401,7 +406,7 @@ subroutine ReadLanduse(filefound) landuse_data(i,j,index_lu) = & landuse_data(i,j,index_lu) + 0.01 * landuse_in(i,j,lu) end if - if ( DEBUG%LANDUSE>0 .and. debug_flag ) & + if ( DEBUG%LANDUSE>0 .and. dbgij ) & write(*,"(a15,i3,f8.4,a10,i3,f8.4)") "DEBUG Landuse ",& lu, landuse_in(i,j,lu), & "index_lu ", index_lu, landuse_data(i,j,index_lu) @@ -429,194 +434,293 @@ subroutine ReadLanduse(filefound) end subroutine ReadLanduse subroutine ReadLanduse_CDF(filefound) - !Read data in other grid and interpolate to present grid - ! - !So far only basic version for use in TNO7. Under construction + ! Read data in other grid and interpolate to present grid ! - implicit none logical :: filefound - integer :: i,j,lu, ilu, index_lu, maxlufound, iam, iveg - logical :: debug_flag + integer :: i,j,lu, ilu, index_lu, maxlufound, iam, ifile, nFiles real :: sumfrac + integer, save :: ncalls=0 - character(len=40) :: varname - character(len=200) :: fname1,fname2 + character(len=40) :: varname, fShort + character(len=200) :: fName, msg integer :: ncFileID, nDimensions,nVariables,nAttributes,timeDimID,varid - integer :: nwords, err, xtype,ndims ,status - character(len=10) :: ewords(7), code ! LC:CF:EMEP - character(len=*), parameter :: sub='RdLanduseCDF:' + integer :: nwords, err, xtype,ndims, status + character(len=20) :: ewords(7) ! LC:CF:EMEP logical :: fexist=.false.!file exist flag - ! temporary arrays used. Will re-write one day.... real, dimension(LIMAX,LJMAX,NLANDUSEMAX):: landuse_in ! tmp, with all data + real, dimension(LIMAX,LJMAX,NLANDUSEMAX):: landuse_glob ! CLM crude + real, dimension(LIMAX,LJMAX):: landuse_tot ! CLM real, dimension(LIMAX,LJMAX):: landuse_tmp ! tmp, with all data + real :: dbgsum, sum_veg + real, dimension(LIMAX,LJMAX,NLUMAX):: landuse_data ! tmp, with all data integer, dimension(LIMAX,LJMAX):: landuse_ncodes ! tmp, with all data integer, dimension(LIMAX,LJMAX,NLUMAX):: landuse_codes ! tmp, with all data - logical, save :: debug_Master=.false. - - if( DEBUG%LANDUSE>0 .and. MasterProc ) then - write(*,*) sub//" Starting" - debug_Master = .true. + integer, dimension(size(FLUX_VEGS)):: iam_index = -1 ! + logical, dimension(NLANDUSEMAX) :: is_veg + character(len=*), parameter :: dtxt='RdLanduseCDF:' + logical, save :: mydbg=.false. ! will set for debug_li, debug_lj + logical :: dbgij + + nFiles = size(LandCoverInputs%MapFile(:) ) + + if( MasterProc ) then + ncalls = ncalls + 1 + write(*,*) dtxt//" Starting", nFiles, ncalls + do ifile = 1, nFiles + write(*,*) 'MapFile ', trim(LandCoverInputs%MapFile(ifile)) + end do end if - - - if (MasterProc ) write(*,*) sub//"LANDUSE_CDF:" - ! filefound=.false. - ! return + if( DEBUG%LANDUSE>0 .and. debug_proc ) mydbg = .true. maxlufound = 0 landuse_ncodes(:,:) = 0 !*** initialise *** landuse_codes(:,:,:) = 0 !*** initialise *** landuse_data (:,:,:) = 0.0 !*** initialise *** - landuse_in = 0.0 !*** initialise *** + landuse_in = 0.0 !*** initialise *** + landuse_glob = 0.0 !*** initialise *** !Landusefile where landcodes are not predefined, but read from the file. - fName1='Landuse_PS_5km_LC.nc' - fName2='LanduseGLC.nc' - !1)check that file exists - !note that every processor open and read the same file - status=nf90_open(path = trim(fName1), mode = nf90_nowrite, ncid = ncFileID) - inquire(file=trim(fName2),exist=fexist) - if ( debug_Master .and. fexist)write(*,*) sub//"LANDUSE: found "//trim(fName2) - if(status==nf90_noerr)then - if ( debug_Master )write(*,*) sub//"LANDUSE: found "//trim(fName1) - !get list of variables - call check(nf90_Inquire(ncFileID,nDimensions,nVariables,nAttributes,timeDimID)) - ! All the inquire functions are inexpensive to use and require no I/O, since the information - ! they provide is stored in memory when a netCDF dataset is first opened. - - !loop over all variables in file - ilu=0 - do varid=1,nVariables + ! Typilaclly, we will read a fine-scale map for the inner area (e.g. + ! 'Landuse_PS_5km_LC.nc') and then a global map to make sure the + ! full domain is covered, e.g. 'glc2000mCLM.nc' + + !1)check that file exists + ! (note that every processor opens/reads the same file) + + ilu=0 + + FILELOOP: do ifile = 1, nFiles ! size(LandCoverInputs%MapFile(:)) + fName = LandCoverInputs%MapFile(ifile) + + call wordsplit(fName,30,ewords,nwords,err,separator="/") + fshort= '.../' // ewords(nwords) ! e.g. '.../Landuse_PS_5km.nc' + status=nf90_open(path = trim(fName), mode = nf90_nowrite, ncid = ncFileID) + inquire(file=trim(fName),exist=fexist) + + if ( MasterProc .and. fexist) then + write(*,'(a,i2,1x,a)') dtxt//"LANDUSE: found ", ifile, trim(fShort) + end if + + call CheckStop (status /= nf90_noerr, & ! AUG31 + dtxt//"LANDUSE: NOT found "//trim(fName) ) ! AUG31 + + !get list of variables + call check(nf90_Inquire(ncFileID,nDimensions,nVariables,nAttributes,& + timeDimID)) + ! All the inquire functions are inexpensive to use and require no I/O, + ! since the information they provide is stored in memory when a netCDF + ! dataset is first opened. + + VARIDLOOP1: do varid=1,nVariables ! all variables in file + if ( DEBUG%LANDUSE>0 ) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) call check(nf90_Inquire_Variable(ncFileID,varid,varname,xtype,ndims)) - if ( debug_Master )write(*,*) sub//"checking "//trim(varname), index( varname, "LC:") + msg = dtxt//"checking "//trim(fShort)//': '// & + trim(varname) !!! , index( varname, "LC:") ! landcover terms look like, e.g. LC:CF:EMEP - if( index( varname, "LC:") < 1 ) cycle ! ONLY LC: (LandCode) wanted + if( index( varname, "LC:") < 1 ) then + if ( mydbg ) write(*,*) trim(msg)//": Skipped, not LC" + cycle ! ONLY LC: (LandCode) wanted + end if call wordsplit(varname,3,ewords,nwords,err,separator=":") - if( ewords(3) /= "EMEP" ) cycle ! ONLY EMEP coded for now + if ( mydbg ) write(*,*) trim(msg)//": Used from ", & + trim(varname), ' ', ewords(3) + if( ewords(3) /= "EMEP" .and. ewords(3) /= "CLM" ) & + cycle ! ONLY EMEP and CLM coded for now !========================= - if( ewords(2) == "IAM_VEG" .and. nFluxVegs < 1 ) exit ! No IAM veg to process + !! Old. No need for IAM here now (will remove). See ADD_IAM below + if( ewords(2)=="IAM_VEG" ) cycle !========================= - ilu=ilu+1 - if ( debug_Master )& - write(*,*) "defining new LC "//ewords(2)//" ilu= " , ilu - call CheckStop( ilu>NLANDUSEMAX , & - sub//"NLANDUSEMAX smaller than number of landuses defined in file "//trim(fname1) ) + !CHECK HERE to see if we already have this landcode:... + lu = find_index( ewords(2), Land_codes(:) ) + call CheckStop( ilu>NLANDUSEMAX , dtxt//& + "NLANDUSEMAX smaller than number of landuses defined in file "//& + trim(fname) ) + if ( lu > 0 ) then + if ( mydbg ) write(*,*) dtxt//"Already have"//ewords(2), lu + else + ilu = ilu + 1 + lu = ilu + if ( mydbg ) write(*,*) dtxt//"Adding code"//ewords(2), ilu + Land_codes(ilu) = ewords(2) ! Landuse code found on file + end if - Land_codes(ilu) = ewords(2) ! Landuse code found on file + if(debug_proc) write(*,'(a,i3,1x,2f8.2,a)') dtxt//'IFILE', ifile,& + glat(debug_li,debug_lj), glon(debug_li,debug_lj),trim(varname) - call ReadField_CDF(trim(fName1),varname,& - landuse_in(1,1,ilu),1,interpol='conservative', & + call ReadField_CDF(trim(fName),varname,& + landuse_tmp,1,interpol='conservative', & needed=.true.,debug_flag=.false.,UnDef=-9.9E19) - if(fexist .and. any(landuse_in(1:limax,1:ljmax,ilu)<-0.1))then - !complete missing data with data from second file - !name in second file may be defined differently - varname=Land_codes(ilu) !name such as CF (without LC: etc.) - - ! ---- TMP. Will sort out GLC file another day - if( Land_codes(ilu) == "IAM_VEG" ) varname = "IAM_DF" ! good enough - ! ------ - - call ReadField_CDF(trim(fName2),varname,& - landuse_tmp,1,interpol='conservative', & - needed=.true.,debug_flag=.false.) - do j = 1, ljmax - do i = 1, limax - if(landuse_in(i,j,ilu)<-0.1)landuse_in(i,j,ilu)=landuse_tmp(i,j) - end do !j - end do !i - endif - - ! Some "IAM" veg species can be defined for calculations of ozone - ! fluxes. These are assigned very small land-area, using the mask - ! which the IAM_VEG species gives. - ! We divive the area by the nFluxVegs to keep the total area small - - if ( Land_codes(ilu) == "IAM_VEG" ) then - - iveg = ilu - forall ( i=1:limax,j=1:ljmax) - landuse_in(i,j,ilu) = landuse_in(i,j,ilu) / real(nFluxVegs) - end forall - - IAM_VEG: do iam = 1, size( FLUX_VEGS ) - if ( len_trim( FLUX_VEGS(iam) ) < 1 ) then - - if(MasterProc) write(*,*)"Landuse SKIPS IAM ", iam - cycle IAM_VEG - end if - - ilu = iveg-1 + iam ! first iam overwrites IAM_VEG name - if(MasterProc) write(*,*)"Landuse EXTRA IAM ",& - iam, ilu, FLUX_VEGS(iam) - - Land_codes(ilu) = FLUX_VEGS(iam) - forall ( i=1:limax,j=1:ljmax) - landuse_in(i,j,ilu) = landuse_in(i,j,iveg) - end forall - end do IAM_VEG + if ( ifile == 1 ) then + landuse_in(:,:,lu) = landuse_tmp + landuse_tot(:,:) = landuse_tot(:,:) + landuse_tmp + else + landuse_glob(:,:,lu) = landuse_tmp ! will merge below + end if + + if ( debug_proc ) then + print "(a,2i4,4es12.3,1x,a)", "F1 ", ifile,lu, & + landuse_tmp(debug_li,debug_lj), & + landuse_tot(debug_li,debug_lj), maxval(landuse_tmp(:,:)), & + landuse_glob(debug_li,debug_lj,lu), & + trim(ewords(2)) end if - if(MasterProc) write(*,*)"LandDefs DONE ", ilu, Land_codes(ilu) - enddo - call check(nf90_close(ncFileID))!fname1 - NLand_codes=ilu - if(MasterProc) then - write( *,*) "Number of landuse codes ", NLand_codes - write( *,*) "LAND_CODES: ", Land_codes(1:NLand_codes) - end if + end do VARIDLOOP1 + call check(nf90_close(ncFileID))!fname1 + end do FILELOOP ! DSLC + + NLand_codes=ilu !DSCLM now here + + + ! MERGE inner and outer maps (Euro and Glob usually) + !AUG31 if ( EuroFileFound .and. GlobFileFound ) then ! we need to merge + + if ( nFiles > 1 ) then ! we need to merge + if ( debug_proc ) print '(a,i3,f12.4,5i6)', "F3 START", & + NLand_codes, landuse_tot(debug_li,debug_lj), me, & + limax, ljmax, debug_li, debug_lj + do j = 1, ljmax + do i = 1, limax + !landuse_tmp can be numerically larger than 1.0 (1E-15 larger). + dbgij = ( mydbg .and. i==debug_li.and.j==debug_lj ) + + if(landuse_tot(i,j)< 0.99999 ) then + landuse_in(i,j,:)= 0.0 ! Will overwrite all PS stuff + dbgsum = 0.0 + + do ilu = 1, NLand_codes + landuse_in(i,j,ilu) = min(1.0, landuse_glob(i,j,ilu) ) + dbgsum = dbgsum + landuse_in(i,j,ilu) + if ( dbgij ) then + write(*, "(a,i3,3es15.6,1x,a)") "F4 ", ilu, & + landuse_in(debug_li,debug_lj,ilu), & + landuse_tot(debug_li,debug_lj), dbgsum,& + trim(Land_Codes(ilu)) + end if + end do - else - !the landusefile with softcoded lancodes has not been found. Use "old" method - if ( debug_Master )write(*,*) "LANDUSE: LC: not found "//trim(fName1) - call CheckStop("Landuse: No landcover files") + end if ! land_tot<0.9999 + end do !j + end do !i + end if ! Euro, Glob - endif !switch hardcoded/fileread lu definitions + if(MasterProc) then + write(*,*)"LandDefs DONE ", ilu, Land_codes(ilu), & + maxval( landuse_in ), minval(landuse_in) + write( *,*) "CDFLAND_CODES: ", NLand_codes, " :" + write( *,'((5a20))') Land_codes(1:NLand_codes) + end if + is_veg(:) = .false. + do lu = 1, NLand_codes + if (find_index( Land_codes(lu), FLUX_IGNORE(:) ) < 1 ) then + if ( mydbg ) write(*,*) dtxt//'Some veg:'//trim(Land_codes(lu)), lu + is_veg(lu) = .true. + end if + end do + + !!!!!!!!!!!! ADD IAM_VEG + ! Some "IAM" veg species can be defined for calculations of ozone fluxes. + ! These are assigned very small land-area, using the mask which the IAM_VEG + ! species gives. We divide the area by the nFluxVegs to keep the total area + ! small. + + ! Append flux vegs to Land_codes + do iam = 1, nFluxVegs + NLand_codes = NLand_codes + 1 + Land_codes(NLand_codes) = FLUX_vegs(iam) + iam_index(iam) = NLand_codes + if ( mydbg ) write(*,*) dtxt//'IAM veg:'//trim(FLUX_VEGS(iam)), & + iam, iam_index(iam) + end do + + do i = 1, limax + do j = 1, ljmax + dbgij = ( mydbg .and. i==debug_li.and.j==debug_lj ) + sum_veg = 0.0 + do lu = 1, NLand_codes + if ( is_veg(lu) .and. landuse_in(i,j,lu) > 0.0 ) then + sum_veg = sum_veg + landuse_in(i,j,lu) + end if + if ( dbgij ) write(*,'(a,4i5,a13,L2,es12.3)') dtxt//'IAM add?', & + me,ncalls,i,j, trim(Land_codes(lu)), is_veg(lu), sum_veg + end do + if ( sum_veg < 1.0e-6 ) CYCLE + + if ( dbgij ) write(*,*) dtxt//'IAM nnn:', nFluxVegs + IAM_VEG: do iam = 1, nFluxVegs ! size( FLUX_VEGS ) + !if ( len_trim( FLUX_VEGS(iam) ) < 1 ) then + ! if(MasterProc) write(*,*)"Landuse SKIPS IAM ", iam + ! cycle IAM_VEG + !end if + + lu = iam_index(iam) + landuse_in(i,j,lu) = 1.0e-3/real(nFluxVegs) ! Add + if ( dbgij ) write(*,*) dtxt//'IAM add:', me, lu, trim(Land_codes(lu)) + end do IAM_VEG + end do !j + end do !i + + + !!!!!!!!!!!! Now, convert to more compact arrays for export do i = 1, limax do j = 1, ljmax + dbgij = ( mydbg .and. i==debug_li.and.j==debug_lj ) do lu = 1, NLand_codes + if ( dbgij ) then + write(*,*) dtxt//'preGridAll', lu,NLand_codes, landuse_in(i,j,lu) + end if if ( landuse_in(i,j,lu) > 0.0 ) then call GridAllocate("LANDUSE",i,j,lu,NLUMAX, & index_lu, maxlufound, landuse_codes, landuse_ncodes) landuse_data(i,j,index_lu) = & landuse_data(i,j,index_lu) + landuse_in(i,j,lu)!already in fraction unit - endif + if ( dbgij ) then + write(*,*) dtxt//'GridAll', lu, index_lu,& + landuse_data(i,j,index_lu), landuse_in(i,j,lu) + end if + end if end do ! lu LandCover(i,j)%ncodes = landuse_ncodes(i,j) LandCover(i,j)%codes(:) = landuse_codes(i,j,:) LandCover(i,j)%fraction(:) = landuse_data(i,j,:) sumfrac = sum( LandCover(i,j)%fraction(:) ) - - if ( sumfrac < 0.99 .or. sumfrac > 1.01 ) then - write(unit=errmsg,fmt="(a19,3i4,f12.4,8i4)") & - "Land SumFrac Error ", me, & + if ( sumfrac < 0.99 .or. sumfrac > 1.01 ) then + write(unit=errmsg,fmt="(a34,5i4,f12.4,6i4,2f7.2)") & !nb len(dtxt)=13 + dtxt//" SumFrac Error ", me,i,j, & i_fdom(i),j_fdom(j), sumfrac, limax, ljmax, & - i_fdom(1), j_fdom(1), i_fdom(limax), j_fdom(ljmax) + i_fdom(1), j_fdom(1), i_fdom(limax), j_fdom(ljmax), & + glat(i,j), glon(i,j) + print *, trim(errmsg) + if(abs(sumfrac-1.0)<0.2.and.abs(glat(i,j))>89.0)then - write(*,*)'WARNING: ',errmsg,sumfrac,glat(i,j) + write(*,*)'WARNING: ',trim(errmsg),sumfrac,glat(i,j) else - write(*,*)'latitude: ',errmsg,glat(i,j) + write(*,*)'lat/lon: ',trim(errmsg),glat(i,j), glon(i,j) call CheckStop(errmsg) - endif - end if + end if + end if end do !j end do !i filefound=.true. - if (DEBUG%LANDUSE>0) write(6,*) "Landuse_ml: me, maxlufound, cdf = ", & - me, maxlufound + if ( DEBUG%LANDUSE>0 ) then + CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) + write(6,'(a,3i5)') dtxt//" me, maxlufound, ncalls, cdf = ", & + me, maxlufound, ncalls + end if end subroutine ReadLanduse_CDF @@ -627,13 +731,13 @@ subroutine SetLandUse(daynumber, month) integer, save :: old_month = -1 integer, save :: old_daynumber = -1 logical, save :: my_first_call = .true. - logical, save :: init_needed=.true. ! since my_first_call had some confusions.. - logical :: debug_flag = .false., debug_sgs real :: hveg, lat_factor real :: xSAIadd integer :: pft logical, save :: debugProc = .false. - character (len=*), parameter :: sub='SetLandUse:' + logical :: dbgij, debug_sgs + character (len=*), parameter :: dtxt='SetLandUse:' + character (len=60) :: dnam !mainly for debug ! Treatment of growing seasons in the southern hemisphere: ! all the static definitions (SGS,EGS...) refer to northern hemisphere, @@ -655,195 +759,188 @@ subroutine SetLandUse(daynumber, month) ! The DO3SE params are needed for the call to fPhenology - call Init_DO3SE(IO_DO3SE,"Inputs_DO3SE.csv",NLand_codes, Land_codes, errmsg) + call Init_DO3SE(IO_DO3SE, LandCoverInputs%Do3seDefs, & + NLand_codes, Land_codes, errmsg) call CheckStop(errmsg, "Reading DO3SE ") end if ! my_first_call !====================================================================== if ( daynumber == old_daynumber ) then - my_first_call = .false. ! PW + my_first_call = .false. return end if old_daynumber = daynumber - if(MasterProc) write(*,*) "LANDUSE: SetLandUse, day ", daynumber - if(debugProc ) write(*,"(a,5i5,L2)") "LANDUSE: debug me i j pft? ", me, & + if(MasterProc) write(*,*) dtxt//" day, pfts? ", daynumber, USES%PFT_MAPS + if(debugProc ) write(*,"(a,5i5,L2)") dtxt//" debug me i j pft? ", me, & debug_li, debug_lj, limax, ljmax, USES%PFT_MAPS !Landcover data can be set either from simplified LPJ !PFTs, or from the "older" DO3SE inputs file - if ( USES%PFT_MAPS ) then !- Check for LPJ-derived data - - if (MasterProc) print *, "New PFTMAPS ", month, old_month + if ( USES%PFT_MAPS ) then !- Check for LPJ-derived data - + if (MasterProc) write(*,*) dtxt//"New PFTMAPS ", month, old_month if ( month /= old_month ) then call MapPFT_LAI( month ) end if - end if + end if !PALEO LANDUSE ! if( PALEO_TEST ) then ! call SetPaleo(daynumber, month) ! end if + do i = 1, limax + do j = 1, ljmax + debug_sgs = ( DEBUG%LANDUSE > 1 .and. & + current_date%hour == 0 .and. & + glat(i,j) < 1.0 .and. glat(i,j) > -1.0 .and. & + glon(i,j) > -72.0 .and. glon(i,j) < -70.0 ) - do i = 1, limax - do j = 1, ljmax - debug_sgs = ( DEBUG%LANDUSE > 1 .and. & - current_date%hour == 0 .and. & - glat(i,j) < 1.0 .and. glat(i,j) > -1.0 .and. & - glon(i,j) > -72.0 .and. glon(i,j) < -70.0 ) + effectivdaynumber=daynumber + ! effectiv daynumber to shift 6 months when in southern hemisphere + if(glat(i,j)<0.0)effectivdaynumber=mod(daynumber+182,nydays)+1 + dbgij = ( debugProc .and. i == debug_li .and. j == debug_lj ) - effectivdaynumber=daynumber - ! effectiv daynumber to shift 6 months when in southern hemisphere - if(glat(i,j)<0.0)effectivdaynumber=mod(daynumber+182,nydays)+1 - - debug_flag = ( debugProc .and. i == debug_li .and. j == debug_lj ) - if ( debug_flag ) then - write(*,"(a12,i3,9i6)") "LANDUSE debug DATE ", & - LandCover(i,j)%ncodes, daynumber, current_date - end if + if ( dbgij ) then + write(*,"(a,i3,9i6)") dtxt//" debug DATE ", & + LandCover(i,j)%ncodes, daynumber, current_date + end if - do ilu= 1, LandCover(i,j)%ncodes - lu = LandCover(i,j)%codes(ilu) - pft = LandType(lu)%pft + do ilu= 1, LandCover(i,j)%ncodes + lu = LandCover(i,j)%codes(ilu) + pft = LandType(lu)%pft + dnam = dtxt//trim(LandDefs(lu)%name) - if ( debug_flag ) print *, sub//"debug_flag lu pft", lu, pft,& - LandDefs(lu)%name, LandType(lu)%is_bulk + if ( dbgij ) write(*, *) trim(dnam)//" lu pft", lu, pft,& + LandType(lu)%is_bulk, LandType(lu)%is_forest - if ( LandType(lu)%is_bulk ) then - LandCover(i,j)%LAI(ilu) = 0.0 - LandCover(i,j)%SAI(ilu) = 0.0 - cycle - endif!else Growing veg present: + if ( LandType(lu)%is_bulk ) then + LandCover(i,j)%LAI(ilu) = 0.0 + LandCover(i,j)%SAI(ilu) = 0.0 + cycle + end if!else Growing veg present: - if ( LandDefs(lu)%name == "MED_OAK" .or. & + if ( LandDefs(lu)%name == "MED_OAK" .or. & LandDefs(lu)%name == "MED_PINE" ) then - LandCover(i,j)%LAI(ilu) = MedLAI(effectivdaynumber, & - 100, 166, & ! Hard-code from Mapping Manual - LandDefs(lu)%LAImin, LandDefs(lu)%LAImax ) - if ( debug_flag ) then - write(*,"(a,3i4,3f8.3)") "MED_TREE "//& - trim(LandDefs(lu)%name), effectivdaynumber,& - LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu), & - LandDefs(lu)%LAImin, LandDefs(lu)%LAImax, & - LandCover(i,j)%LAI(ilu) - end if + LandCover(i,j)%LAI(ilu) = MedLAI(effectivdaynumber, & + 100, 166, & ! Hard-code from Mapping Manual + LandDefs(lu)%LAImin, LandDefs(lu)%LAImax ) + if ( dbgij ) then + write(*,"(a,3i4,3f8.3)") "MED_TREE "//& + trim(LandDefs(lu)%name), effectivdaynumber,& + LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu), & + LandDefs(lu)%LAImin, LandDefs(lu)%LAImax, & + LandCover(i,j)%LAI(ilu) + end if - else - LandCover(i,j)%LAI(ilu) = Polygon(effectivdaynumber, & - 0.0, LandDefs(lu)%LAImin, LandDefs(lu)%LAImax,& - LandCover(i,j)%SGS(ilu), LandDefs(lu)%SLAIlen, & - LandCover(i,j)%EGS(ilu), LandDefs(lu)%ELAIlen) - end if + else + LandCover(i,j)%LAI(ilu) = Polygon(effectivdaynumber, & + 0.0, LandDefs(lu)%LAImin, LandDefs(lu)%LAImax,& + LandCover(i,j)%SGS(ilu), LandDefs(lu)%SLAIlen, & + LandCover(i,j)%EGS(ilu), LandDefs(lu)%ELAIlen) + end if - LandCover(i,j)%fphen(ilu) = fPhenology( lu & - ,effectivdaynumber & - ,LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu)& - ,debug_flag ) + LandCover(i,j)%fphen(ilu) = fPhenology( lu ,effectivdaynumber & + ,LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu) ,dbgij ) - if ( debug_flag ) then - !if (debug_sgs ) then - write(*,"(a,3i4,5f8.3)")"LANDUSE CHECK_VEG "//& - trim(LandDefs(lu)%name), effectivdaynumber, & - LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu), & - LandDefs(lu)%LAImin, LandDefs(lu)%LAImax,& - LandCover(i,j)%LAI(ilu), LandCover(i,j)%fphen(ilu) - end if + if ( dbgij ) then + write(*,"(a,3i4,5f8.3)")trim(dnam)//" CHECK_VEG ",& + effectivdaynumber, & + LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu), & + LandDefs(lu)%LAImin, LandDefs(lu)%LAImax,& + LandCover(i,j)%LAI(ilu), LandCover(i,j)%fphen(ilu) + write(*,"(a,L3)")trim(dnam)//' CHECK_PFT', USES%PFT_MAPS + end if + if ( USES%PFT_MAPS ) then + if ( DEBUG%PFT_MAPS > 0 .and. dbgij ) then + if ( pft > 0 ) then + write(*,"(a,i4,i6,2f8.3)") trim(dnam)//" PFTS COMP? ", & + daynumber, pft, LandCover(i,j)%LAI(ilu), & + pft_lai(i,j, pft)*LandDefs(lu)%LAImax + else + write(*,"(2a,i4,i6,2f8.3)") trim(dnam)//" PFTS COMP? ", & + daynumber, pft, LandCover(i,j)%LAI(ilu), -1.0 + end if + end if - if ( USES%PFT_MAPS ) then - if ( DEBUG%PFT_MAPS.gt.0 .and. debug_flag ) then - if ( pft > 0 ) then - write(*,"(2a,i4,i6,2f8.3)") "LANDUSE PFTS COMP? ", & - LandDefs(lu)%name, daynumber, pft,& - LandCover(i,j)%LAI(ilu), pft_lai(i,j, pft)*LandDefs(lu)%LAImax - else - write(*,"(2a,i4,i6,2f8.3)") "LANDUSE PFTS COMP? ", & - LandDefs(lu)%name, daynumber, pft,& - LandCover(i,j)%LAI(ilu), -1.0 - end if - end if - if ( pft > 0 ) then !PFT OVERWRITE! - LandCover(i,j)%LAI(ilu)= pft_lai(i,j, pft)*LandDefs(lu)%LAImax + if ( pft > 0 ) then !PFT OVERWRITE! + LandCover(i,j)%LAI(ilu)= pft_lai(i,j, pft)*LandDefs(lu)%LAImax + if(dbgij) write(*,"(a,2i4,5f8.3)")dtxt//' CHECK_LAI', lu, pft, & + pft_lai(i,j, pft),LandDefs(lu)%LAImax LandCover(i,j)%fphen(ilu)= 1.0 ! Skip fphen if using PFT LandCover(i,j)%SGS(ilu)= -999 ! Marker, since not used LandCover(i,j)%EGS(ilu)= -999 ! Marker, since not used - end if - if (debug_sgs )write(*,*) "ESGS in PFTMAPS" + end if + if (debug_sgs )write(*,*) "ESGS in PFTMAPS" end if - hveg = LandDefs(lu)%hveg_max ! defaults - xSAIadd = 0.0 - - if ( LandType(lu)%is_crop ) then + hveg = LandDefs(lu)%hveg_max ! defaults + xSAIadd = 0.0 - !DS2014 if ( LandType(lu)%is_iam ) then ! IAM wheat - !DS2014 if ( effectivdaynumber >= LandCover(i,j)%SGS(ilu) .and. & - !DS2014 effectivdaynumber <= LandCover(i,j)%EGS(ilu) ) then - !DS2014 WheatGrowingSeason(i,j) = 1 - !DS2014 else - !DS2014 WheatGrowingSeason(i,j) = 0 - !DS2014 end if - !DS2014 end if + if ( LandType(lu)%is_crop ) then - ! Note that IAM crops have SLAIlen=0, so are immediately - ! given LAI=3.5, SAI=5. + ! Note that IAM crops have SLAIlen=0, so are immediately + ! given LAI=3.5, SAI=5. - if ( effectivdaynumber < LandCover(i,j)%SGS(ilu) .or. & - effectivdaynumber > LandCover(i,j)%EGS(ilu) ) then - hveg = STUBBLE - xSAIadd = 0.0 - else if ( effectivdaynumber < & + if ( effectivdaynumber < LandCover(i,j)%SGS(ilu) .or. & + effectivdaynumber > LandCover(i,j)%EGS(ilu) ) then + hveg = STUBBLE + xSAIadd = 0.0 + else if ( effectivdaynumber < & (LandCover(i,j)%SGS(ilu) + LandDefs(lu)%SLAIlen) ) then - hveg= LandDefs(lu)%hveg_max * & - LandCover(i,j)%LAI(ilu) / LandDefs(lu)%LAImax - xSAIadd = ( 5.0/3.5 - 1.0) * LandCover(i,j)%LAI(ilu) - else if ( effectivdaynumber < LandCover(i,j)%EGS(ilu) ) then - hveg = LandDefs(lu)%hveg_max ! not needed? - xSAIadd = 1.5 ! Sensescent - end if - LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) + xSAIadd - - ! end if ! crops - + hveg= LandDefs(lu)%hveg_max * & + LandCover(i,j)%LAI(ilu) / LandDefs(lu)%LAImax + xSAIadd = ( 5.0/3.5 - 1.0) * LandCover(i,j)%LAI(ilu) + else if ( effectivdaynumber < LandCover(i,j)%EGS(ilu) ) then + hveg = LandDefs(lu)%hveg_max ! not needed? + xSAIadd = 1.5 ! Sensescent + end if + LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) + xSAIadd ! Just used reduced LAI for high latitudes for now, because of tests ! which suggest that the big-leaf model as coded will overestimate ! Gsto if we allow higher LAI in central Europe. - else if( LandType(lu)%is_forest ) then - if ( glat(i,j) >= 60.0 ) then - lat_factor = max(0.3, ( 1.0 - 0.05* (glat(i,j)-60.0)) ) - hveg = hveg * lat_factor - LandCover(i,j)%LAI(ilu) = LandCover(i,j)%LAI(ilu) * lat_factor - end if - LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) + 1.0 - else - LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) !defaults - end if + else if( LandType(lu)%is_forest ) then + if ( glat(i,j) >= 60.0 ) then + lat_factor = max(0.3, ( 1.0 - 0.05* (glat(i,j)-60.0)) ) + hveg = hveg * lat_factor + LandCover(i,j)%LAI(ilu) = LandCover(i,j)%LAI(ilu) * lat_factor + end if + LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) + 1.0 + else if( LandType(lu)%is_seminat ) then !A2017 SNL + if ( glat(i,j) >= 60.0 ) then + lat_factor = max(0.3, ( 1.0 - 0.05* (glat(i,j)-60.0)) ) + hveg = hveg * lat_factor + LandCover(i,j)%LAI(ilu) = LandCover(i,j)%LAI(ilu) * lat_factor + end if + LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) + 0.5 ! A2017SNL + else + LandCover(i,j)%SAI(ilu) = LandCover(i,j)%LAI(ilu) !defaults + end if - LandCover(i,j)%hveg(ilu) = hveg + LandCover(i,j)%hveg(ilu) = hveg -if( debug_sgs ) then - write(*, "(a20,i4,2f7.1,3i5,f8.2)") "ESGS:"//trim(LandDefs(lu)%name),& - lu, glat(i,j), glon(i,j), & - daynumber, effectivdaynumber, Landcover(i,j)%SGS(ilu), Landcover(i,j)%LAI(ilu) -!end if -! if (debug_sgs ) then - write(*,"(a,3i4,5f8.3)")"CHECK_VEGB"//trim(LandDefs(lu)%name),& + if( debug_sgs .or. dbgij ) then + write(*, "(a20,i4,2f7.1,3i5,f8.2)") trim(dnam)//":ESGS:",& + lu, glat(i,j), glon(i,j), daynumber, effectivdaynumber, & + Landcover(i,j)%SGS(ilu), Landcover(i,j)%LAI(ilu) + write(*,"(a,3i4,5f8.3)")trim(dnam)//"CHECK_VEGB:",& effectivdaynumber, & LandCover(i,j)%SGS(ilu), LandCover(i,j)%EGS(ilu), & LandDefs(lu)%LAImin, LandDefs(lu)%LAImax,& LandCover(i,j)%LAI(ilu), LandCover(i,j)%fphen(ilu) -end if ! debug_sgs + end if ! debug_sgs end do ! lu end do ! j end do ! i diff --git a/LocalVariables_ml.f90 b/LocalVariables_ml.f90 index 0dcfe35..d45b9ec 100644 --- a/LocalVariables_ml.f90 +++ b/LocalVariables_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -32,7 +32,7 @@ module LocalVariables_ml ! e.g. for a measurement site or for a specific landuse within a grid square ! ----------------------------------------------------------------------- -use Wesely_ml, only: NDRYDEP_CALC +use GasParticleCoeffs_ml, only: NDRYDEP_CALC implicit none private diff --git a/MARS_Aero_water_ml.f90 b/MARS_Aero_water_ml.f90 index e1841f8..ad7576d 100644 --- a/MARS_Aero_water_ml.f90 +++ b/MARS_Aero_water_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/MARS_ml.f90 b/MARS_ml.f90 index eecaa43..b49321b 100644 --- a/MARS_ml.f90 +++ b/MARS_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -636,7 +636,7 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & else DO_RATIO_Low_2=.true. High_Factor=0.0 - endif + end if IF ( RATIO >RATIO_Low .and. RATIO < RATIO_High .and. MARS_RATIO_SMOOTH)then DO_RATIO_High_2=.true. @@ -645,7 +645,7 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & TSO4_LowA=TSO4*Ratio/RATIO_Low ! High_Factor=(RATIO-RATIO_Low)/(RATIO_High-RATIO_Low) High_Factor=(RATIO*RATIO_High-RATIO_Low*RATIO_High)/(RATIO*RATIO_High-RATIO*RATIO_Low) - endif + end if !.................................... !......... High Ammonia Case ........ @@ -876,7 +876,7 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & MNH4 = 1.e-30 MAS = 1.e-30 MAN = 1.e-30 - endif + end if !...MAS, MAN and MNH4 are the aqueous concentrations of sulfate, nitrate, !... and ammonium in molal units (moles/(kg water) ). @@ -1103,7 +1103,7 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & !http://wiki.seas.harvard.edu/geos-chem/index.php?title=Aerosol_thermodynamical_equilibrium&redirect=no#RPMARES if ( ( abs( GAMANA ) < FLOOR ) .or. ( abs( GAMAS1 ) < FLOOR ) ) THEN goto 1601 - endif + end if GAMAHAT = ( GAMAS2 * GAMAS2 / ( GAMAAB * GAMAAB ) ) BHAT = KHAT * GAMAHAT !!! EROR = ABS ( ( PHIOLD - PHIBAR ) / PHIOLD ) @@ -1455,7 +1455,7 @@ subroutine actcof ( CAT, AN, GAMA, MOLNU, PHIMULT , ERRMARK, IA2, debug_flag) WRITE(6,*) 'GAMA=', GAMA WRITE(6,*) 'MOLNU=',MOLNU WRITE(6,*) 'PHIMULT=',PHIMULT - endif + end if !! CALL M3EXIT( PNAME, 0, 0, XMSG, XSTAT2 ) !emep1.2 call stop_test(.true.,me,NPROC,ios,'##MARS-negat.con') END IF @@ -3428,7 +3428,7 @@ subroutine rpmares_2900 ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & else DO_RATIO_Low_2=.true. High_Factor=0.0 - endif + end if IF ( RATIO >RATIO_Low .and. RATIO < RATIO_High .and. MARS_RATIO_SMOOTH)then DO_RATIO_High_2=.true. @@ -3437,7 +3437,7 @@ subroutine rpmares_2900 ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & TSO4_LowA=TSO4*Ratio/RATIO_Low ! High_Factor=(RATIO-RATIO_Low)/(RATIO_High-RATIO_Low) High_Factor=(RATIO*RATIO_High-RATIO_Low*RATIO_High)/(RATIO*RATIO_High-RATIO*RATIO_Low) - endif + end if !.................................... !......... High Ammonia Case ........ @@ -3668,7 +3668,7 @@ subroutine rpmares_2900 ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & MNH4 = 1.e-30 MAS = 1.e-30 MAN = 1.e-30 - endif + end if !...MAS, MAN and MNH4 are the aqueous concentrations of sulfate, nitrate, !... and ammonium in molal units (moles/(kg water) ). diff --git a/MPI_Groups_ml.f90 b/MPI_Groups_ml.f90 index 16f3db6..8c83bf5 100644 --- a/MPI_Groups_ml.f90 +++ b/MPI_Groups_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,6 +39,7 @@ module MPI_Groups_ml integer, public :: request_ps_w, request_ps_e, request_xn_w, request_xn_e integer, public :: request_ps_s, request_ps_n, request_xn_s, request_xn_n integer, public :: request_s, request_n, request_w, request_e +integer, public :: irequest_s(100), irequest_n(100), irequest_w(100), irequest_e(100) integer, public :: IERROR !dummy @@ -66,13 +67,13 @@ subroutine MPI_world_init(NPROC,ME) MPI_COMM_SUB=MPI_COMM_WORLD if(ME==0)write(*,"(A,I5,A)")' Found ',NPROC,' MPI processes available' -endsubroutine MPI_world_init +end subroutine MPI_world_init subroutine share(shared_data,data_shape,xsize,MPI_COMM_SHARED) !share the array shared_data USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_F_POINTER!fortran 2003 extensions implicit none - TYPE(C_PTR) :: baseptr!,baseptr2 + TYPE(C_PTR) :: basespecs!,baseptr2 ! TYPE(MPI_Win) :: win ! TYPE(MPI_Comm), intent(in) :: MPI_COMM_SHARED integer :: win @@ -94,7 +95,7 @@ subroutine share(shared_data,data_shape,xsize,MPI_COMM_SHARED) data_size=1 do i=1,size(data_shape) data_size=data_size*data_shape(i) - enddo + end do if(data_size/=XSIZE)& write(*,*)'WARNING: incompatible dimensions in MPI_groups_ml ',& data_size,XSIZE,data_shape @@ -104,8 +105,8 @@ subroutine share(shared_data,data_shape,xsize,MPI_COMM_SHARED) ! CALL MPI_WIN_ALLOCATE_SHARED(MPI_XSIZE, DISP_UNIT, MPI_INFO_NULL, MPI_COMM_SHARED, BASEPTR2, WIN,IERROR) call MPI_Win_fence(0, win, ierror) -! CALL MPI_Win_shared_query(win, 0, MPI_xsize, disp_unit, baseptr,IERROR) - CALL C_F_POINTER(baseptr, shared_data, data_shape) +! CALL MPI_Win_shared_query(win, 0, MPI_xsize, disp_unit, basespecs,IERROR) + CALL C_F_POINTER(basespecs, shared_data, data_shape) call MPI_Win_fence(0, win, ierror) !test if it works @@ -123,20 +124,20 @@ subroutine share(shared_data,data_shape,xsize,MPI_COMM_SHARED) shared_data(2,1,1)=22. case default shared_data(3,1,1)=me_mpi - endselect + end select CALL MPI_BARRIER(MPI_COMM_SHARED, IERROR) call MPI_Win_fence(0, win, ierror) ! write(*,"(A,5i7,12F11.2)")'data in share ',ME_MPI,me_calc,me_io,me_sub,& ! me_shared,shared_data(1:3,1,1),1.0*mpi_xsize!,shared_data(1:2,2,1) ! if(me_io>=0)write(*,*)' COMM',MPI_COMM_SHARED,MPI_COMM_WORLD -endsubroutine share +end subroutine share subroutine share_logical(shared_data,data_shape,xsize,MPI_COMM_SHARED) !share the array shared_data USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_F_POINTER!fortran 2003 extensions implicit none - TYPE(C_PTR) :: baseptr + TYPE(C_PTR) :: basespecs ! TYPE(MPI_Win) :: win ! TYPE(MPI_Comm), intent(in) :: MPI_COMM_SHARED integer :: win @@ -158,15 +159,15 @@ subroutine share_logical(shared_data,data_shape,xsize,MPI_COMM_SHARED) data_size=1 do i=1,size(data_shape) data_size=data_size*data_shape(i) - enddo + end do if(data_size/=XSIZE)& write(*,*)'WARNING: incompatible dimensions in MPI_groups_ml ',& data_size,XSIZE,data_shape ! CALL MPI_WIN_ALLOCATE_SHARED(MPI_XSIZE, DISP_UNIT, MPI_INFO_NULL, MPI_COMM_SHARED, BASEPTR, WIN, IERROR) call MPI_Win_fence(0, win, ierror) -! CALL MPI_Win_shared_query(win, 0, MPI_xsize, disp_unit, baseptr, IERROR) - CALL C_F_POINTER(baseptr, shared_data) +! CALL MPI_Win_shared_query(win, 0, MPI_xsize, disp_unit, basespecs, IERROR) + CALL C_F_POINTER(basespecs, shared_data) call MPI_Win_fence(0, win, ierror) !test if it works @@ -176,5 +177,5 @@ subroutine share_logical(shared_data,data_shape,xsize,MPI_COMM_SHARED) if(me_io==0.and.me_sub==0)shared_data=.false. call MPI_Win_fence(0, win, ierror) ! write(*,*)'logical data in share ',ME_MPI,me_shared,shared_data -endsubroutine share_logical +end subroutine share_logical endmodule MPI_Groups_ml diff --git a/Makefile.SRCS b/Makefile.SRCS index 9615a2a..a6c4380 100644 --- a/Makefile.SRCS +++ b/Makefile.SRCS @@ -1,28 +1,38 @@ #============================================================================= FOBJ ?= \ - AeroFunctions.o Aero_Vds_ml.o Ammonium_ml.o AOD_PM_ml.o Advection_ml.o AirEmis_ml.o AllocInit.o \ + AeroFunctions.o Aero_Vds_ml.o Ammonium_ml.o AOD_PM_ml.o \ + Advection_ml.o AirEmis_ml.o AllocInit.o \ AOTnPOD_ml.o Aqueous_n_WetDep_ml.o BLPhysics_ml.o Biogenics_ml.o \ - BoundaryConditions_ml.o CellMet_ml.o CheckStop_ml.o Chem_ml.o CoDep_ml.o Country_ml.o \ + BoundaryConditions_ml.o CellMet_ml.o CheckStop_ml.o ChemFields_ml.o \ + ChemSpecs_wrapper.o CoDep_ml.o Country_ml.o \ ChemFunctions_ml.o CM_ChemRates_ml.o Convection_ml.o ColumnSource_ml.o \ - CM_ChemGroups_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_tmp.o \ - DefPhotolysis_ml.o Derived_ml.o DerivedFields_ml.o DO3SE_ml.o DryDep_ml.o DustProd_ml.o \ - EcoSystem_ml.o EmisDef_ml.o EmisGet_ml.o Emissions_ml.o ExternalBICs_ml.o \ + CM_ChemGroups_ml.o CM_ChemSpecs_ml.o \ + DefPhotolysis_ml.o Derived_ml.o DerivedFields_ml.o DO3SE_ml.o \ + DryDep_ml.o DustProd_ml.o \ + EcoSystem_ml.o emep_Config_mod.o \ + EmisDef_ml.o EmisGet_ml.o Emissions_ml.o ExternalBICs_ml.o \ FastJ_ml.o ForestFire_ml.o Functions_ml.o \ - GridAllocate_ml.o GridValues_ml.o \ + GasParticleCoeffs_ml.o \ + Gravset_ml.o GridAllocate_ml.o GridValues_ml.o \ InterpolationRoutines_ml.o \ Io_ml.o Io_Nums_ml.o Io_Progs_ml.o KeyValueTypes.o LandDefs_ml.o Landuse_ml.o \ LandPFT_ml.o LocalVariables_ml.o MARS_ml.o MARS_Aero_water_ml.o \ MassBudget_ml.o Met_ml.o MetFields_ml.o EQSAM_ml.o MicroMet_ml.o \ - ModelConstants_ml.o MosaicOutputs_ml.o MPI_Groups_ml.o AerosolCalls.o My_Derived_ml.o \ - SOA_ml.o My_Outputs_ml.o NetCDF_ml.o \ - Nest_ml.o NumberConstants.o \ - Output_hourly.o OutputChem_ml.o OwnDataTypes_ml.o Par_ml.o \ + ModelConstants_ml.o MosaicOutputs_ml.o MPI_Groups_ml.o AerosolCalls.o \ + My_Derived_ml.o My_Outputs_ml.o NetCDF_ml.o Nest_ml.o NumberConstants.o \ + Output_hourly.o OutputChem_ml.o OwnDataTypes_ml.o Par_ml.o \ PhysicalConstants_ml.o PlumeRise_ml.o PointSource_ml.o \ Precision_ml.o Radiation_ml.o Rb_ml.o \ ReadField_ml.o Rsurface_ml.o Runchem_ml.o Setup_1d_ml.o \ - Setup_1dfields_ml.o Sites_ml.o SmallUtils_ml.o SoilWater_ml.o Solver.o \ - SeaSalt_ml.o StoFlux_ml.o \ - SubMet_ml.o Tabulations_ml.o TimeDate_ml.o TimeDate_ExtraUtil_ml.o Timefactors_ml.o Timing_ml.o \ - Trajectory_ml.o Units_ml.o Unimod.o Wesely_ml.o \ - isocom.o ISOFWD.o isorev.o \ - global2local.o PhyChem_ml.o My_3DVar_ml.o My_Pollen_ml.o My_ESX_ml.o + Setup_1dfields_ml.o Sites_ml.o SmallUtils_ml.o SOA_ml.o \ + SoilWater_ml.o Solver.o SeaSalt_ml.o StoFlux_ml.o \ + SubMet_ml.o Tabulations_ml.o TimeDate_ml.o TimeDate_ExtraUtil_ml.o \ + Timefactors_ml.o Timing_ml.o \ + Trajectory_ml.o uEMEP_ml.o Units_ml.o Unimod.o \ + YieldModifications_mod.o \ + global2local.o PhyChem_ml.o My_3DVar_ml.o My_Pollen_ml.o + + +# default target +all: + diff --git a/MassBudget_ml.f90 b/MassBudget_ml.f90 index 1b561f4..b4a23f9 100644 --- a/MassBudget_ml.f90 +++ b/MassBudget_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -32,8 +32,7 @@ module MassBudget_ml use CheckStop_ml, only: CheckStop use ChemSpecs, only: NSPEC_ADV, NSPEC_SHL, species_adv use Chemfields_ml, only: xn_adv ! advected species -use EmisDef_ml, only: DMS_natso2_month, DMS_natso2_year& - ,O_NH3, O_DMS +use EmisDef_ml, only: O_NH3, O_DMS use GridValues_ml, only: xmd, & gridwidth_m,dA,dB,debug_proc,debug_li,debug_lj use Io_ml, only: IO_LOG, PrintLog, datewrite @@ -44,18 +43,19 @@ module MassBudget_ml PT, & ! Pressure at top USE_OCEAN_NH3,USE_OCEAN_DMS,FOUND_OCEAN_DMS,& DEBUG_MASS,EXTENDEDMASSBUDGET -use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER, MPI_LOGICAL, & - MPI_MIN, MPI_MAX, MPI_SUM, MPI_IN_PLACE, & - MPI_COMM_CALC, MPI_COMM_WORLD, MPISTATUS, IERROR, ME_MPI, NPROC_MPI +! do not use "only", because MPI_IN_PLACE does not behave well on certain +! versions of gfortran(?), and MPI stuff clearly inidcated anyway +use MPI_Groups_ml ! , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, & + ! MPI_INTEGER, MPI_LOGICAL, & + ! MPI_MIN, MPI_MAX, MPI_SUM, MPI_IN_PLACE, & + ! MPI_COMM_CALC, MPI_COMM_WORLD, MPISTATUS,& + ! IERROR, ME_MPI, NPROC_MPI use Par_ml, only: & - li0,li1,& ! First/Last local index in longitude when outer boundary is excluded - lj0,lj1 ! First/Last local index in latitude when outer boundary is excluded + li0,li1,& ! First/Last local index in long. when outer boundary is excluded + lj0,lj1 ! First/Last local index in lat. when outer boundary is excluded use PhysicalConstants_ml,only: GRAV,ATWAIR! Mol. weight of air(Jones,1992) use Setup_1dfields_ml, only: amk, rcemis ! Air concentrations , emissions use SmallUtils_ml, only: find_index -!use mpi, only: MPI_COMM_CALC, MPI_IN_PLACE,& -! MPI_DOUBLE_PRECISION, MPI_SUM, MPI_MIN, MPI_MAX -! openMPI has no explicit interface for MPI_ALLREDUCE implicit none private @@ -93,9 +93,7 @@ subroutine Init_massbudget() ! within 3-D grid, after boundary conditions ! !---------------------------------------------------------------------- - integer i, j, k, n, info ! lon,lat,lev indexes - ! n - No. of species - ! info - printing info + integer i, j, k, n ! lon,lat,lev indexes, n - No. of species real rwork,fac,wgt_fac fac = GRIDWIDTH_M*GRIDWIDTH_M/GRAV @@ -104,9 +102,9 @@ subroutine Init_massbudget() do i=li0,li1 rwork = fac*(dA(k)+dB(k)*ps(i,j,1))* xmd(i,j) sumini(:) = sumini(:) + xn_adv(:,i,j,k)*rwork ! sumini in kg - enddo - enddo - enddo + end do + end do + end do CALL MPI_ALLREDUCE(MPI_IN_PLACE, sumini , NSPEC_ADV, & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) @@ -117,10 +115,10 @@ subroutine Init_massbudget() wgt_fac=species_adv(n)%molwt/ATWAIR write(IO_LOG,"(a15,i4,4x,e10.3)") "Initial mass",n,sumini(n)*wgt_fac write(*,"(a15,i4,4x,e10.3)") "Initial mass",n,sumini(n)*wgt_fac - enddo - endif + end do + end if - endsubroutine Init_massbudget + end subroutine Init_massbudget !---------------------------------------------------------------------------- !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx subroutine emis_massbudget_1d(i,j) @@ -139,23 +137,21 @@ subroutine emis_massbudget_1d(i,j) do k = KCHEMTOP,KMAX_MID scaling_k = scaling * (dA(k) + dB(k)*ps(i,j,1))/amk(k) if(all((/DEBUG_MASS,debug_proc,i==debug_li,j==debug_lj/)))& - call datewrite("MASSRC ",k,(/dB(k)*ps(i,j,1),xmd(i,j),ps(i,j,1),scaling_k/)) + call datewrite("MASSRC ",k,(/dB(k)*ps(i,j,1),xmd(i,j),& + ps(i,j,1),scaling_k/)) do iadv = 1, NSPEC_ADV itot = iadv + NSPEC_SHL totem(iadv) = totem(iadv) + rcemis( itot, k ) * scaling_k - enddo - enddo ! k loop + end do + end do ! k loop -endsubroutine emis_massbudget_1d +end subroutine emis_massbudget_1d !---------------------------------------------------------------------------- subroutine massbudget() ! sums over all sulphur and nitrogen, so is model independant. - integer :: i, j, k, n, nn, info ! lon,lat,lev indexes - ! n - No. of species - ! nn - Total no. of short lived and advected species - ! info - printing info + integer :: i, j, k, n ! lon,lat,lev indexes, n - No. of species integer :: ix_o3, ifam ! family index integer :: iomb ! for MassBugetSummary.txt Table real, dimension(NSPEC_ADV,KMAX_MID) :: sumk ! total mass in each layer @@ -178,7 +174,7 @@ subroutine massbudget() real, dimension(NSPEC_ADV) :: & xmax, xmin, & ! min and max value for the individual species sum_mass, & ! total mass of species - frac_mass, & ! mass budget fraction (should=1) for groups of species + frac_mass, & ! mass budget frac. (should=1) for groups of species gfluxin,gfluxout, & ! flux in and out gtotem, & ! total emission gtotddep, gtotwdep, & ! total dry and wet deposition @@ -211,9 +207,9 @@ subroutine massbudget() if(all((/DEBUG_MASS,debug_proc,i==debug_li,j==debug_lj/)))& call datewrite("MASSBUD",k,(/(dA(k)*dB(k)*ps(i,j,1))*xmd(i,j)/& GRAV*GRIDWIDTH_M*GRIDWIDTH_M,ps(i,j,1),PT,xmd(i,j)/)) - enddo - enddo - enddo + end do + end do + end do CALL MPI_ALLREDUCE(MPI_IN_PLACE, xmax, NSPEC_ADV,& MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_CALC, IERROR) @@ -249,7 +245,7 @@ subroutine massbudget() amin(:) = min( amin(:), xmin(:) ) do k = 2,KMAX_MID sum_mass(:) = sum_mass(:)+sumk(:,k) - enddo + end do !O3 flux are also printed out @@ -264,34 +260,35 @@ subroutine massbudget() 33 FORMAT(5(A,es10.3)) write(*,*)'Ozone fluxes (kg):' write(*,33)'Net from top = ', fluxin_top(ix_o3)-fluxout_top(ix_o3),& - ' in from top = ',fluxin_top(ix_o3),' out of top = ',fluxout_top(ix_o3) + ' in from top = ',fluxin_top(ix_o3),' out of top = ',fluxout_top(ix_o3) write(*,33)'Net lateral faces = ', fluxin(ix_o3)-fluxout(ix_o3),& - ' in lateral faces = ' ,fluxin(ix_o3), & - ' out lateral faces = ', fluxout (ix_o3) - write(*,33)'O3 in atmosphere at start of run = ', sumini(ix_o3)*o3_fac,& - ' at end of run = ', sum_mass(ix_o3)*o3_fac + ' in lateral faces = ' ,fluxin(ix_o3), & + ' out lateral faces = ', fluxout (ix_o3) + write(*,33)'O3 in atmosphere at start of run = ', & + sumini(ix_o3)*o3_fac, ' at end of run = ', sum_mass(ix_o3)*o3_fac write(*,33)'O3 dry deposited = ',& gtotddep(ix_o3)*species_adv(ix_o3)%molwt else write(*,*)'O3 index not found' - endif - endif + end if + end if do n = 1,NSPEC_ADV totdiv = sumini(n) + gtotem(n) + gfluxin(n) frac_mass(n) = sum_mass(n) + (gtotddep(n)+gtotwdep(n))*ATWAIR + gfluxout(n) if(totdiv>0.0) frac_mass(n) = frac_mass(n)/totdiv - enddo + end do if(MasterProc) then ! printout from node 0 if(EXTENDEDMASSBUDGET)then do n=1,NSPEC_ADV - wgt_fac=species_adv(n)%molwt/ATWAIR - if(gtotem(n)>0.0) write(*,*)'tot. emission of '//trim(species_adv(n)%name)//' ',gtotem(n)*wgt_fac - enddo - endif + wgt_fac=species_adv(n)%molwt/ATWAIR + if(gtotem(n)>0.0) write(*,*)'tot. emission of '//& + trim(species_adv(n)%name)//' ',gtotem(n)*wgt_fac + end do + end if call PrintLog('++++++++++++++++++++++++++++++++++++++++++++++++') do ifam = 1, 3 @@ -301,7 +298,7 @@ subroutine massbudget() case(1);natoms = real(species_adv(:)%sulphurs) case(2);natoms = real(species_adv(:)%nitrogens) case(3);natoms = real(species_adv(:)%carbons) - endselect + end select family_init(ifam) = dot_product(sumini(:) ,natoms(:)) family_mass(ifam) = dot_product(sum_mass(:),natoms(:)) @@ -311,12 +308,12 @@ subroutine massbudget() family_wdep(ifam) = dot_product(gtotwdep(:),natoms(:)) family_em(ifam) = dot_product(gtotem(:) ,natoms(:)) -!convert into kg + !convert into kg select case(ifam) case(1);wgt_fac=32/ATWAIR!sulphurs case(2);wgt_fac=14/ATWAIR!nitrogens case(3);wgt_fac=12/ATWAIR!carbons - endselect + end select family_init(ifam)=family_init(ifam)*wgt_fac family_inflow(ifam)=family_inflow(ifam)*wgt_fac family_em(ifam)=family_em(ifam)*wgt_fac @@ -338,7 +335,8 @@ subroutine massbudget() call PrintLog('++++++++++++++++++++++++++++++++++++++++++++++++') - write(logtxt,"(a9,5a12)")" ","sumini","summas","fluxout","fluxin","fracmass" + write(logtxt,"(a9,5a12)")" ","sumini","summas","fluxout","fluxin",& + "fracmass" call PrintLog(logtxt) write(logtxt,"(a9,5es12.4)") family_name(ifam), & @@ -352,8 +350,8 @@ subroutine massbudget() family_ddep(ifam), family_wdep(ifam), family_em(ifam) call PrintLog(logtxt) call PrintLog('++++++++++++++++++++++++++++++++++++++++++++++++') - enddo ! ifam = 1,3 - endif + end do ! ifam = 1,3 + end if if(MasterProc) then ! printout from node 0 @@ -368,11 +366,11 @@ subroutine massbudget() n,species_adv(n)%name, k,sumk(n,k)*wgt_fac write(* ,"(' Spec ',i3,2x,a12,5x,'k= ',i2,5x,es12.5)")& n,species_adv(n)%name, k,sumk(n,k)*wgt_fac - enddo - enddo + end do + end do end if ! EXTENDED - !2016 NEW: SUMMARY TABLE: + ! SUMMARY TABLE: open(newunit=iomb,file="MassBudgetSummary.txt") write(iomb,'(a)') ' # Mass Budget. Units are kg with MW used here. ADJUST! if needed' write(iomb,'(a3,1x,a14,a7,99a12)') '#n', 'Spec ', & @@ -390,7 +388,8 @@ subroutine massbudget() write(*,"(a3,6a12)")" n ", "Spec", & "sumini", "summas", "fluxout", "fluxin", "fracmass" write(*,"(i3,1x,a11,5es12.4)") n,species_adv(n)%name, & - sumini(n)*wgt_fac, sum_mass(n)*wgt_fac, gfluxout(n)*wgt_fac, gfluxin(n)*wgt_fac, frac_mass(n) + sumini(n)*wgt_fac, sum_mass(n)*wgt_fac, gfluxout(n)*wgt_fac, & + gfluxin(n)*wgt_fac, frac_mass(n) write(*,*) write(*,"(a3,6a12)") "n ", "species", "totddep", "totwdep", "totem" write(*,"(i3,1x,a11,5es12.4)") n, species_adv(n)%name, & @@ -406,12 +405,11 @@ subroutine massbudget() gtotwdep(n)*wgt_fac*ATWAIR, sumini(n)*wgt_fac, sum_mass(n)*wgt_fac,& gfluxout(n)*wgt_fac, gfluxin(n)*wgt_fac, frac_mass(n) - enddo + end do close(iomb) - endif ! MasterProc + end if ! MasterProc if(FOUND_OCEAN_DMS)then - !DMS emissions ! update dms budgets CALL MPI_ALLREDUCE(MPI_IN_PLACE, O_DMS%sum_month, 1,& MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) @@ -421,27 +419,20 @@ subroutine massbudget() if(MasterProc)then write(*,59)'SO2 from ocean DMS cdf file last month ',O_DMS%sum_month - write(*,59)'SO2 from natso2.dat last month',DMS_natso2_month - DMS_natso2_year=DMS_natso2_year+DMS_natso2_month - DMS_natso2_month=0.0 O_DMS%sum_year=O_DMS%sum_year+O_DMS%sum_month O_DMS%sum_month=0.0 59 format(A,6F14.5) - write(*,*)'DMS OCEAN emissions ' write(*,59)'SO2 from ocean DMS cdf file ',O_DMS%sum_year - write(*,59)'SO2 from natso2.dat ',DMS_natso2_year -! write(*,59)'fraction new/old method',O_DMS%sum_year/DMS_natso2_year - endif - endif + end if + end if if(MasterProc)then if(USE_OCEAN_NH3)then - write(*,*)'NH3 OCEAN emissions ' write(*,59)'NH3 emisions from ocean cdf file (Gg)',O_NH3%sum_year - endif - endif -endsubroutine massbudget + end if + end if +end subroutine massbudget !-------------------------------------------------------------------------- end module MassBudget_ml !-------------------------------------------------------------------------- diff --git a/MetFields_ml.f90 b/MetFields_ml.f90 index 7f347a2..6566368 100644 --- a/MetFields_ml.f90 +++ b/MetFields_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -30,7 +30,7 @@ module MetFields_ml use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER, MPI_LOGICAL, & MPI_COMM_CALC, MPI_COMM_WORLD, MPI_COMM_SUB, MPISTATUS, & IERROR, ME_MPI, NPROC_MPI, largeLIMAX,largeLJMAX, share, share_logical - + use Par_ml , only : me implicit none private @@ -209,7 +209,13 @@ module MetFields_ml ,Idiffuse & ! diffuse solar radiation (W/m^2) ,Idirect ! total direct solar radiation (W/m^2) - + integer, parameter ::Nspecial2d = 0 + real,target, public,allocatable, dimension(:,:,:), save:: & + special2d + integer, parameter ::Nspecial3d = 0 + real,target, public,allocatable, dimension(:,:,:,:), save:: & + special3d + integer, public, save :: ix_special2d(Nspecial2d),ix_special3d(Nspecial3d) real,target,public, save,allocatable, dimension(:,:) :: & !st-dust clay_frac & ! clay fraction (%) in the soil @@ -283,11 +289,11 @@ module MetFields_ml real, pointer, dimension(:,:,:)::field_shared logical, pointer :: ready ! The field must be present in the external meteo file logical, pointer :: copied ! The field must be present in the external meteo file - endtype metfield + end type metfield logical, public,save, target::ready=.false.,copied=.false. integer, public, parameter :: NmetfieldsMax=100 !maxnumber of metfields - type(metfield), public :: met(NmetfieldsMax) !To put the metfirelds that need systematic treatment + type(metfield), public :: met(NmetfieldsMax) !To put the metfields that need systematic treatment type(metfield), public :: derivmet(20) !DSA15 To put the metfields derived from NWP, eg for output logical, target :: metfieldfound(NmetfieldsMax)=.false. !default for met(ix)%found integer, public, save :: Nmetfields! number of fields defined in met @@ -315,13 +321,13 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) implicit none integer, intent(in) ::LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET - integer ::ix,i,j,data_shape(3),xsize + integer ::ix,i,j,n,data_shape(3),xsize do ix=1,NmetfieldsMax met(ix)%found => metfieldfound(ix)!default target if(.not. associated(met(ix)%ready))met(ix)%ready=>ready if(.not. associated(met(ix)%copied))met(ix)%copied=>copied - enddo + end do ix=1 met(ix)%name = 'u_wind' @@ -354,7 +360,7 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) ix_v_xmi=ix ix=ix+1 - met(ix)%name = 'specific_humidity' + met(ix)%name = 'specific_humidity' ! kg/kg met(ix)%dim = 3 met(ix)%frequency = 3 met(ix)%time_interpolate = .true. @@ -913,6 +919,51 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) met(ix)%msize = NMET ix_vn=ix +!can be used to output any 2d field, using 'MET2D' + do n = 1, Nspecial2d + ix=ix+1 + write(met(ix)%name,fmt='(A,I0)')'special2d',n + met(ix)%dim = 2 + met(ix)%frequency = 3 + met(ix)%time_interpolate = .false. + met(ix)%read_meteo = .false. + met(ix)%needed = .false. + met(ix)%found = .false. + if(n==1)then + allocate(special2d(LIMAX,LJMAX,Nspecial2d)) + special2d=0.0 + endif +! met(ix)%field(1:LIMAX,1:LJMAX,1:1,1:1) => special2d(1:LIMAX,1:LJMAX,n) +!Since the syntax above is not allowed, we move the adress of the pointer, instead of the target + met(ix)%field(1:LIMAX,1:LJMAX,1-(n-1):1-(n-1),1:1) => special2d + met(ix)%zsize = 1 + met(ix)%msize = 1 + ix_special2d(n)=ix + enddo + +!can be used to output any 2d field, using 'MET2D' + do n = 1, Nspecial3d + ix=ix+1 + write(met(ix)%name,fmt='(A,I0)')'special3d',n + met(ix)%dim = 3 + met(ix)%frequency = 3 + met(ix)%time_interpolate = .false. + met(ix)%read_meteo = .false. + met(ix)%needed = .false. + met(ix)%found = .false. + if(n==1)then + allocate(special3d(LIMAX,LJMAX,KMAX_MID,Nspecial3d)) + special3d=0.0 + endif +! met(ix)%field(1:LIMAX,1:LJMAX,1:KMAX_MID,1:1) => special3d(1:LIMAX,1:LJMAX,1:KMAX_MID,n) +!Since the syntax above is not allowed, we move the adress of the pointer, instead of the target + met(ix)%field(1:LIMAX,1:LJMAX,1:KMAX_MID,1-(n-1):1-(n-1)) => special3d + met(ix)%zsize = KMAX_MID + met(ix)%msize = 1 + ix_special3d(n)=ix + enddo + + if(USE_WRF_MET_NAMES)then WRF_MET_CORRECTIONS = .true. @@ -991,13 +1042,13 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) met(ix_sdepth)%name = 'SNOWNC'!snow and ice in mm met(ix_ice_nwp)%name = 'SEAICE'!flag 0 or 1 !... addmore -endif +end if Nmetfields=ix if(Nmetfields>NmetfieldsMax)then write(*,*)"Increase NmetfieldsMax! " stop - endif + end if allocate(u_ref(LIMAX,LJMAX)) allocate(rho_surf(LIMAX,LJMAX)) @@ -1037,18 +1088,18 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) xsize=largeLIMAX*largeLJMAX i=i+1 call share(met(ix)%field_shared,data_shape,xsize,MPI_COMM_SUB) - endif + end if if(met(ix)%dim==3)then j=j+1 data_shape=(/largeLIMAX,largeLJMAX,KMAX_MID/) xsize=largeLIMAX*largeLJMAX*KMAX_MID call share(met(ix)%field_shared,data_shape,xsize,MPI_COMM_SUB) - endif + end if CALL MPI_BARRIER(MPI_COMM_SUB, IERROR) - enddo + end do Nshared_2d=i Nshared_3d=j - endif + end if end subroutine Alloc_MetFields ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/Met_ml.f90 b/Met_ml.f90 index e5af2d9..da9a6f4 100644 --- a/Met_ml.f90 +++ b/Met_ml.f90 @@ -1,8 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -25,122 +24,89 @@ !* You should have received a copy of the GNU General Public License !* along with this program. If not, see . !*****************************************************************************! -!_____________________________________________________________________________ -! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -! MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD - module Met_ml - -! MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD -! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -!_____________________________________________________________________________ -! Subroutines: Frequency Called from: -! MetModel_LandUse Unimod -! MeteoRead 3h Unimod - puts data into nr -! metfieldint dt_advec PhyChem, ends with call met_derived -! met_derived dt_advec MeteoRead and metfieldint- gets u_mid, rho_sruf, -! ustar_nwp, inL_nwp -! BLPhysics(numt) 3h MeteoRead, after met_derived -! +!============================================================================= +! Subroutines: Frequency Called from: +! MetModel_LandUse Unimod +! MeteoRead 3h Unimod - puts data into nr +! metfieldint dt_advec Unimod +! BLPhysics(numt) 3h MeteoRead, after met_derived +! ! Alt: ! Unimod do every dt_advec , .... -! call MeteoRead - puts data into nr -! Unit changes, special definitions etc... -! e.g. converts wind to u_xmj, v_xmi -! call met_derived(nr=2) uses q(...,nr=2) (future) -! call BLPhysics(nr=2) -! call met_derived(nr=1) uses q(...,nr=1) (now) -! call phyche() ... -! chemistry stuff -! call metfieldint -! call met_derived(nr=1) -! -! +! call MeteoRead - puts data into nr +! Unit changes, special definitions etc... +! e.g. converts wind to u_xmj, v_xmi +! call met_derived(nr=2) uses q(...,nr=2) (future) +! call BLPhysics(nr=2) +! call met_derived(nr=1) uses q(...,nr=1) (now) +! call phyche() ... +! chemistry stuff +! call metfieldint +! call met_derived(nr=1) +! ! metfieldint -! -! ! this routine does the forward linear stepping of the meteorological -! ! fields read or derived every 3 hours. -! q(..1) = q(.., 1) + ... -! -! -!============================================================================= - -use OwnDataTypes_ml, only : Deriv -use BLPhysics_ml, only : & - KZ_MINIMUM, KZ_MAXIMUM, KZ_SBL_LIMIT,PIELKE & +! does the forward linear stepping of the meteorological +! fields read or derived every 3 hours. +! +!============================================================================= + +use emep_Config_mod, only: PBL +use BLPhysics_ml, only: & + KZ_MINIMUM, KZ_SBL_LIMIT, PIELKE & ,HmixMethod, UnstableKzMethod, StableKzMethod, KzMethod & ,USE_MIN_KZ & ! From old code, is it needed? ,MIN_USTAR_LAND & ! sets u* > 0.1 m/s over land - ,OB_invL_LIMIT & ! + ,OB_invL_LIMIT & ! ,Test_BLM & ! Tests all Kz, Hmix routines - ,PBL_ZiMAX, PBL_ZiMIN & ! max and min PBL heights - ,JericevicRiB_Hmix & ! TESTING ,JericevicRiB_Hmix0 & ! Used, now allows shallow SBL - ,Venkatram_Hmix & ! TESTING - ,Zilitinkevich_Hmix & ! TESTING - ,SeibertRiB_Hmix_3d & ! TESTING - ,BrostWyngaardKz & ! TESTING - ,JericevicKz & ! TESTING - ,TI_Hmix & ! TESTING or orig + ,SeibertRiB_Hmix_3d & + ,BrostWyngaardKz & + ,JericevicKz & + ,TI_Hmix & ,PielkeBlackadarKz & ,O_BrienKz & - ,NWP_Kz & ! Kz from meteo - ,Kz_m2s_toSigmaKz & - ,Kz_m2s_toEtaKz & + ,NWP_Kz & ! Kz from meteo + ,Kz_m2s_toSigmaKz & + ,Kz_m2s_toEtaKz & ,SigmaKz_2_m2s -use CheckStop_ml, only : CheckStop,StopAll -use FastJ_ml, only : setup_phot_fastj,rcphot_3D -use Functions_ml, only : Exner_tab, Exner_nd -use Functions_ml, only : T_2_Tpot !OS_TESTS -use GridValues_ml, only : xmd, i_fdom, j_fdom, i_local,j_local& - ,glon,glat,gl_stagg,gb_stagg& - ,xm_i,xm_j ,xm2,xmd,xm2ji,xmdji,GridArea_m2& - , projection & - ,glon,glat, MIN_ADVGRIDS & - ,Poles, xm_i, xm_j, xm2, sigma_bnd,sigma_mid & - ,xp, yp, fi, GRIDWIDTH_M,ref_latitude & - ,debug_proc, debug_li, debug_lj & - ,grid_north_pole_latitude,grid_north_pole_longitude & - ,gl_stagg,gb_stagg,A_mid,B_mid & - ,Eta_bnd,Eta_mid,dA,dB,A_mid,B_mid,A_bnd,B_bnd & +use CheckStop_ml, only: CheckStop +use FastJ_ml, only: setup_phot_fastj,rcphot_3D +use Functions_ml, only: Exner_tab, Exner_nd +use Functions_ml, only: T_2_Tpot !OS_TESTS +use GridValues_ml, only: glat, xm_i, xm_j, xm2 & + ,Poles, sigma_bnd, sigma_mid, xp, yp, fi, GRIDWIDTH_M & + ,debug_proc, debug_li, debug_lj, A_mid, B_mid & + ,Eta_bnd,Eta_mid,dA,dB,A_mid,B_mid,A_bnd,B_bnd & ,KMAX_MET,External_Levels_Def,k1_met,k2_met,x_k1_met,rot_angle -use Io_ml , only: ios, IO_ROUGH, datewrite,PrintLog, & - IO_CLAY, IO_SAND, open_file, IO_LOG +use Io_ml , only: ios, datewrite, PrintLog, IO_LOG use Landuse_ml, only: water_fraction, water_frac_set, & likely_coastal, mainly_sea -use MetFields_ml -use MicroMet_ml, only : PsiH ! Only if USE_MIN_KZ -use ModelConstants_ml, only : PASCAL, PT, Pref, METSTEP & - ,KMAX_BND,KMAX_MID,NMET,KCHEMTOP & - ,IIFULLDOM, JJFULLDOM, RUNDOMAIN,NPROC & - ,MasterProc, DEBUG_MET, V_RAIN, nmax & - ,DEBUG_BLM, DEBUG_Kz, DEBUG_SOILWATER,DEBUG_LANDIFY & - ,NH3_U10 & !FUTURE +use MetFields_ml +use MicroMet_ml, only: PsiH ! Only if USE_MIN_KZ +use ModelConstants_ml, only: PASCAL, PT, Pref, METSTEP & + ,KMAX_BND, KMAX_MID, MasterProc, DEBUG_MET, nmax & + ,DEBUG_BLM, DEBUG_Kz, DEBUG_SOILWATER, DEBUG_LANDIFY & ,DomainName & !HIRHAM,EMEP,EECCA etc. - ,USE_DUST, TEGEN_DATA, USE_SOILWATER & - ,nstep,USE_CONVECTION,USE_EtaCOORDINATES,USE_FASTJ & - ,CONVECTION_FACTOR & - ,LANDIFY_MET,MANUAL_GRID & - ,CW_THRESHOLD,RH_THRESHOLD, CW2CC,IOU_INST,JUMPOVER29FEB, meteo, startdate, enddate -use MPI_Groups_ml, only: MPI_DOUBLE_PRECISION, MPI_SUM,MPI_INTEGER, MPI_BYTE,MPI_LOGICAL,& + ,USE_DUST, TEGEN_DATA, USE_SOILWATER & + ,nstep,USE_CONVECTION,USE_EtaCOORDINATES,USE_FASTJ & + ,CONVECTION_FACTOR & + ,LANDIFY_MET,MANUAL_GRID & + ,CW_THRESHOLD,RH_THRESHOLD, CW2CC, JUMPOVER29FEB, meteo, startdate +use MPI_Groups_ml, only: MPI_DOUBLE_PRECISION, MPI_BYTE, MPI_LOGICAL,& MPI_COMM_IO, MPI_COMM_CALC, IERROR, ME_IO, ME_CALC,& request_e,request_n,request_s,request_w,LargeSub_Ix,& largeLIMAX,largeLJMAX, MPISTATUS, MPI_MIN -use Par_ml , only : MAXLIMAX,MAXLJMAX,GIMAX,GJMAX, me & - ,limax,ljmax & - ,neighbor,WEST,EAST,SOUTH,NORTH,NOPROC & +use Par_ml, only: MAXLIMAX,MAXLJMAX,GIMAX,GJMAX, me & + ,limax,ljmax, neighbor,WEST,EAST,SOUTH,NORTH,NOPROC & ,MSG_NORTH2,MSG_EAST2,MSG_SOUTH2,MSG_WEST2 & - ,IRUNBEG,JRUNBEG, tgi0, tgj0,gi0,gj0 & - ,MSG_INIT3,MSG_READ4, tlimax, tljmax & - ,tlargegi0,tlargegj0 -use PhysicalConstants_ml, only : KARMAN, KAPPA, RGAS_KG, CP, GRAV & - ,ROWATER, PI -use TimeDate_ml, only : current_date, date,nmdays, & - add_secs,timestamp,& - make_timestamp, make_current_date, nydays -use NetCDF_ml, only : printCDF,ReadField_CDF,vertical_interpolate,Out_netCDF,GetCDF_modelgrid ! testoutputs + ,IRUNBEG,JRUNBEG, gi0,gj0, MSG_READ4, tlargegi0,tlargegj0 +use PhysicalConstants_ml, only: KARMAN, KAPPA, RGAS_KG, CP, GRAV +use TimeDate_ml, only: current_date, date,nmdays, & + add_secs,timestamp, make_timestamp, make_current_date +use NetCDF_ml, only: ReadField_CDF,vertical_interpolate,GetCDF_modelgrid use netcdf use TimeDate_ExtraUtil_ml,only: nctime2date,date2string @@ -172,1774 +138,1679 @@ module Met_ml public :: landify ! replaces met variables from mixed sea/land with land contains - subroutine MeteoRead_io() - - character (len = 100), save :: meteoname ! name of the meteofile - character (len = 100) :: namefield ! name of the requested field - integer :: ix, KMAX, istart,jstart,ijk,i,j,k,k1,k2 - integer :: nr - integer :: ndim,nyear,nmonth,nday,nhour - real ::meteo_3D(largeLIMAX,largeLJMAX,KMAX_MET) - logical,save :: first_call = .true. - type(date) :: next_inptime ! hfTD,addhours_to_input - type(timestamp) :: ts_now ! time in timestamp format - real :: nsec ! step in seconds - logical :: fexist,found - - if(current_date%seconds /= 0 .or. (mod(current_date%hour,METSTEP)/=0) )return - - nr=2 !set to one only when the first time meteo is read - call_msg = "Meteoread" - if(me_IO>=0)then - if(first_call)then !first time meteo is read - nr = 1 - nrec = 0 - next_inptime = current_date - - !On first call, check that date from meteo file correspond to dates requested. - !Also defines nhour_first and Nhh (and METSTEP in case of WRF metdata). - call Check_Meteo_Date !note that all procs read this - else - nsec=METSTEP*3600.0 !from hr to sec - ts_now = make_timestamp(current_date) - call add_secs(ts_now,nsec) - if(JUMPOVER29FEB.and.current_date%month==2.and.current_date%day==29)then - if(MasterProc)write(*,*)'Jumping over one day for meteo_date!' - call add_secs(ts_now,24*3600.) - endif - next_inptime=make_current_date(ts_now) - endif - nyear=next_inptime%year - nmonth=next_inptime%month - nday=next_inptime%day - nhour=next_inptime%hour - nrec=nrec+1 - - if(nrec>Nhh.or.nrec==1) then ! start reading a new meteo input file - meteoname = date2string(meteo,next_inptime) - nrec = 1 - if(nday==1.and.nmonth==1)then - !hour 00:00 from 1st January may be missing;checking first: - inquire(file=meteoname,exist=fexist) - if(.not.fexist)then - if(MasterProc)write(*,*)trim(meteoname),& - ' does not exist; using data from previous day' - meteoname=date2string(meteo,next_inptime,-24*3600.0) - nrec=Nhh - endif - endif - if(ME_IO==0)write(*,*)'io procs reading ',trim(meteoname) - endif - - do ix=1,Nmetfields - if(met(ix)%read_meteo)then - namefield=met(ix)%name - ndim=met(ix)%dim - - if(ndim==3)KMAX=KMAX_MET - if(ndim==2)KMAX=1 - - istart=gi0 - jstart=gj0 - call GetCDF_modelgrid(namefield,meteoname,meteo_3D,1,KMAX,nrec,1,& - imax_in=largeLIMAX,jmax_in=largeLJMAX,needed=met(ix)%needed,found=met(ix)%found) - if(met(ix)%found)then - if(KMAX==1)then - ijk=0 - k=1 - do j=1,largeLJMAX - do i=1,largeLIMAX - ijk=ijk+1 - met(ix)%field_shared(i,j,k)=meteo_3D(i,j,k) - enddo - enddo - else - if(External_Levels_Def)then - !interpolate vertically if the levels are not identical - ijk=0 - do k=1,KMAX_MID - k1=k1_met(k) - k2=k2_met(k) - do j=1,largeLJMAX - do i=1,largeLIMAX - ijk=ijk+1 - met(ix)%field_shared(i,j,k)=x_k1_met(k)*meteo_3D(i,j,k1)+(1.0-x_k1_met(k))*meteo_3D(i,j,k2) - enddo - enddo - enddo - else - !use same vertical coordinates as meteo - ijk=0 - do k=1,KMAX_MID - do j=1,largeLJMAX - do i=1,largeLIMAX - ijk=ijk+1 - met(ix)%field_shared(i,j,k)=meteo_3D(i,j,k) - enddo - enddo - enddo - - endif - endif - met(ix)%ready=.true. - met(ix)%copied=.false. - else - met(ix)%ready=.false. - met(ix)%copied=.false. - endif - - if(me_io==0)then - if(met(ix)%found)write(*,*)'found ',trim(namefield),' in ',trim(meteoname) - if(met(ix)%found.and.ndim==2)write(*,*)'typical value 2D = ',trim(namefield),me_io,met(ix)%field_shared(5,5,1) - if(met(ix)%found.and.ndim==3)write(*,*)'typical value 3D = ',trim(namefield),me_io,met(ix)%field_shared(5,5,KMAX_MID) - if(.not.met(ix)%found)write(*,*)'did not find ',trim(namefield),' in ',trim(meteoname) - endif - endif - enddo - first_call = .false. - else - - endif - - end subroutine MeteoRead_io -!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - subroutine MeteoRead() - ! the subroutine reads meteorological fields and parameters (every - ! METSTEP-hours) from NetCDF fields-files, divide the fields into - ! domains and sends subfields to the processors - implicit none - - character (len = 100), save :: meteoname ! name of the meteofile - character (len = 100) :: namefield & ! name of the requested field - ,unit=' ',validity=' ' ! field is either instaneous or averaged - integer :: ndim,nyear,nmonth,nday,nhour - integer :: nr ! Fields are interpolate in - ! time (NMET = 2): between nr=1 and nr=2 - - type(date) :: next_inptime ! hfTD,addhours_to_input - type(timestamp) :: ts_now ! time in timestamp format - - real :: nsec ! step in seconds - - real :: buff(LIMAX,LJMAX)!temporary metfields - integer :: i, j, ix, k, kk, ii,jj,ii2,jj2, nrix, isw, KMAX - logical :: fexist,found - logical,save :: first_call = .true. - logical,save :: newrain = .true. - - ! Soil water has many names. Some we can deal with: - ! (and all need to end up as SMI) - character(len=*), dimension(4), parameter :: possible_soilwater_uppr = (/& - "SMI1 " & - ,"SMI " & - ,"soil_water_content " & - ,"soil_wetness_surface" & - /) - character(len=*), dimension(3), parameter :: possible_soilwater_deep = (/& - "SMI3 " & - ,"SMI " & - ,"deep_soil_water_content" & - /) - logical :: write_now - - real :: relh1,relh2,temperature,swp,wp, x_out - real, dimension(KMAX_MID) :: prhelp, exf2 - real, dimension(KMAX_BND) :: exf1 - - real, dimension(LJMAX,KMAX_MID) :: usnd ! send in x - real, dimension(LIMAX,KMAX_MID) :: vsnd ! and in y direction - real, dimension(LJMAX,KMAX_MID) :: urcv ! rcv in x - real, dimension(LIMAX,KMAX_MID) :: vrcv ! and in y direction - - real p1, p2, x, y - real prhelp_sum,divk(KMAX_MID),sumdiv,dB_sum - real divt, inv_METSTEP - - real ::Ps_extended(0:LIMAX+1,0:LJMAX+1),Pmid,Pu1,Pu2,Pv1,Pv2 - - real :: tmpsw, landfrac, sumland ! for soil water averaging - real :: minprecip, tmpmax ! debug - - real buf_uw(LJMAX,KMAX_MID) - real buf_ue(LJMAX,KMAX_MID) - real buf_vn(LIMAX,KMAX_MID) - real buf_vs(LIMAX,KMAX_MID) - integer :: INFO,i_large,j_large - - if(current_date%seconds /= 0 .or. (mod(current_date%hour,METSTEP)/=0) )return - - nr=2 !set to one only when the first time meteo is read - call_msg = "Meteoread" - - inv_METSTEP = 1.0/METSTEP - divt = 1./(3600.0*METSTEP) +subroutine MeteoRead_io() + + character (len = 100), save :: meteoname ! name of the meteofile + character (len = 100) :: namefield ! name of the requested field + integer :: ix, KMAX, istart,jstart,ijk,i,j,k,k1,k2 + integer :: nr + integer :: ndim,nyear,nmonth,nday,nhour + real ::meteo_3D(largeLIMAX,largeLJMAX,KMAX_MET) + logical,save :: first_call = .true. + type(date) :: next_inptime ! hfTD,addhours_to_input + type(timestamp) :: ts_now ! time in timestamp format + real :: nsec ! step in seconds + logical :: fexist + + if(current_date%seconds /= 0 .or. (mod(current_date%hour,METSTEP)/=0) )return + + nr=2 !set to one only when the first time meteo is read + call_msg = "Meteoread" + if(me_IO>=0)then if(first_call)then !first time meteo is read - nr = 1 - nrec = 0 - next_inptime = current_date - - KMAX=max(KMAX_MID,KMAX_MET)!so that allocated arrays are large for both use - if(MasterProc)then - allocate(var_global(GIMAX,GJMAX,KMAX)) - else - allocate(var_global(1,1,1)) !just to have the array defined - endif - allocate(var_local(MAXLIMAX,MAXLJMAX,KMAX)) - - !On first call, check that date from meteo file correspond to dates requested. - !Also defines nhour_first and Nhh (and METSTEP and bucket in case of WRF metdata). - call Check_Meteo_Date !note that all procs read this - - call Exner_tab()!init table - - debug_iloc = debug_li - debug_jloc = debug_lj + nr = 1 + nrec = 0 + next_inptime = current_date + !On first call, check that date from meteo file correspond to dates requested. + !Also defines nhour_first and Nhh (and METSTEP in case of WRF metdata). + call Check_Meteo_Date !note that all procs read this else - nsec=METSTEP*3600.0 !from hr to sec - ts_now = make_timestamp(current_date) - call add_secs(ts_now,nsec) - if(JUMPOVER29FEB.and.current_date%month==2.and.current_date%day==29)then - if(MasterProc)write(*,*)'Jumping over one day for meteo_date!' - call add_secs(ts_now,24*3600.) - endif - next_inptime=make_current_date(ts_now) - endif - + nsec=METSTEP*3600.0 !from hr to sec + ts_now = make_timestamp(current_date) + call add_secs(ts_now,nsec) + if(JUMPOVER29FEB.and.current_date%month==2.and.current_date%day==29)then + if(MasterProc)write(*,*)'Jumping over one day for meteo_date!' + call add_secs(ts_now,24*3600.) + end if + next_inptime=make_current_date(ts_now) + end if nyear=next_inptime%year nmonth=next_inptime%month nday=next_inptime%day nhour=next_inptime%hour + nrec=nrec+1 + + if(nrec>Nhh.or.nrec==1) then ! start reading a new meteo input file + meteoname = date2string(meteo,next_inptime) + nrec = 1 + if(nday==1.and.nmonth==1)then + !hour 00:00 from 1st January may be missing;checking first: + inquire(file=meteoname,exist=fexist) + if(.not.fexist)then + if(MasterProc)write(*,*)trim(meteoname),& + ' does not exist; using data from previous day' + meteoname=date2string(meteo,next_inptime,-24*3600.0) + nrec=Nhh + end if + end if + if(ME_IO==0)write(*,*)'io procs reading ',trim(meteoname) + end if + + do ix=1,Nmetfields + if(met(ix)%read_meteo)then + namefield=met(ix)%name + ndim=met(ix)%dim + + if(ndim==3)KMAX=KMAX_MET + if(ndim==2)KMAX=1 + + istart=gi0 + jstart=gj0 + call GetCDF_modelgrid(namefield,meteoname,meteo_3D,1,KMAX,nrec,1,& + imax_in=largeLIMAX,jmax_in=largeLJMAX,needed=met(ix)%needed,found=met(ix)%found) + if(met(ix)%found)then + if(KMAX==1)then + ijk=0 + k=1 + do j=1,largeLJMAX + do i=1,largeLIMAX + ijk=ijk+1 + met(ix)%field_shared(i,j,k)=meteo_3D(i,j,k) + end do + end do + else + if(External_Levels_Def)then + !interpolate vertically if the levels are not identical + ijk=0 + do k=1,KMAX_MID + k1=k1_met(k) + k2=k2_met(k) + do j=1,largeLJMAX + do i=1,largeLIMAX + ijk=ijk+1 + met(ix)%field_shared(i,j,k)=x_k1_met(k)*meteo_3D(i,j,k1)& + +(1.0-x_k1_met(k))*meteo_3D(i,j,k2) + end do + end do + end do + else + !use same vertical coordinates as meteo + ijk=0 + do k=1,KMAX_MID + do j=1,largeLJMAX + do i=1,largeLIMAX + ijk=ijk+1 + met(ix)%field_shared(i,j,k)=meteo_3D(i,j,k) + end do + end do + end do + end if + end if + met(ix)%ready=.true. + met(ix)%copied=.false. + else + met(ix)%ready=.false. + met(ix)%copied=.false. + end if + + if(me_io==0)then + if(met(ix)%found)write(*,*)'found ',trim(namefield),' in ',trim(meteoname) + if(met(ix)%found.and.ndim==2)write(*,*)'typical value 2D = ',trim(namefield),me_io,met(ix)%field_shared(5,5,1) + if(met(ix)%found.and.ndim==3)write(*,*)'typical value 3D = ',trim(namefield),me_io,met(ix)%field_shared(5,5,KMAX_MID) + if(.not.met(ix)%found)write(*,*)'did not find ',trim(namefield),' in ',trim(meteoname) + end if + end if + end do + first_call = .false. + end if +end subroutine MeteoRead_io - if(MasterProc.and.DEBUG_MET) write(6,*) & - '*** nyear,nmonth,nday,nhour,nmdays2' & - ,next_inptime%year,next_inptime%month,next_inptime%day & - ,next_inptime%hour,nmdays(2) +subroutine MeteoRead() + ! the subroutine reads meteorological fields and parameters (every + ! METSTEP-hours) from NetCDF fields-files, divide the fields into + ! domains and sends subfields to the processors + implicit none - !Read rec=1 both for h=0 and h=3:00 in case 00:00 in 1st meteofile + character (len = 100), save :: meteoname ! name of the meteofile + character (len = 100) :: namefield & ! name of the requested field + ,unit=' ',validity=' ' ! field is either instaneous or averaged + integer :: ndim,nyear,nmonth,nday,nhour + integer :: nr ! Fields are interpolate in + + type(date) :: next_inptime ! hfTD,addhours_to_input + type(timestamp) :: ts_now ! time in timestamp format + + real :: nsec ! step in seconds + + real :: buff(LIMAX,LJMAX)!temporary metfields + integer :: i, j, ix, k, kk, nrix, isw, KMAX + logical :: fexist + logical,save :: first_call = .true. + + ! Soil water has many names. Some we can deal with: + ! (and all need to end up as SMI) + character(len=*), parameter :: & + possible_soilwater_uppr(4) = (/& + "SMI1 " & + ,"SMI " & + ,"soil_water_content " & + ,"soil_wetness_surface" /), & + possible_soilwater_deep(3) = (/& + "SMI3 " & + ,"SMI " & + ,"deep_soil_water_content" /) + logical :: write_now + + real :: relh1,relh2,temperature,swp,wp, x_out + real, dimension(KMAX_MID) :: exf2 + real, dimension(KMAX_BND) :: exf1 + + real, dimension(LJMAX,KMAX_MID) :: usnd ! send in x + real, dimension(LIMAX,KMAX_MID) :: vsnd ! and in y direction + real, dimension(LJMAX,KMAX_MID) :: urcv ! rcv in x + real, dimension(LIMAX,KMAX_MID) :: vrcv ! and in y direction + + real :: p1, p2, x, y + real :: divk(KMAX_MID),sumdiv,dB_sum + real :: divt, inv_METSTEP + + real :: Ps_extended(0:LIMAX+1,0:LJMAX+1),Pmid,Pu1,Pu2,Pv1,Pv2 + + real :: minprecip, tmpmax ! debug + + real, dimension(LJMAX,KMAX_MID) :: buf_uw,buf_ue + real, dimension(LIMAX,KMAX_MID) :: buf_vn,buf_vs + integer :: INFO,i_large,j_large + + if(current_date%seconds /= 0 .or. (mod(current_date%hour,METSTEP)/=0) )return + + nr=2 !set to one only when the first time meteo is read + call_msg = "Meteoread" + + inv_METSTEP = 1.0/METSTEP + divt = 1./(3600.0*METSTEP) + + if(first_call)then !first time meteo is read + nr = 1 + nrec = 0 + next_inptime = current_date + + KMAX=max(KMAX_MID,KMAX_MET)!so that allocated arrays are large for both use + if(MasterProc)then + allocate(var_global(GIMAX,GJMAX,KMAX)) + else + allocate(var_global(1,1,1)) !just to have the array defined + end if + allocate(var_local(MAXLIMAX,MAXLJMAX,KMAX)) - nrec=nrec+1 + !On first call, check that date from meteo file correspond to dates requested. + !Also defines nhour_first and Nhh (and METSTEP and bucket in case of WRF metdata). + call Check_Meteo_Date !note that all procs read this - if(nrec>Nhh.or.nrec==1) then ! start reading a new meteo input file - meteoname = date2string(meteo,next_inptime) + call Exner_tab()!init table - nrec = 1 - if(nday==1.and.nmonth==1)then - !hour 00:00 from 1st January may be missing;checking first: - inquire(file=meteoname,exist=fexist) - if(.not.fexist)then - if(MasterProc)write(*,*)trim(meteoname),& - ' does not exist; using data from previous day' - meteoname=date2string(meteo,next_inptime,-24*3600.0) - nrec=Nhh - endif - endif - if(MasterProc)write(*,*)'reading ',trim(meteoname) - !could open and close file here instead of in Getmeteofield - endif + debug_iloc = debug_li + debug_jloc = debug_lj - if(MasterProc.and.DEBUG_MET) write(*,*)'nrec,nhour=',nrec,nhour + else + nsec=METSTEP*3600.0 !from hr to sec + ts_now = make_timestamp(current_date) + call add_secs(ts_now,nsec) + if(JUMPOVER29FEB.and.current_date%month==2.and.current_date%day==29)then + if(MasterProc)write(*,*)'Jumping over one day for meteo_date!' + call add_secs(ts_now,24*3600.) + end if + next_inptime=make_current_date(ts_now) + end if + + nyear=next_inptime%year + nmonth=next_inptime%month + nday=next_inptime%day + nhour=next_inptime%hour + + if(MasterProc.and.DEBUG_MET) & + write(6,*) '*** nyear,nmonth,nday,nhour,nmdays2' & + ,next_inptime%year,next_inptime%month,next_inptime%day & + ,next_inptime%hour,nmdays(2) + + !Read rec=1 both for h=0 and h=3:00 in case 00:00 in 1st meteofile + + nrec=nrec+1 + + if(nrec>Nhh.or.nrec==1) then ! start reading a new meteo input file + meteoname = date2string(meteo,next_inptime) + + nrec = 1 + if(nday==1.and.nmonth==1)then + !hour 00:00 from 1st January may be missing;checking first: + inquire(file=meteoname,exist=fexist) + if(.not.fexist)then + if(MasterProc)write(*,*)trim(meteoname),& + ' does not exist; using data from previous day' + meteoname=date2string(meteo,next_inptime,-24*3600.0) + nrec=Nhh + end if + end if + if(MasterProc)write(*,*)'reading ',trim(meteoname) + !could open and close file here instead of in Getmeteofield + end if - write_now=MasterProc.and.(DEBUG_MET.or.first_call) !inform of what is done with each field the first time + if(MasterProc.and.DEBUG_MET) write(*,*)'nrec,nhour=',nrec,nhour - !============== Read the meteo fields ================================================ + write_now=MasterProc.and.(DEBUG_MET.or.first_call) !inform of what is done with each field the first time - do ix=1,Nmetfields - if(met(ix)%read_meteo)then - namefield=met(ix)%name - ndim=met(ix)%dim - nrix=min(met(ix)%msize,nr) - -! if(met(ix)%ready .eqv. .true.)then - if(.false.)then - if(ndim==2)then - do j=1,ljmax - j_large=j+gj0-tlargegj0(LargeSub_Ix) - do i=1,limax - i_large=i+gi0-tlargegi0(LargeSub_Ix) - met(ix)%field(i,j,1,nrix)=met(ix)%field_shared(i_large,j_large,1) - enddo - enddo - else if(ndim==3)then - do k=1,KMAX_MID - do j=1,ljmax - j_large=j+gj0-tlargegj0(LargeSub_Ix) - do i=1,limax - i_large=i+gi0-tlargegi0(LargeSub_Ix) - met(ix)%field(i,j,k,nrix)=met(ix)%field_shared(i_large,j_large,k) - enddo - enddo - enddo - endif - met(ix)%found=.true. - met(ix_fh)%validity='averaged'!should be softified - met(ix_fl)%validity='averaged'!should be softified - else - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,met(ix)%validity,& - met(ix)%field(1:LIMAX,1:LJMAX,:,nrix),needed=met(ix)%needed,& - found=met(ix)%found) - endif - if(write_now)then - if(met(ix)%found)write(*,*)'found ',trim(namefield),' in ',trim(meteoname) - if(met(ix)%found.and.ndim==2)write(*,*)'typical value = ',& - met(ix)%field(5,5,1,nrix),maxval(met(ix)%field(:,:,1,nrix)) - if(met(ix)%found.and.ndim==3)write(*,*)'typical value = ',& - met(ix)%field(5,5,kmax_mid,nrix),maxval(met(ix)%field(:,:,kmax_mid,nrix)) - if(.not.met(ix)%found)write(*,*)'did not find ',trim(namefield),' in ',trim(meteoname) - if(me_calc<0)then - if(ndim==2)then - write(*,*)'met compare 2D ',me,met(ix)%field(5,5,1,nrix),met(ix)%field_shared(i_large,j_large,1) - else - write(*,*)'met compare 3D ',me,met(ix)%field(5,5,KMAX_MID,nrix),met(ix)%field_shared(i_large,j_large,KMAX_MID) - endif - endif - endif - endif - enddo - - !============== now correct and complete the metfields as needed! ========================== - if(MANUAL_GRID)then - !rotate the wind fields - !non-staggered grid here - do k=1,KMAX_MID - do j=1,ljmax - do i=1,limax - x=u_xmj(i,j,k,nr) - y=v_xmi(i,j,k,nr) - u_xmj(i,j,k,nr) = x*cos(rot_angle(i,j))-y*sin(rot_angle(i,j)) - v_xmi(i,j,k,nr) = x*sin(rot_angle(i,j))+y*cos(rot_angle(i,j)) - enddo - enddo - enddo - - !Now must stagger the wind fields - !must first fetch values from neighbors - if (neighbor(WEST) .ne. NOPROC) then - if(neighbor(WEST) .ne. me)then - buf_uw(:,:) = u_xmj(1,:,:,nr) - CALL MPI_ISEND(buf_uw, 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(WEST), MSG_EAST2, MPI_COMM_CALC, request_w, IERROR) - else - ! cyclic grid: own neighbor - ue(:,:,nr) = u_xmj(1,:,:,nr) - endif - endif - if (neighbor(SOUTH) .ne. NOPROC) then - buf_vs(:,:) = v_xmi(:,1,:,nr) - CALL MPI_ISEND(buf_vs, 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(SOUTH), MSG_NORTH2, MPI_COMM_CALC, request_s, IERROR) - endif - - if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then - CALL MPI_RECV(ue(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(EAST), MSG_EAST2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif - if (neighbor(NORTH) .ne. NOPROC) then - CALL MPI_RECV(vn(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(NORTH), MSG_NORTH2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif - - if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then - CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif - if (neighbor(SOUTH) .ne. NOPROC) then - CALL MPI_WAIT(request_s, MPISTATUS, IERROR) - endif + !============== Read the meteo fields ================================================ - do k=1,KMAX_MID - do j=1,ljmax - do i=1,limax-1 - u_xmj(i,j,k,nr) = 0.5*(u_xmj(i,j,k,nr)+u_xmj(i+1,j,k,nr)) - enddo - enddo - enddo - do k=1,KMAX_MID + do ix=1,Nmetfields + if(met(ix)%read_meteo)then + namefield=met(ix)%name + ndim=met(ix)%dim + nrix=min(met(ix)%msize,nr) + +! if(met(ix)%ready)then + if(.false.)then + select case(ndim) + case(2) do j=1,ljmax - do i=limax,limax - u_xmj(i,j,k,nr) = 0.5*(u_xmj(i,j,k,nr)+ue(j,k,nr)) - enddo - enddo - enddo - - do k=1,KMAX_MID - do j=1,ljmax-1 - do i=1,limax - v_xmi(i,j,k,nr) = 0.5*(v_xmi(i,j,k,nr)+v_xmi(i,j+1,k,nr)) - enddo - enddo - enddo - do k=1,KMAX_MID - do j=ljmax,ljmax - do i=1,limax - v_xmi(i,j,k,nr) = 0.5*(v_xmi(i,j,k,nr)+vn(i,k,nr)) - enddo - enddo - enddo - - endif - - !extend the i or j index to 0 - if (neighbor(EAST) .ne. NOPROC) then - usnd(:,:) = u_xmj(limax,:,:,nr) - CALL MPI_ISEND( usnd, 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) - endif - if (neighbor(NORTH) .ne. NOPROC) then - vsnd(:,:) = v_xmi(:,ljmax,:,nr) - CALL MPI_ISEND( vsnd , 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) - endif + j_large=j+gj0-tlargegj0(LargeSub_Ix) + do i=1,limax + i_large=i+gi0-tlargegi0(LargeSub_Ix) + met(ix)%field(i,j,1,nrix)=met(ix)%field_shared(i_large,j_large,1) + end do + end do + case(3) + do k=1,KMAX_MID + do j=1,ljmax + j_large=j+gj0-tlargegj0(LargeSub_Ix) + do i=1,limax + i_large=i+gi0-tlargegi0(LargeSub_Ix) + met(ix)%field(i,j,k,nrix)=met(ix)%field_shared(i_large,j_large,k) + end do + end do + end do + end select + met(ix)%found=.true. + met(ix_fh)%validity='averaged'!should be softified + met(ix_fl)%validity='averaged'!should be softified + else + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,met(ix)%validity,& + met(ix)%field(1:LIMAX,1:LJMAX,:,nrix),needed=met(ix)%needed,& + found=met(ix)%found) + end if + if(write_now)then + if(met(ix)%found)then + write(*,*)'found ',trim(namefield),' in ',trim(meteoname) + select case(ndim) + case(2) + write(*,*)'typical value = ',met(ix)%field(5,5,1,nrix),& + maxval(met(ix)%field(:,:,1,nrix)) + case(3) + write(*,*)'typical value = ',met(ix)%field(5,5,kmax_mid,nrix),& + maxval(met(ix)%field(:,:,kmax_mid,nrix)) + end select + else + write(*,*)'did not find ',trim(namefield),' in ',trim(meteoname) + end if + if(me_calc<0)then + select case(ndim) + case(2) + write(*,*)'met compare 2D ',me,met(ix)%field(5,5,1,nrix),& + met(ix)%field_shared(i_large,j_large,1) + case(3) + write(*,*)'met compare 3D ',me,met(ix)%field(5,5,KMAX_MID,nrix),& + met(ix)%field_shared(i_large,j_large,KMAX_MID) + end select + end if + end if + end if + end do + + !============== now correct and complete the metfields as needed! ========================== + if(MANUAL_GRID)then + !rotate the wind fields + !non-staggered grid here + do k=1,KMAX_MID + do j=1,ljmax + do i=1,limax + x=u_xmj(i,j,k,nr) + y=v_xmi(i,j,k,nr) + u_xmj(i,j,k,nr) = x*cos(rot_angle(i,j))-y*sin(rot_angle(i,j)) + v_xmi(i,j,k,nr) = x*sin(rot_angle(i,j))+y*cos(rot_angle(i,j)) + end do + end do + end do + + !Now must stagger the wind fields + !must first fetch values from neighbors if (neighbor(WEST) .ne. NOPROC) then - CALL MPI_RECV( u_xmj(0,:,:,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) - else - u_xmj(0,:,:,nr) = u_xmj(1,:,:,nr) - endif + if(neighbor(WEST) .ne. me)then + buf_uw(:,:) = u_xmj(1,:,:,nr) + CALL MPI_ISEND(buf_uw, 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(WEST), MSG_EAST2, MPI_COMM_CALC, request_w, IERROR) + else + ! cyclic grid: own neighbor + ue(:,:,nr) = u_xmj(1,:,:,nr) + end if + end if if (neighbor(SOUTH) .ne. NOPROC) then - CALL MPI_RECV( v_xmi(:,0,:,nr) , 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + buf_vs(:,:) = v_xmi(:,1,:,nr) + CALL MPI_ISEND(buf_vs, 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(SOUTH), MSG_NORTH2, MPI_COMM_CALC, request_s, IERROR) + end if + + if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then + CALL MPI_RECV(ue(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(EAST), MSG_EAST2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + if (neighbor(NORTH) .ne. NOPROC) then + CALL MPI_RECV(vn(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(NORTH), MSG_NORTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + + if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then + CALL MPI_WAIT(request_w, MPISTATUS, IERROR) + end if + if (neighbor(SOUTH) .ne. NOPROC) then + CALL MPI_WAIT(request_s, MPISTATUS, IERROR) + end if + + do k=1,KMAX_MID + do j=1,ljmax + do i=1,limax-1 + u_xmj(i,j,k,nr) = 0.5*(u_xmj(i,j,k,nr)+u_xmj(i+1,j,k,nr)) + end do + end do + end do + do k=1,KMAX_MID + do j=1,ljmax + do i=limax,limax + u_xmj(i,j,k,nr) = 0.5*(u_xmj(i,j,k,nr)+ue(j,k,nr)) + end do + end do + end do + + do k=1,KMAX_MID + do j=1,ljmax-1 + do i=1,limax + v_xmi(i,j,k,nr) = 0.5*(v_xmi(i,j,k,nr)+v_xmi(i,j+1,k,nr)) + end do + end do + end do + do k=1,KMAX_MID + do j=ljmax,ljmax + do i=1,limax + v_xmi(i,j,k,nr) = 0.5*(v_xmi(i,j,k,nr)+vn(i,k,nr)) + end do + end do + end do + end if ! MANUAL_GRID + + !extend the i or j index to 0 + if (neighbor(EAST) .ne. NOPROC) then + usnd(:,:) = u_xmj(limax,:,:,nr) + CALL MPI_ISEND( usnd, 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) + end if + if (neighbor(NORTH) .ne. NOPROC) then + vsnd(:,:) = v_xmi(:,ljmax,:,nr) + CALL MPI_ISEND( vsnd , 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) + end if + + if (neighbor(WEST) .ne. NOPROC) then + CALL MPI_RECV( u_xmj(0,:,:,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) + else + u_xmj(0,:,:,nr) = u_xmj(1,:,:,nr) + end if + if (neighbor(SOUTH) .ne. NOPROC) then + CALL MPI_RECV( v_xmi(:,0,:,nr) , 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + else + if(Poles(2)/=1) then + v_xmi(:,0,:,nr) = v_xmi(:,1,:,nr) else - if(Poles(2)/=1) then - v_xmi(:,0,:,nr) = v_xmi(:,1,:,nr) - else - !"close" the South pole - v_xmi(:,0,:,nr) = 0.0 - endif - endif - if (neighbor(NORTH) == NOPROC.and.Poles(1)==1) then - !"close" the North pole - v_xmi(:,ljmax,:,nr) = 0.0 - endif - if(neighbor(EAST) .ne. NOPROC) CALL MPI_WAIT(request_e, MPISTATUS, IERROR) - if(neighbor(NORTH) .ne. NOPROC)CALL MPI_WAIT(request_n, MPISTATUS, IERROR) - - !divide by the scaling in the perpendicular direction to get effective - !u_xmj and v_xmi - !(for conformal projections like Polar Stereo, xm_i and xm_j are equal) - do k = 1,KMAX_MID - do j = 1,ljmax - do i = 0,limax - u_xmj(i,j,k,nr) = u_xmj(i,j,k,nr)/xm_j(i,j) - enddo - enddo - do j = 0,ljmax - do i = 1,limax - v_xmi(i,j,k,nr) = v_xmi(i,j,k,nr)/xm_i(i,j) - enddo - enddo - enddo + !"close" the South pole + v_xmi(:,0,:,nr) = 0.0 + end if + end if + if (neighbor(NORTH) == NOPROC.and.Poles(1)==1) then + !"close" the North pole + v_xmi(:,ljmax,:,nr) = 0.0 + end if + if(neighbor(EAST) .ne. NOPROC) CALL MPI_WAIT(request_e, MPISTATUS, IERROR) + if(neighbor(NORTH) .ne. NOPROC)CALL MPI_WAIT(request_n, MPISTATUS, IERROR) + + !divide by the scaling in the perpendicular direction to get effective + !u_xmj and v_xmi + !(for conformal projections like Polar Stereo, xm_i and xm_j are equal) + do k = 1,KMAX_MID + do j = 1,ljmax + do i = 0,limax + u_xmj(i,j,k,nr) = u_xmj(i,j,k,nr)/xm_j(i,j) + end do + end do + do j = 0,ljmax + do i = 1,limax + v_xmi(i,j,k,nr) = v_xmi(i,j,k,nr)/xm_i(i,j) + end do + end do + end do + + if(WRF_MET_CORRECTIONS)then + !WRF temperatures are shifted by 300: + th(:,:,:,nr) = th(:,:,:,nr) + 300.0 + end if + + ! correct surface pressure here, because we will need it before we get to the 2D block + ! conversion of pressure from hPa to Pascal. + if(.not.WRF_MET_CORRECTIONS)ps(1:limax,1:ljmax,nr) = ps(1:limax,1:ljmax,nr)*PASCAL + if(foundcc3d)then if(WRF_MET_CORRECTIONS)then - !WRF temperatures are shifted by 300: - th(:,:,:,nr) = th(:,:,:,nr) + 300.0 - endif - -!correct surface pressure here, because we will need it before we get to the 2D block - ! conversion of pressure from hPa to Pascal. - if(.not.WRF_MET_CORRECTIONS)ps(1:limax,1:ljmax,nr) = ps(1:limax,1:ljmax,nr)*PASCAL - - if(foundcc3d)then - if(WRF_MET_CORRECTIONS)then - !WRF clouds in fraction, multiply by 100: - cc3d(:,:,:) = 100*cc3d(:,:,:) - endif - if(trim(met(ix_cc3d)%validity)/='averaged'.and.write_now)& - write(*,*)'WARNING: 3D cloud cover are instantaneous values' - cc3d(:,:,:) = 0.01*max(0.0,min(100.0,cc3d(:,:,:)))!0-100 % clouds to fraction - else !if available, will use cloudwater to determine the height of release - if(write_now)write(*,*)'WARNING: deriving 3D cloud cover (cc3d) from cloud water ' - namefield='cloudwater' - call Getmeteofield(meteoname,namefield,nrec,3,unit,validity,& + !WRF clouds in fraction, multiply by 100: + cc3d(:,:,:) = 100*cc3d(:,:,:) + end if + if(trim(met(ix_cc3d)%validity)/='averaged'.and.write_now)& + write(*,*)'WARNING: 3D cloud cover are instantaneous values' + cc3d(:,:,:) = 0.01*max(0.0,min(100.0,cc3d(:,:,:)))!0-100 % clouds to fraction + else !if available, will use cloudwater to determine the height of release + if(write_now)write(*,*)'WARNING: deriving 3D cloud cover (cc3d) from cloud water ' + namefield='cloudwater' + call Getmeteofield(meteoname,namefield,nrec,3,unit,validity,& cc3d(:,:,:),found=foundcloudwater) - call CheckStop(.not.foundcloudwater,& + call CheckStop(.not.foundcloudwater,& "meteo field not found: 3D_cloudcover and"//trim(namefield)) - cc3d(:,:,:)=0.01*max(0.0,min(100.0,cc3d(:,:,:)*CW2CC))!from kg/kg water to % clouds to fraction - endif - ! maximum of cloud fractions for layers above a given layer - cc3dmax(:,:,1) = cc3d(:,:,1) - do k=2,KMAX_MID - cc3dmax(:,:,k) = amax1(cc3dmax(:,:,k-1),cc3d(:,:,k-1)) - enddo - - lwc = 0.6e-6*cc3d - - if(.not.foundprecip)then - !Will construct 3D precipitations from 2D precipitations - if(write_now)write(*,*)'WARNING: deriving 3D precipitations from 2D precipitations ' - if(write_now)write(*,*)'2D precipitations sum of large_scale and convective precipitations' - - ix = ix_surface_precip - call Getmeteofield(meteoname,trim(met(ix)%name),nrec,met(ix)%dim,unit,met(ix)%validity,& - met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) - - ix = ix_convective_precip - call Getmeteofield(meteoname,met(ix)%name,nrec,met(ix)%dim,unit,met(ix)%validity,& - met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) - - surface_precip = surface_precip + convective_precip - !write(*,*)'precip ',nrec,Nhh,surface_precip(5,5),convective_precip(5,5),surface_precip_old(5,5) - if(WRF_MET_CORRECTIONS) then - if(found_wrf_bucket)then - !wrf "bucket" definition for surface precipitation: - !surface_precip = I_RAINNC*bucket + RAINNC + I_RAINC*bucket + RAINC - surface_precip=surface_precip+irainnc*wrf_bucket+irainc*wrf_bucket - endif - buff=surface_precip !save to save in old below - - !must first check that precipitation is increasing. At some dates WRF maybe restarted! - minprecip=minval(surface_precip(1:limax,1:ljmax) - surface_precip_old(1:limax,1:ljmax)) - - CALL MPI_ALLREDUCE(minprecip, x_out, 1,MPI_DOUBLE_PRECISION, & - MPI_MIN, MPI_COMM_CALC, IERROR) - minprecip=x_out - if(minprecip<-10)then - if(me==0)write(*,*)'WARNING: found negative precipitations. set precipitations to zero!',minprecip - surface_precip = 0.0 + cc3d(:,:,:)=0.01*max(0.0,min(100.0,cc3d(:,:,:)*CW2CC))!from kg/kg water to % clouds to fraction + end if + ! maximum of cloud fractions for layers above a given layer + cc3dmax(:,:,1) = cc3d(:,:,1) + do k=2,KMAX_MID + cc3dmax(:,:,k) = amax1(cc3dmax(:,:,k-1),cc3d(:,:,k-1)) + end do + + lwc = 0.6e-6*cc3d + + if(.not.foundprecip)then + !Will construct 3D precipitations from 2D precipitations + if(write_now)then + write(*,*)'WARNING: deriving 3D precipitations from 2D precipitations ' + write(*,*)'2D precipitations sum of large_scale and convective precipitations' + end if + + ix = ix_surface_precip + call Getmeteofield(meteoname,met(ix)%name,nrec,met(ix)%dim,unit,& + met(ix)%validity,met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) + + ix = ix_convective_precip + call Getmeteofield(meteoname,met(ix)%name,nrec,met(ix)%dim,unit,& + met(ix)%validity,met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) + + surface_precip = surface_precip + convective_precip + !write(*,*)'precip ',nrec,Nhh,surface_precip(5,5),convective_precip(5,5),surface_precip_old(5,5) + if(WRF_MET_CORRECTIONS) then + if(found_wrf_bucket)then + !wrf "bucket" definition for surface precipitation: + !surface_precip = I_RAINNC*bucket + RAINNC + I_RAINC*bucket + RAINC + surface_precip=surface_precip+irainnc*wrf_bucket+irainc*wrf_bucket + end if + buff=surface_precip !save to save in old below + + !must first check that precipitation is increasing. At some dates WRF maybe restarted! + minprecip=minval(surface_precip(1:limax,1:ljmax) - surface_precip_old(1:limax,1:ljmax)) + + CALL MPI_ALLREDUCE(minprecip, x_out, 1,MPI_DOUBLE_PRECISION, & + MPI_MIN, MPI_COMM_CALC, IERROR) + minprecip=x_out + if(minprecip<-10)then + if(me==0)write(*,*)'WARNING: found negative precipitations. set precipitations to zero!',minprecip + surface_precip = 0.0 + else + surface_precip = max(0.0,(surface_precip - surface_precip_old))*0.001/(METSTEP*3600)! get only the variation. mm ->m/s + end if + surface_precip_old = buff ! Accumulated rain in WRF + sdepth=sdepth*0.001 !mm->m + ice_nwp = ice_nwp*100!flag->% + !smooth qrain, because it is instantaneous but rain may move + do k=1,kmax_mid + call smoosp(rain(1,1,k,nr),0.0,1.0E10) + end do + end if + + ! if available, will use cloudwater to determine the height of release + ! NB: array cw_met only used here + if(nr==2)cw_met(:,:,:,1)=cw_met(:,:,:,2)!save previous value + + ix = ix_cw_met + call Getmeteofield(meteoname,met(ix)%name,nrec,met(ix)%dim,unit,& + met(ix)%validity,met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) + + if(foundrain)then + if(write_now)& + write(*,*)'release profile for 3D precipitations derived from QRAIN' + do j=1,ljmax + do i=1,limax + !note that there is much noise in surface precipitations, because it is the difference of two large number (1E5) + !values smaller than 0.01 mm are meaningless + if(surface_precip(i,j)>1E-9 .and. & + rain(i,j,kmax_mid,1)+rain(i,j,kmax_mid,nr)>1E-12)then + do k=1,kmax_mid + pr(i,j,k)=min(surface_precip(i,j),& + surface_precip(i,j)*(rain(i,j,k,1)+rain(i,j,k,nr))& + /(rain(i,j,kmax_mid,1)+rain(i,j,kmax_mid,nr))) + pr(i,j,k)=pr(i,j,k)*METSTEP*3600.0*1000.0! and m/s->mm/METSTEP + end do + elseif(surface_precip(i,j)>1.0E-8 )then + ! surface precipitation but no QRAIN found. + ! Should not occur too often. use humidity method. + pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0! guarantees precip at surface + do k=1,KMAX_MID-1 + !convert from potential temperature into absolute temperature + temperature = th(i,j,k,nr) & + *exp(KAPPA*log((A_mid(k)+B_mid(k)*ps(i,j,nr))*1.e-5))!Pa, Ps in Pa here + !saturation water pressure + swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) + !water pressure + wp=q(i,j,k,nr)*(A_mid(k)+B_mid(k)*ps(i,j,nr))/0.622!Ps in Pa here + relh2=wp/swp + !convert from potential temperature into absolute temperature + !Ps in Pa here + temperature = th(i,j,k,1) & + *exp(KAPPA*log((A_mid(k)+B_mid(k)*ps(i,j,1))*1.e-5))!Ps in Pa here + !saturation water pressure + swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) + !water pressure + wp=q(i,j,k,1)*(A_mid(k)+B_mid(k)*ps(i,j,1))/0.622!Ps in Pa here + relh1=wp/swp + if(relh1>RH_THRESHOLD.or.relh2>RH_THRESHOLD)then + !fill the column up to this level with constant precip + do kk=k,KMAX_MID-1 + pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!m/s->mm/METSTEP + end do + exit + else + pr(i,j,k)=0.0 + end if + end do else - surface_precip = max(0.0,(surface_precip - surface_precip_old))*0.001/(METSTEP*3600)! get only the variation. mm ->m/s - endif - surface_precip_old = buff ! Accumulated rain in WRF - sdepth=sdepth*0.001 !mm->m - ice_nwp = ice_nwp*100!flag->% - !smooth qrain, because it is instantaneous but rain may move - do k=1,kmax_mid - call smoosp(rain(1,1,k,nr),0.0,1.0E10) - enddo - endif - - !if available, will use cloudwater to determine the height of release - !NB: array cw_met only used here - if(nr==2)cw_met(:,:,:,1)=cw_met(:,:,:,2)!save previous value - - ix = ix_cw_met - call Getmeteofield(meteoname,met(ix)%name,nrec,met(ix)%dim,unit,met(ix)%validity,& - met(ix)%field,needed=met(ix)%needed,found=met(ix)%found) - - if(foundrain)then - if(write_now)write(*,*)'release profile for 3D precipitations derived from QRAIN' - do j=1,ljmax - do i=1,limax - !note that there is much noise in surface precipitations, because it is the difference of two large number (1E5) - !values smaller than 0.01 mm are meaningless - if(surface_precip(i,j)>1.0E-9 .and. rain(i,j,kmax_mid,1)+rain(i,j,kmax_mid,nr)>1.E-12)then - do k=1,kmax_mid - pr(i,j,k)=min(surface_precip(i,j),surface_precip(i,j)*(rain(i,j,k,1)+rain(i,j,k,nr))/(rain(i,j,kmax_mid,1)+rain(i,j,kmax_mid,nr))) - pr(i,j,k)=pr(i,j,k)*METSTEP*3600.0*1000.0! and m/s->mm/METSTEP - enddo - else if(surface_precip(i,j)>1.0E-8 )then - !write(*,*)'surface precip, but no qrain: ',i_fdom(i),j_fdom(j),rain(i,j,kmax_mid,1)+rain(i,j,kmax_mid,nr),surface_precip(i,j) - !surface precipitation but no QRAIN found. Should not occur too often. use humidity method. - pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0!guarantees precip at surface - do k=1,KMAX_MID-1 - !convert from potential temperature into absolute temperature - temperature = th(i,j,k,nr)*exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,nr))*1.e-5))!Pa, Ps in Pa here - !saturation water pressure - swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) - !water pressure - wp=q(i,j,k,nr)*(A_mid(k) + B_mid(k)*ps(i,j,nr))/0.622!Ps in Pa here - relh2=wp/swp - !convert from potential temperature into absolute temperature - !Ps in Pa here - temperature = th(i,j,k,1)* & - exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,1))*1.e-5))!Ps in Pa here - !saturation water pressure - swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) - !water pressure - wp=q(i,j,k,1)*(A_mid(k) + B_mid(k)*ps(i,j,1))/0.622!Ps in Pa here - relh1=wp/swp - if(relh1>RH_THRESHOLD.or.relh2>RH_THRESHOLD)then - !fill the column up to this level with constant precip - do kk=k,KMAX_MID-1 - pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!m/s->mm/METSTEP - enddo - exit - else - pr(i,j,k)=0.0 - endif - enddo - else - do k=1,kmax_mid - pr(i,j,k)=0.0 - enddo - endif - enddo - enddo - - else if(foundcloudwater)then - - if(write_now)write(*,*)'release height for 3D precipitations derived from cloudwater' - if(MasterProc.and.first_call)write(unit=IO_LOG,fmt="(a)")& - "3D precipitations: derived from 2D and cloudwater" - if(nr==1)cw_met(:,:,:,2)=cw_met(:,:,:,nr)!so that nr=2 also is defined - do j=1,ljmax - do i=1,limax - pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0!guarantees precip at surface - do k=1,KMAX_MID-1 - if(cw_met(i,j,k,2)+cw_met(i,j,k,1)>CW_THRESHOLD)then - !fill the column up to this level with constant precip - do kk=k,KMAX_MID-1 - pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!from m/s to mm/METSTEP - enddo - exit - else - pr(i,j,k)=0.0 - endif - enddo - enddo - enddo - - else - !will use RH to determine the height of release (less accurate than cloudwater) - if(write_now)write(*,*)'release height for 3D precipitations derived from humidity' - if(MasterProc.and.first_call)write(unit=IO_LOG,fmt="(a)")& - "3D precipitations: derived from 2D and humidity" - do j=1,ljmax - do i=1,limax - pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0!guarantees precip at surface - do k=1,KMAX_MID-1 - !convert from potential temperature into absolute temperature - temperature = th(i,j,k,nr)*exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,nr))*1.e-5))!Pa, Ps in Pa here - !saturation water pressure - swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) - !water pressure - wp=q(i,j,k,nr)*(A_mid(k) + B_mid(k)*ps(i,j,nr))/0.622!Ps in Pa here - relh2=wp/swp - !convert from potential temperature into absolute temperature - !Ps in Pa here - temperature = th(i,j,k,1)* & - exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,1))*1.e-5))!Ps in Pa here - !saturation water pressure - swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) - !water pressure - wp=q(i,j,k,1)*(A_mid(k) + B_mid(k)*ps(i,j,1))/0.622!Ps in Pa here - relh1=wp/swp - if(relh1>RH_THRESHOLD.or.relh2>RH_THRESHOLD)then - !fill the column up to this level with constant precip - do kk=k,KMAX_MID-1 - pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!3hours and m->mm - enddo - exit - else - pr(i,j,k)=0.0 - endif - enddo - enddo - enddo - endif - endif - pr=max(0.0,pr)*divt ! positive precipitation in mm/s - - ! surface precipitation, mm/hr - !NB: surface_precip is different than the one read directly from the - !metfile (which has different units, and is the sum of the 2D - !large_scale_precipitations+convective_precipitations) - - surface_precip(:,:) = pr(:,:,KMAX_MID) * inv_METSTEP - - if(USE_CONVECTION)then - cnvuf=max(0.0,cnvuf) !no negative upward fluxes - cnvuf(:,:,KMAX_BND)=0.0 !no flux through surface - cnvuf(:,:,1)=0.0 !no flux through top - cnvdf=min(0.0,cnvdf) !no positive downward fluxes - cnvdf(:,:,KMAX_BND)=0.0 !no flux through surface - cnvdf(:,:,1)=0.0 !no flux through top - - ! Sometimes the NWP calculated fluxes are too high. - ! can be scaled via config: - if( abs( CONVECTION_FACTOR - 1 ) > 0.001 ) then - cnvuf(:,:,:) = cnvuf(:,:,:) * CONVECTION_FACTOR - cnvdf(:,:,:) = cnvdf(:,:,:) * CONVECTION_FACTOR - end if - endif - - ! Kz from meteo - if(NWP_Kz) then - if(.not.foundKz_met.and.MasterProc.and.first_call)& - write(*,*)' WARNING: Kz will be derived in model ' - if(foundKz_met)Kz_met=max(0.0,Kz_met) ! only positive Kz - endif - - !============== 2D fields (surface) (i,j) ============================ - ndim=2 - - ! conversion of pressure from hPa to Pascal. - !ps(:,:,nr) = ps(:,:,nr)*PASCAL moved higher up! - - - if(foundrh2m)then - rh2m(:,:,nr) = 0.01 * rh2m(:,:,nr) ! Convert from % to fraction - else - if(MasterProc.and.first_call)write(*,*)'WARNING: relative_humidity_2m not found' - rh2m(:,:,nr) = -999.9 ! ? - endif + do k=1,kmax_mid + pr(i,j,k)=0.0 + end do + end if + end do + end do + + elseif(foundcloudwater)then + + if(write_now)& + write(*,*)'release height for 3D precipitations derived from cloudwater' + if(MasterProc.and.first_call)& + write(IO_LOG,*)"3D precipitations: derived from 2D and cloudwater" + if(nr==1)cw_met(:,:,:,2)=cw_met(:,:,:,nr)!so that nr=2 also is defined + do j=1,ljmax + do i=1,limax + pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0!guarantees precip at surface + do k=1,KMAX_MID-1 + if(cw_met(i,j,k,2)+cw_met(i,j,k,1)>CW_THRESHOLD)then + !fill the column up to this level with constant precip + do kk=k,KMAX_MID-1 + pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!from m/s to mm/METSTEP + end do + exit + else + pr(i,j,k)=0.0 + end if + end do + end do + end do - if(WRF_MET_CORRECTIONS)then - !flux defined with opposite signs - fh(:,:,nr)=-fh(:,:,nr) - fl(:,:,nr)=-fl(:,:,nr) - sst=max(273.0,sst)!WRF set land sst to zero - SoilWater_uppr(:,:,nr)=(SoilWater_uppr(:,:,nr)-0.05)*3!rough conversion wrf->SMI . Can be improved! - SoilWater_deep(:,:,nr)=(SoilWater_deep(:,:,nr)-0.05)*3!rough conversion wrf->SMI . Can be improved! - endif - - if(LANDIFY_MET)then - call landify(t2_nwp(:,:,nr),"t2nwp") - call landify(rh2m(:,:,nr),"rh2m") - call landify(fh(:,:,nr),"fh") - call landify(fl(:,:,nr),"fl") - if(foundtau)call landify(tau(:,:,nr),"tau") - endif - - if(met(ix_fh)%validity=='averaged')fh(:,:,1)=fh(:,:,nr) - - if(met(ix_fl)%validity=='averaged')fl(:,:,1)=fl(:,:,nr) - - if(foundtau)then - tau=max(0.0,tau) - if(met(ix_tau)%validity=='averaged')tau(:,:,1)=tau(:,:,nr) else - ! For WRF we get u*, not tau. Since it seems better to - ! interpolate tau than u* between time-steps we convert - if(write_now)write(*,*)' tau derived from ustar_nwp' - namefield=met(ix_ustar_nwp)%name - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& - ustar_nwp(:,:),needed=.true.,found=foundustar) - if(LANDIFY_MET) call landify(ustar_nwp(:,:),"ustar") - !Ps in Pa here - rho_surf(1:limax,1:ljmax) = ps(1:limax,1:ljmax,nr)/(RGAS_KG * t2_nwp(1:limax,1:ljmax,nr) ) - tau(1:limax,1:ljmax,nr) = ustar_nwp(1:limax,1:ljmax)*ustar_nwp(1:limax,1:ljmax)* rho_surf(1:limax,1:ljmax) - endif - - if(.not.foundSST.and.write_now)write(*,*)' WARNING: sea_surface_temperature not found ' + !will use RH to determine the height of release (less accurate than cloudwater) + if(write_now)write(*,*)'release height for 3D precipitations derived from humidity' + if(MasterProc.and.first_call)write(unit=IO_LOG,fmt="(a)")& + "3D precipitations: derived from 2D and humidity" + do j=1,ljmax + do i=1,limax + pr(i,j,KMAX_MID)= surface_precip(i,j)*METSTEP*3600.0*1000.0!guarantees precip at surface + do k=1,KMAX_MID-1 + !convert from potential temperature into absolute temperature + temperature = th(i,j,k,nr)*exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,nr))*1.e-5))!Pa, Ps in Pa here + !saturation water pressure + swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) + !water pressure + wp=q(i,j,k,nr)*(A_mid(k) + B_mid(k)*ps(i,j,nr))/0.622!Ps in Pa here + relh2=wp/swp + !convert from potential temperature into absolute temperature + !Ps in Pa here + temperature = th(i,j,k,1)* & + exp(KAPPA*log((A_mid(k) + B_mid(k)*ps(i,j,1))*1.e-5))!Ps in Pa here + !saturation water pressure + swp=611.2*exp(17.67*(temperature-273.15)/(temperature-29.65)) + !water pressure + wp=q(i,j,k,1)*(A_mid(k) + B_mid(k)*ps(i,j,1))/0.622!Ps in Pa here + relh1=wp/swp + if(relh1>RH_THRESHOLD.or.relh2>RH_THRESHOLD)then + !fill the column up to this level with constant precip + do kk=k,KMAX_MID-1 + pr(i,j,kk)= surface_precip(i,j)*METSTEP*3600.0*1000.0!3hours and m->mm + end do + exit + else + pr(i,j,k)=0.0 + end if + end do + end do + end do + end if + end if ! .not.foundprecip + pr=max(0.0,pr)*divt ! positive precipitation in mm/s + + ! surface precipitation, mm/hr + ! NB: surface_precip is different than the one read directly from the + ! metfile (which has different units, and is the sum of the 2D + ! large_scale_precipitations+convective_precipitations) + surface_precip(:,:) = pr(:,:,KMAX_MID) * inv_METSTEP + + if(USE_CONVECTION)then + cnvuf=max(0.0,cnvuf) !no negative upward fluxes + cnvuf(:,:,KMAX_BND)=0.0 !no flux through surface + cnvuf(:,:,1)=0.0 !no flux through top + cnvdf=min(0.0,cnvdf) !no positive downward fluxes + cnvdf(:,:,KMAX_BND)=0.0 !no flux through surface + cnvdf(:,:,1)=0.0 !no flux through top + + ! Sometimes the NWP calculated fluxes are too high. + ! can be scaled via config: + if( abs( CONVECTION_FACTOR - 1 ) > 0.001 ) then + cnvuf(:,:,:) = cnvuf(:,:,:) * CONVECTION_FACTOR + cnvdf(:,:,:) = cnvdf(:,:,:) * CONVECTION_FACTOR + end if + end if + + ! Kz from meteo + if(NWP_Kz) then + if(foundKz_met)then + Kz_met=max(0.0,Kz_met) ! only positive Kz + elseif(MasterProc.and.first_call)then + write(*,*)' WARNING: Kz will be derived in model ' + end if + end if + + !============== 2D fields (surface) (i,j) ============================ + ndim=2 + + if(foundrh2m)then + rh2m(:,:,nr) = 0.01 * rh2m(:,:,nr) ! Convert from % to fraction + else + if(MasterProc.and.first_call)& + write(*,*)'WARNING: relative_humidity_2m not found' + rh2m(:,:,nr) = -999.9 ! ? + end if + + if(WRF_MET_CORRECTIONS)then + ! flux defined with opposite signs + fh(:,:,nr)=-fh(:,:,nr) + fl(:,:,nr)=-fl(:,:,nr) + sst=max(273.0,sst)!WRF set land sst to zero + ! rough conversion wrf->SMI . Can be improved! + SoilWater_uppr(:,:,nr)=(SoilWater_uppr(:,:,nr)-0.05)*3 + SoilWater_deep(:,:,nr)=(SoilWater_deep(:,:,nr)-0.05)*3 + end if + + if(LANDIFY_MET)then + call landify(t2_nwp(:,:,nr),"t2nwp") + call landify(rh2m(:,:,nr),"rh2m") + call landify(fh(:,:,nr),"fh") + call landify(fl(:,:,nr),"fl") + if(foundtau)call landify(tau(:,:,nr),"tau") + end if + + if(met(ix_fh)%validity=='averaged')fh(:,:,1)=fh(:,:,nr) + + if(met(ix_fl)%validity=='averaged')fl(:,:,1)=fl(:,:,nr) + + if(foundtau)then + tau=max(0.0,tau) + if(met(ix_tau)%validity=='averaged')tau(:,:,1)=tau(:,:,nr) + else + ! For WRF we get u*, not tau. Since it seems better to + ! interpolate tau than u* between time-steps we convert + if(write_now)write(*,*)' tau derived from ustar_nwp' + namefield=met(ix_ustar_nwp)%name + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& + ustar_nwp(:,:),needed=.true.,found=foundustar) + if(LANDIFY_MET) call landify(ustar_nwp(:,:),"ustar") + !Ps in Pa here + forall(i=1:limax,j=1:ljmax) + rho_surf(i,j) = ps(i,j,nr)/(RGAS_KG*t2_nwp(i,j,nr) ) + tau(i,j,nr) = ustar_nwp(i,j)*ustar_nwp(i,j)*rho_surf(i,j) + end forall + end if + if(.not.foundSST.and.write_now)& + write(*,*)' WARNING: sea_surface_temperature not found ' + + ! Soil water fields. Somewhat tricky. + ! Ideal is soil moisture index, available from IFS, = (SW-PWP)/(FC-PWP) + ! Otherwise m3/m3 or m units are converted + ! + ! Start with shallow + + call CheckStop(USE_DUST.and..not.USE_SOILWATER,"Inconsistent SM, DUST") + + if(USE_SOILWATER) then ! Soil water fields. Somewhat tricky. ! Ideal is soil moisture index, available from IFS, = (SW-PWP)/(FC-PWP) ! Otherwise m3/m3 or m units are converted ! ! Start with shallow - - call CheckStop(USE_DUST.and..not.USE_SOILWATER,"Inconsistent SM, DUST") - - if(USE_SOILWATER) then - ! Soil water fields. Somewhat tricky. - ! Ideal is soil moisture index, available from IFS, = (SW-PWP)/(FC-PWP) - ! Otherwise m3/m3 or m units are converted - ! - ! Start with shallow - if(.not.foundSoilWater_uppr) then - foundSMI1=.false. - do isw = 1, size(possible_soilwater_uppr) - namefield=possible_soilwater_uppr(isw) - if((DEBUG_SOILWATER.or.first_call).and.MasterProc) write(*,*) "Met_ml: soil water search ",isw,trim(namefield) - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,SoilWater_uppr(:,:,nr),found=foundSoilWater_uppr) - if(foundSoilWater_uppr) then ! found - foundSMI1=(index(namefield,"SMI")>0) - exit - endif - enddo - if(foundSMI1.and.MasterProc.and.first_call) & ! = 1st call - call PrintLog("Met: found SMI1:"//trim(namefield)) - if(foundSoilWater_uppr.and.trim(unit)=="m") SoilWaterSource="PARLAM" - endif ! upper - - if(.not.foundSoilWater_deep) then !just deep here - foundSMI3=.false. - do isw = 1, size(possible_soilwater_deep) - namefield=possible_soilwater_deep(isw) - if(DomainName=="HIRHAM") then - if(MasterProc.and.first_call)write(*,*) " Rename soil water in HIRHAM" - namefield='soil_water_second_layer' - endif - if(MasterProc.and.first_call) write(*,*) "Met_ml: deep soil water search ", isw, trim(namefield) - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& - SoilWater_deep(:,:,nr),found=foundSoilWater_deep) - if(foundSoilWater_deep) then ! found - foundSMI3=(index(namefield,"SMI")>0) - if(.not.foundSMI3) & ! = 1st call - call PrintLog("Met: found SMI3:"//trim( namefield), MasterProc) - exit - endif - enddo - if(foundSoilWater_deep ) then - if(trim(unit)=="m") then ! PARLAM has metres of water - SoilWaterSource = "PARLAM" - elseif(unit(1:5)=='m3/m3')then - SoilWaterSource = "IFS" - endif - endif !found deep_soil_water_content - endif ! - if(SoilWaterSource == "IFS")then - if(first_call)then - !needed for transforming IFS soil water - call ReadField_CDF('SoilTypes_IFS.nc','pwp',pwp, & - 1,interpol='conservative',needed=.true.,UnDef=-999.,debug_flag=.false.) - call ReadField_CDF('SoilTypes_IFS.nc','fc',fc, & - 1,interpol='conservative',needed=.true.,UnDef=-999.,debug_flag=.false.) - - ! landify(x,intxt,xmin,xmax,wfmin,xmask) - ! We use a global mask for water_fraction < 100%, but set wfmin to 1.0 - ! to allow all grids with some land to be processed - ! Fc and PWP should be above zero and below 1, let's use 0.8 - - call landify( pwp(:,:), " PWP ", & - 0.0, 0.8, 1.0, water_fraction < 1.0 ) ! mask for where there is land - call landify( fc(:,:), " FC ", & - 0.0, 0.8, 1.0, water_fraction < 1.0 ) ! mask for where there is land - do i = 1, limax - do j = 1, ljmax - if( fc(i,j) > pwp(i,j) ) then ! Land values - tmpmax = -0.99 * pwp(i,j)/(fc(i,j)-pwp(i,j) ) - SoilWater_uppr(i,j,nr) = max( tmpmax, SoilWater_uppr(i,j,nr) ) - else - SoilWater_uppr(i,j,nr) = -999. ! NOT NEEDED???? - end if - end do - end do - endif - - endif - if(foundSMI3.or.foundSoilWater_deep)then - if ( water_frac_set ) then ! smooth the SoilWater values: - - ! If NWP thinks this is a sea-square, but we anyway have land, - ! the soil moisture might be very strange. We search neighbouring - ! grids and make a land-weighted mean SW - ! Skip on 1st numt, since water fraction set a little later. No harm done... - ! changed landify routine to accept water_fraction as mask. Should - ! works almost the same as code below did. - ! Should move later also, after other units converted to SMI - ! NB Some grid squares in EECCA have water cover of 99.998 - call landify( SoilWater_deep(:,:,nr), "SMI_DEEP", & - 0.0, 1.0, 1.0, water_fraction < 1.0 ) - ! Allow some negative SMI for upper levels - call landify( SoilWater_uppr(:,:,nr), "SMI_UPPR", & - -1.0, 1.0, 1.0, water_fraction < 1.0 ) - else ! water_frac not set yet - call CheckStop("ERROR, Met_ml: SMD not set!! here" ) - endif ! water_frac_set test - endif ! - - ! SMI = (SW-PWP)/((FC-PWP), therefore min SMI value should be -PWP/(FC-PWP) - ! Let's use 99% of this: - if ( SoilWaterSource == "IFS") then !MAR2013 - do i = 1, limax - do j = 1, ljmax - if( fc(i,j) > pwp(i,j) ) then ! Land values - tmpmax = -0.99 * pwp(i,j)/(fc(i,j)-pwp(i,j) ) - SoilWater_uppr(i,j,nr) = max( tmpmax, SoilWater_uppr(i,j,nr) ) - else - SoilWater_uppr(i,j,nr) = -999. ! NOT NEEDED???? - end if - end do + if(.not.foundSoilWater_uppr) then + foundSMI1=.false. + do isw = 1, size(possible_soilwater_uppr) + namefield=possible_soilwater_uppr(isw) + if((DEBUG_SOILWATER.or.first_call).and.MasterProc) write(*,*) "Met_ml: soil water search ",isw,trim(namefield) + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,SoilWater_uppr(:,:,nr),found=foundSoilWater_uppr) + if(foundSoilWater_uppr) then ! found + foundSMI1=(index(namefield,"SMI")>0) + exit + end if + end do + if(foundSMI1.and.MasterProc.and.first_call) & ! = 1st call + call PrintLog("Met: found SMI1:"//trim(namefield)) + if(foundSoilWater_uppr.and.trim(unit)=="m") SoilWaterSource="PARLAM" + end if ! upper + + if(.not.foundSoilWater_deep) then !just deep here + foundSMI3=.false. + do isw = 1, size(possible_soilwater_deep) + namefield=possible_soilwater_deep(isw) + if(DomainName=="HIRHAM") then + if(MasterProc.and.first_call)write(*,*) " Rename soil water in HIRHAM" + namefield='soil_water_second_layer' + end if + if(MasterProc.and.first_call) write(*,*) "Met_ml: deep soil water search ", isw, trim(namefield) + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& + SoilWater_deep(:,:,nr),found=foundSoilWater_deep) + if(foundSoilWater_deep) then ! found + foundSMI3=(index(namefield,"SMI")>0) + if(.not.foundSMI3) & ! = 1st call + call PrintLog("Met: found SMI3:"//trim(namefield), MasterProc) + exit + end if + end do + if(foundSoilWater_deep ) then + if(trim(unit)=="m") then ! PARLAM has metres of water + SoilWaterSource = "PARLAM" + elseif(unit(1:5)=='m3/m3')then + SoilWaterSource = "IFS" + end if + end if !found deep_soil_water_content + end if ! + + if(SoilWaterSource == "IFS")then + if(first_call)then + !needed for transforming IFS soil water + call ReadField_CDF('SoilTypes_IFS.nc','pwp',pwp, 1,& + interpol='conservative',needed=.true.,UnDef=-999.,debug_flag=.false.) + call ReadField_CDF('SoilTypes_IFS.nc','fc',fc, 1,& + interpol='conservative',needed=.true.,UnDef=-999.,debug_flag=.false.) + + ! landify(x,intxt,xmin,xmax,wfmin,xmask) + ! We use a global mask for water_fraction < 100%, but set wfmin to 1.0 + ! to allow all grids with some land to be processed + ! Fc and PWP should be above zero and below 1, let's use 0.8 + + call landify( pwp(:,:), " PWP ", & + 0.0, 0.8, 1.0, water_fraction < 1.0 ) ! mask for where there is land + call landify( fc(:,:), " FC ", & + 0.0, 0.8, 1.0, water_fraction < 1.0 ) ! mask for where there is land + do i = 1, limax + do j = 1, ljmax + if( fc(i,j) > pwp(i,j) ) then ! Land values + tmpmax = -0.99 * pwp(i,j)/(fc(i,j)-pwp(i,j) ) + SoilWater_uppr(i,j,nr) = max( tmpmax, SoilWater_uppr(i,j,nr) ) + else + SoilWater_uppr(i,j,nr) = -999. ! NOT NEEDED???? + end if end do - end if !MAR2013 test + end do + end if + end if - ! MAR2013 adding back PARLAM SMI calcs: - ! with hard-coded FC value of 0.02 (cm) - if( SoilWaterSource == "PARLAM")then - !SoilMax = 0.02 - SoilWater_deep(:,:,nr) = SoilWater_deep(:,:,nr) / 0.02 !SoilMax - SoilWater_uppr(:,:,nr) = SoilWater_uppr(:,:,nr) / 0.02 !SoilMax - end if - -! We should now have SMI regardless of soil water data source. We -! restrict this to be in range 0 --- 1 for deep soil water. -! For upper-soil water, we allow some negative, since evaporation can dry the soil -! bellow the PWP. -! SoilWater_deep(:,:,nr) = max(0.0, SoilWater_deep(:,:,nr) ) + if(foundSMI3.or.foundSoilWater_deep)then + if ( water_frac_set ) then ! smooth the SoilWater values: + + ! If NWP thinks this is a sea-square, but we anyway have land, + ! the soil moisture might be very strange. We search neighbouring + ! grids and make a land-weighted mean SW + ! Skip on 1st numt, since water fraction set a little later. No harm done... + ! changed landify routine to accept water_fraction as mask. Should + ! works almost the same as code below did. + ! Should move later also, after other units converted to SMI + ! NB Some grid squares in EECCA have water cover of 99.998 + call landify( SoilWater_deep(:,:,nr), "SMI_DEEP", & + 0.0, 1.0, 1.0, water_fraction < 1.0 ) + ! Allow some negative SMI for upper levels + call landify( SoilWater_uppr(:,:,nr), "SMI_UPPR", & + -1.0, 1.0, 1.0, water_fraction < 1.0 ) + else ! water_frac not set yet + call CheckStop("ERROR, Met_ml: SMD not set!! here" ) + end if ! water_frac_set test + end if ! + + ! SMI = (SW-PWP)/((FC-PWP), therefore min SMI value should be -PWP/(FC-PWP) + ! Let's use 99% of this: + if ( SoilWaterSource == "IFS") then !MAR2013 + do i = 1, limax + do j = 1, ljmax + if( fc(i,j) > pwp(i,j) ) then ! Land values + tmpmax = -0.99 * pwp(i,j)/(fc(i,j)-pwp(i,j) ) + SoilWater_uppr(i,j,nr) = max( tmpmax, SoilWater_uppr(i,j,nr) ) + else + SoilWater_uppr(i,j,nr) = -999. ! NOT NEEDED???? + end if + end do + end do + end if !MAR2013 test + + ! PARLAM SMI calc: hard-coded FC value of 0.02 (cm) + if( SoilWaterSource == "PARLAM")then + !SoilMax = 0.02 + SoilWater_deep(:,:,nr) = SoilWater_deep(:,:,nr) / 0.02 !SoilMax + SoilWater_uppr(:,:,nr) = SoilWater_uppr(:,:,nr) / 0.02 !SoilMax + end if - SoilWater_deep(:,:,nr) = max(0.0, SoilWater_deep(:,:,nr) ) - SoilWater_uppr(:,:,nr) = min(1.0, SoilWater_uppr(:,:,nr)) - SoilWater_deep(:,:,nr) = min(1.0, SoilWater_deep(:,:,nr) ) + ! We should now have SMI regardless of soil water data source. + ! We restrict this to be in range 0 --- 1 for deep soil water. + ! For upper-soil water, we allow some negative, since evaporation + ! can dry the soil bellow the PWP. + SoilWater_deep(:,:,nr) = max(0.0, SoilWater_deep(:,:,nr) ) + SoilWater_uppr(:,:,nr) = min(1.0, SoilWater_uppr(:,:,nr)) + SoilWater_deep(:,:,nr) = min(1.0, SoilWater_deep(:,:,nr) ) - endif ! USE_SOILWATER + end if ! USE_SOILWATER - !======================================== + !======================================== - if(.not.foundsdepth.and.write_now)write(*,*)' WARNING: snow_depth not found ' + if(.not.foundsdepth.and.write_now)& + write(*,*)' WARNING: snow_depth not found ' - if(.not.foundice.and.write_now)write(*,*)' WARNING: ice_nwp coverage (%) not found ' + if(.not.foundice.and.write_now)& + write(*,*)' WARNING: ice_nwp coverage (%) not found ' + if(foundws10_met)then + namefield='v10' !second component of ws_10m + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& + buff(:,:),needed=.false.,found=foundws10_met) + if(.not.foundws10_met)then + namefield='V10' !second component of ws_10m + call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& + buff(:,:),found=foundws10_met) + end if if(foundws10_met)then - namefield='v10' !second component of ws_10m - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& - buff(:,:),needed=.false.,found=foundws10_met) - if(.not.foundws10_met)then - namefield='V10' !second component of ws_10m - call Getmeteofield(meteoname,namefield,nrec,ndim,unit,validity,& - buff(:,:),found=foundws10_met) - endif - if(foundws10_met)then - if(write_now)write(*,*)' found v component of 10m wind ' - ws_10m(:,:,nr)=sqrt(ws_10m(:,:,nr)**2+buff(:,:)**2) - if(LANDIFY_MET) call landify(ws_10m(:,:,nr),"WS10") - endif - endif - - - ! derive the meteorological parameters from the basic parameters - ! read from field-files. + if(write_now)write(*,*)' found v component of 10m wind ' + ws_10m(:,:,nr)=sqrt(ws_10m(:,:,nr)**2+buff(:,:)**2) + if(LANDIFY_MET) call landify(ws_10m(:,:,nr),"WS10") + end if + end if - do j = 1,ljmax - do i = 1,limax - p1 = A_bnd(KMAX_BND)+B_bnd(KMAX_BND)*ps(i,j,nr) - - exf1(KMAX_BND) = CP * Exner_nd(p1) - - z_bnd(i,j,KMAX_BND) = 0.0 - - do k = KMAX_MID,1,-1 - - ! eddy diffusivity in the surface-layer follows the - ! formulation usedin the nwp-model which is based on - ! Louis (1979), (see mc7e.f). - ! exner-function of the half-layers - - p1 = A_bnd(k)+B_bnd(k)*ps(i,j,nr) - exf1(k) = CP * Exner_nd( p1 ) - - ! exner-function of the full-levels - p2 = A_mid(k)+B_mid(k)*ps(i,j,nr) - exf2(k) = CP * Exner_nd(p2) - - ! height of the half-layers - z_bnd(i,j,k) = z_bnd(i,j,k+1) + (th(i,j,k,nr)* & - (exf1(k+1) - exf1(k)))/GRAV - - ! height of the full levels. - z_mid(i,j,k) = z_bnd(i,j,k+1) + (th(i,j,k,nr)* & - (exf1(k+1) - exf2(k)))/GRAV - -! roa(i,j,k,nr) = CP*(A_mid(k)+B_mid(k)*ps(i,j,nr))/ & -! (RGAS_KG*th(i,j,k,nr)*exf2(k)) -!We derive density from pressure and heights, so that they are consistent. - roa(i,j,k,nr) = (dA(k)+dB(k)*ps(i,j,nr))/& - (GRAV*(z_bnd(i,j,k)-z_bnd(i,j,k+1))) - - enddo ! k - - enddo - enddo - - - if(foundsdot.and.sdot_at_mid)then - ! interpolation of sigma dot for bnd (half layers) - do k = KMAX_MID,2,-1 - sdot(i,j,k,nr) = sdot(i,j,k-1,nr) & - + (sdot(i,j,k,nr)-sdot(i,j,k-1,nr)) & - * (sigma_bnd(k)-sigma_mid(k-1)) & - / (sigma_mid(k)-sigma_mid(k-1)) - enddo - endif - ! set sdot equal to zero at the top and bottom of atmosphere. - sdot(:,:,KMAX_BND,nr)=0.0 - sdot(:,:,1,nr)=0.0 - Etadot(:,:,KMAX_BND,nr)=0.0 - Etadot(:,:,1,nr)=0.0 - if(.not.foundsdot .and. .not.met(ix_Etadot)%found)then - if(write_now)write(*,*)'WARNING: Etadot derived from horizontal winds ' - ! sdot derived from divergence=0 principle - do j = 1,ljmax - do i = 1,limax - Ps_extended(i,j) = Ps(i,j,nr) - enddo - enddo - !Get Ps at edges from neighbors - !we reuse usnd, vsnd etc - if (neighbor(EAST) .ne. NOPROC) then - usnd(:,1) = ps(limax,:,nr) - CALL MPI_ISEND( usnd, 8*LJMAX, MPI_BYTE, & - neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) - endif - if (neighbor(NORTH) .ne. NOPROC) then - vsnd(:,1) = ps(:,ljmax,nr) - CALL MPI_ISEND( vsnd , 8*LIMAX, MPI_BYTE, & - neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) - endif - ! receive from WEST neighbor if any - if (neighbor(WEST) .ne. NOPROC) then - CALL MPI_RECV( urcv, 8*LJMAX, MPI_BYTE, & - neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) - Ps_extended(0,1:ljmax) = urcv(1:ljmax,1) - else - Ps_extended(0,1:ljmax) = Ps_extended(1,1:ljmax) - endif - ! receive from SOUTH neighbor if any - if (neighbor(SOUTH) .ne. NOPROC) then - CALL MPI_RECV( vrcv, 8*LIMAX, MPI_BYTE, & - neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) - Ps_extended(1:limax,0) = vrcv(1:limax,1) - else - Ps_extended(1:limax,0) = Ps_extended(1:limax,1) - endif - if (neighbor(WEST) .ne. NOPROC) then - usnd(:,2) = ps(1,:,nr) - CALL MPI_ISEND( usnd(1,2), 8*LJMAX, MPI_BYTE, & - neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, request_w, IERROR) - endif - if (neighbor(SOUTH) .ne. NOPROC) then - vsnd(:,2) = ps(:,1,nr) - CALL MPI_ISEND( vsnd(1,2) , 8*LIMAX, MPI_BYTE, & - neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, request_s, IERROR) - endif - - ! receive from EAST neighbor if any - if (neighbor(EAST) .ne. NOPROC) then - CALL MPI_RECV( urcv, 8*LJMAX, MPI_BYTE, & - neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) - Ps_extended(limax+1,1:ljmax) = urcv(1:ljmax,1) - else - Ps_extended(limax+1,1:ljmax) = Ps_extended(limax,1:ljmax) - endif - ! receive from NORTH neighbor if any - if (neighbor(NORTH) .ne. NOPROC) then - CALL MPI_RECV( vrcv, 8*LIMAX, MPI_BYTE, & - neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) - Ps_extended(1:limax,ljmax+1) = vrcv(1:limax,1) - else - Ps_extended(1:limax,ljmax+1) = Ps_extended(1:limax,ljmax) - endif - - if (neighbor(EAST) .ne. NOPROC) then - CALL MPI_WAIT(request_e, MPISTATUS, IERROR) - endif - - if (neighbor(NORTH) .ne. NOPROC) then - CALL MPI_WAIT(request_n, MPISTATUS, IERROR) - endif - if (neighbor(WEST) .ne. NOPROC) then - CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif - - if (neighbor(SOUTH) .ne. NOPROC) then - CALL MPI_WAIT(request_s, MPISTATUS, IERROR) - endif - - do j = 1,ljmax - do i = 1,limax - Pmid=Ps_extended(i,j)-PT - Pu1=0.5*(Ps_extended(i-1,j)+Ps_extended(i,j))-PT - Pu2=0.5*(Ps_extended(i+1,j)+Ps_extended(i,j))-PT - Pv1=0.5*(Ps_extended(i,j-1)+Ps_extended(i,j))-PT - Pv2=0.5*(Ps_extended(i,j+1)+Ps_extended(i,j))-PT - - sdot(i,j,KMAX_BND,nr)=0.0 - sdot(i,j,1,nr)=0.0 - sumdiv=0.0 - do k=1,KMAX_MID - divk(k)=((u_xmj(i,j,k,nr)*Pu2-u_xmj(i-1,j,k,nr)*Pu1) & - + (v_xmi(i,j,k,nr)*Pv2-v_xmi(i,j-1,k,nr)*Pv1)) & - * xm2(i,j)*(sigma_bnd(k+1)-sigma_bnd(k)) & - / GRIDWIDTH_M/Pmid - sumdiv=sumdiv+divk(k) - enddo - ! sdot(i,j,KMAX_MID,nr)=-(sigma_bnd(KMAX_MID+1)-sigma_bnd(KMAX_MID))& - ! *sumdiv+divk(KMAX_MID) - do k=KMAX_MID,1,-1 - sdot(i,j,k,nr)=sdot(i,j,k+1,nr)-(sigma_bnd(k+1)-sigma_bnd(k))& - *sumdiv+divk(k) - enddo - enddo - enddo - - !new method introduced 26/2-2013 - !Old method sigma=(P-PT)/(ps-pt); new method uses Eta=A/Pref+B; the method differ. - !see http://www.ecmwf.int/research/ifsdocs/DYNAMICS/Chap2_Discretization3.html#959545 - - !(note that u_xmj and v_xmi have already been divided by xm here) - dB_sum=1.0/(B_bnd(KMAX_MID+1)-B_bnd(1))!normalisation factor for dB (should be one if entire atmosphere is included) - - do j = 1,ljmax - do i = 1,limax - Pmid=Ps_extended(i,j)! without "-PT" - !surface pressure at gridcell boundaries - Pu1=0.5*(Ps_extended(i-1,j)+Ps_extended(i,j)) - Pu2=0.5*(Ps_extended(i+1,j)+Ps_extended(i,j)) - Pv1=0.5*(Ps_extended(i,j-1)+Ps_extended(i,j)) - Pv2=0.5*(Ps_extended(i,j+1)+Ps_extended(i,j)) - - sumdiv=0.0 - do k=1,KMAX_MID - divk(k)=((u_xmj(i,j,k,nr)*(dA(k)+dB(k)*Pu2)-u_xmj(i-1,j,k,nr)*(dA(k)+dB(k)*Pu1)) & - + (v_xmi(i,j,k,nr)*(dA(k)+dB(k)*Pv2)-v_xmi(i,j-1,k,nr)*(dA(k)+dB(k)*Pv1))) & - * xm2(i,j)/ GRIDWIDTH_M - sumdiv=sumdiv+divk(k) - enddo - - Etadot(i,j,KMAX_MID+1,nr)=0.0 - do k=KMAX_MID,1,-1 - Etadot(i,j,k,nr)=Etadot(i,j,k+1,nr)-dB(k)*dB_sum*sumdiv+divk(k) - Etadot(i,j,k+1,nr)=Etadot(i,j,k+1,nr)*(dA(k)/Pref+dB(k))/(dA(k)+dB(k)*Pmid) - ! Etadot(i,j,k+1,nr)=Etadot(i,j,k+1,nr)/(Ps_extended(i,j)-PT) gives same result as sdot for sigma coordinates - enddo - Etadot(i,j,1,nr)=0.0! Is zero anyway from relations above - enddo - enddo - - if(MANUAL_GRID)then - !around the north pole the interpolation of wind fields is not accurate, - !and we cannot rely on continuity to derive the vertical winds. - !Brutal: set Etadot to 0! - do k=1,KMAX_MID,1 - do j = 1,ljmax - do i = 1,limax - if(glat(i,j)>88.0)Etadot(i,j,k,nr)=0.0 - enddo - enddo - enddo - endif - - endif - if(met(ix_Etadot)%found)then - call CheckStop(.not.USE_EtaCOORDINATES,& - "Conflict: requested etadot, but does not use eta coordinates") - !convert from mid values to boundary values - if(write_now)write(*,*)'interpolating etadot from mid to boundary levels' - do k = KMAX_MID,2,-1 - do j = 1,ljmax - do i = 1,limax - Etadot(i,j,k,nr) = Etadot(i,j,k-1,nr) & - + (Etadot(i,j,k,nr)-Etadot(i,j,k-1,nr)) & - * (Eta_bnd(k)-Eta_mid(k-1)) & - / (Eta_mid(k)-Eta_mid(k-1)) - enddo - enddo - enddo - Etadot(:,:,1,nr)=0.0!no exchanges above top (should not be useed anyway) - endif - call met_derived(nr) !compute derived meteo fields used in BLPhysics + ! derive the meteorological parameters from the basic parameters + ! read from field-files. + do j = 1,ljmax + do i = 1,limax + p1 = A_bnd(KMAX_BND)+B_bnd(KMAX_BND)*ps(i,j,nr) - call BLPhysics() + exf1(KMAX_BND) = CP * Exner_nd(p1) - call met_derived(1) !compute derived meteo fields for nr=1 "now" + z_bnd(i,j,KMAX_BND) = 0.0 - !windspeed of neighbor subdomains at edges (used for advection) - !It the windspeed divided by xm which must be used here. -! send to WEST neighbor if any - if (neighbor(WEST) .ne. NOPROC) then - if(neighbor(WEST) .ne. me)then - buf_uw(:,:) = u_xmj(1,:,:,nr) - CALL MPI_ISEND(buf_uw, 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(WEST), MSG_EAST2, MPI_COMM_CALC, request_w, IERROR) - else - ! cyclic grid: own neighbor - ue(:,:,nr) = u_xmj(1,:,:,nr) - endif - endif + do k = KMAX_MID,1,-1 + ! eddy diffusivity in the surface-layer follows the + ! formulation usedin the nwp-model which is based on + ! Louis (1979), (see mc7e.f). + ! exner-function of the half-layers -! send to EAST neighbor if any - if (neighbor(EAST) .ne. NOPROC) then - if (neighbor(EAST) .ne. me) then - buf_ue(:,:) = u_xmj(limax-1,:,:,nr) - CALL MPI_ISEND(buf_ue, 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) - else - ! cyclic grid: own neighbor - uw(:,:,nr) = u_xmj(limax-1,:,:,nr) - endif - endif + p1 = A_bnd(k)+B_bnd(k)*ps(i,j,nr) + exf1(k) = CP * Exner_nd( p1 ) -! send to SOUTH neighbor if any - if (neighbor(SOUTH) .ne. NOPROC) then - buf_vs(:,:) = v_xmi(:,1,:,nr) - CALL MPI_ISEND(buf_vs, 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(SOUTH), MSG_NORTH2, MPI_COMM_CALC, request_s, IERROR) - endif + ! exner-function of the full-levels + p2 = A_mid(k)+B_mid(k)*ps(i,j,nr) + exf2(k) = CP * Exner_nd(p2) -! send to NORTH neighbor if any - if (neighbor(NORTH) .ne. NOPROC) then - buf_vn(:,:) = v_xmi(:,ljmax-1,:,nr) - CALL MPI_ISEND(buf_vn, 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) - endif + ! height of the half-layers + z_bnd(i,j,k) = z_bnd(i,j,k+1) + (th(i,j,k,nr)* & + (exf1(k+1) - exf1(k)))/GRAV -! receive from EAST neighbor if any - if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then - CALL MPI_RECV(ue(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(EAST), MSG_EAST2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + ! height of the full levels. + z_mid(i,j,k) = z_bnd(i,j,k+1) + (th(i,j,k,nr)* & + (exf1(k+1) - exf2(k)))/GRAV -! receive from WEST neighbor if any - if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then - CALL MPI_RECV(uw(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & - neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + ! derive density from pressure and heights, so that they are consistent + roa(i,j,k,nr) = (dA(k)+dB(k)*ps(i,j,nr))& + /(GRAV*(z_bnd(i,j,k)-z_bnd(i,j,k+1))) -! receive from NORTH neighbor if any + end do ! k + end do + end do + if(foundsdot.and.sdot_at_mid)then + ! interpolation of sigma dot for bnd (half layers) + do k = KMAX_MID,2,-1 + sdot(i,j,k,nr) = sdot(i,j,k-1,nr) & + + (sdot(i,j,k,nr)-sdot(i,j,k-1,nr)) & + * (sigma_bnd(k)-sigma_mid(k-1)) & + / (sigma_mid(k)-sigma_mid(k-1)) + end do + end if + ! set sdot equal to zero at the top and bottom of atmosphere. + sdot(:,:,KMAX_BND,nr)=0.0 + sdot(:,:,1,nr)=0.0 + Etadot(:,:,KMAX_BND,nr)=0.0 + Etadot(:,:,1,nr)=0.0 + if(.not.foundsdot .and. .not.met(ix_Etadot)%found)then + if(write_now)write(*,*)'WARNING: Etadot derived from horizontal winds ' + ! sdot derived from divergence=0 principle + do j = 1,ljmax + do i = 1,limax + Ps_extended(i,j) = Ps(i,j,nr) + end do + end do + ! Get Ps at edges from neighbors + ! we reuse usnd, vsnd etc + if (neighbor(EAST) .ne. NOPROC) then + usnd(:,1) = ps(limax,:,nr) + CALL MPI_ISEND( usnd, 8*LJMAX, MPI_BYTE, & + neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) + end if if (neighbor(NORTH) .ne. NOPROC) then - CALL MPI_RECV(vn(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(NORTH), MSG_NORTH2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif - -! receive from SOUTH neighbor if any + vsnd(:,1) = ps(:,ljmax,nr) + CALL MPI_ISEND( vsnd , 8*LIMAX, MPI_BYTE, & + neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) + end if + ! receive from WEST neighbor if any + if (neighbor(WEST) .ne. NOPROC) then + CALL MPI_RECV( urcv, 8*LJMAX, MPI_BYTE, & + neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) + Ps_extended(0,1:ljmax) = urcv(1:ljmax,1) + else + Ps_extended(0,1:ljmax) = Ps_extended(1,1:ljmax) + end if + ! receive from SOUTH neighbor if any if (neighbor(SOUTH) .ne. NOPROC) then - CALL MPI_RECV(vs(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & - neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) - endif + CALL MPI_RECV( vrcv, 8*LIMAX, MPI_BYTE, & + neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + Ps_extended(1:limax,0) = vrcv(1:limax,1) + else + Ps_extended(1:limax,0) = Ps_extended(1:limax,1) + end if + if (neighbor(WEST) .ne. NOPROC) then + usnd(:,2) = ps(1,:,nr) + CALL MPI_ISEND( usnd(1,2), 8*LJMAX, MPI_BYTE, & + neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, request_w, IERROR) + end if + if (neighbor(SOUTH) .ne. NOPROC) then + vsnd(:,2) = ps(:,1,nr) + CALL MPI_ISEND( vsnd(1,2) , 8*LIMAX, MPI_BYTE, & + neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, request_s, IERROR) + end if - if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then + ! receive from EAST neighbor if any + if (neighbor(EAST) .ne. NOPROC) then + CALL MPI_RECV( urcv, 8*LJMAX, MPI_BYTE, & + neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) + Ps_extended(limax+1,1:ljmax) = urcv(1:ljmax,1) + else + Ps_extended(limax+1,1:ljmax) = Ps_extended(limax,1:ljmax) + end if + ! receive from NORTH neighbor if any + if (neighbor(NORTH) .ne. NOPROC) then + CALL MPI_RECV( vrcv, 8*LIMAX, MPI_BYTE, & + neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + Ps_extended(1:limax,ljmax+1) = vrcv(1:limax,1) + else + Ps_extended(1:limax,ljmax+1) = Ps_extended(1:limax,ljmax) + end if + + if (neighbor(EAST) .ne. NOPROC) then CALL MPI_WAIT(request_e, MPISTATUS, IERROR) - endif - if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then - CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif + end if + if (neighbor(NORTH) .ne. NOPROC) then CALL MPI_WAIT(request_n, MPISTATUS, IERROR) - endif + end if + if (neighbor(WEST) .ne. NOPROC) then + CALL MPI_WAIT(request_w, MPISTATUS, IERROR) + end if + if (neighbor(SOUTH) .ne. NOPROC) then CALL MPI_WAIT(request_s, MPISTATUS, IERROR) - endif - - if(USE_FASTJ)then - !compute photolysis rates from FastJ - if(nr==2)rcphot_3D(:,:,:,:,1)=rcphot_3D(:,:,:,:,2) - do j = 1,ljmax - do i = 1,limax - call setup_phot_fastj(i,j,INFO,nr) - enddo - enddo - endif - - if(first_call.and.next_inptime%hour>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + do j = 1,ljmax + do i = 1,limax + Pmid=Ps_extended(i,j)-PT + Pu1=0.5*(Ps_extended(i-1,j)+Ps_extended(i,j))-PT + Pu2=0.5*(Ps_extended(i+1,j)+Ps_extended(i,j))-PT + Pv1=0.5*(Ps_extended(i,j-1)+Ps_extended(i,j))-PT + Pv2=0.5*(Ps_extended(i,j+1)+Ps_extended(i,j))-PT + + sdot(i,j,KMAX_BND,nr)=0.0 + sdot(i,j,1,nr)=0.0 + sumdiv=0.0 + do k=1,KMAX_MID + divk(k)=((u_xmj(i,j,k,nr)*Pu2-u_xmj(i-1,j,k,nr)*Pu1) & + + (v_xmi(i,j,k,nr)*Pv2-v_xmi(i,j-1,k,nr)*Pv1)) & + * xm2(i,j)*(sigma_bnd(k+1)-sigma_bnd(k)) & + / GRIDWIDTH_M/Pmid + sumdiv=sumdiv+divk(k) + end do + do k=KMAX_MID,1,-1 + sdot(i,j,k,nr)=sdot(i,j,k+1,nr)-(sigma_bnd(k+1)-sigma_bnd(k))& + *sumdiv+divk(k) + end do + end do + end do - !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +! New method introduced 26/2-2013. Old method sigma=(P-PT)/(ps-pt); +! New method uses Eta=A/Pref+B; the method differ, see +! http://www.ecmwf.int/research/ifsdocs/DYNAMICS/Chap2_Discretization3.html#959545 - subroutine metfieldint + !(note that u_xmj and v_xmi have already been divided by xm here) + dB_sum=1.0/(B_bnd(KMAX_MID+1)-B_bnd(1))!normalisation factor for dB (should be one if entire atmosphere is included) - ! this routine does the forward linear stepping of the meteorological - ! fields read or derived every 3 hours. + do j = 1,ljmax + do i = 1,limax + Pmid=Ps_extended(i,j)! without "-PT" + !surface pressure at gridcell boundaries + Pu1=0.5*(Ps_extended(i-1,j)+Ps_extended(i,j)) + Pu2=0.5*(Ps_extended(i+1,j)+Ps_extended(i,j)) + Pv1=0.5*(Ps_extended(i,j-1)+Ps_extended(i,j)) + Pv2=0.5*(Ps_extended(i,j+1)+Ps_extended(i,j)) + + sumdiv=0.0 + do k=1,KMAX_MID + divk(k)=((u_xmj(i,j,k,nr) *(dA(k)+dB(k)*Pu2) & + -u_xmj(i-1,j,k,nr)*(dA(k)+dB(k)*Pu1)) & + +(v_xmi(i,j,k,nr) *(dA(k)+dB(k)*Pv2) & + -v_xmi(i,j-1,k,nr)*(dA(k)+dB(k)*Pv1))) & + * xm2(i,j)/ GRIDWIDTH_M + sumdiv=sumdiv+divk(k) + end do + + Etadot(i,j,KMAX_MID+1,nr)=0.0 + do k=KMAX_MID,1,-1 + Etadot(i,j,k,nr)=Etadot(i,j,k+1,nr)-dB(k)*dB_sum*sumdiv+divk(k) + Etadot(i,j,k+1,nr)=Etadot(i,j,k+1,nr)*(dA(k)/Pref+dB(k))/(dA(k)+dB(k)*Pmid) + end do + Etadot(i,j,1,nr)=0.0! Is zero anyway from relations above + end do + end do - implicit none + if(MANUAL_GRID)then + !around the north pole the interpolation of wind fields is not accurate, + !and we cannot rely on continuity to derive the vertical winds. + !Brutal: set Etadot to 0! + do k=1,KMAX_MID,1 + do j = 1,ljmax + do i = 1,limax + if(glat(i,j)>88.0)Etadot(i,j,k,nr)=0.0 + end do + end do + end do + end if - real :: div - integer :: ix + end if + + if(met(ix_Etadot)%found)then + call CheckStop(.not.USE_EtaCOORDINATES,& + "Conflict: requested etadot, but does not use eta coordinates") + !convert from mid values to boundary values + if(write_now)write(*,*)'interpolating etadot from mid to boundary levels' + do k = KMAX_MID,2,-1 + do j = 1,ljmax + do i = 1,limax + Etadot(i,j,k,nr) = Etadot(i,j,k-1,nr) & + + (Etadot(i,j,k,nr)-Etadot(i,j,k-1,nr)) & + * (Eta_bnd(k)-Eta_mid(k-1)) & + / (Eta_mid(k)-Eta_mid(k-1)) + end do + end do + end do + Etadot(:,:,1,nr)=0.0!no exchanges above top (should not be useed anyway) + end if - if (nstep.lt.nmax) then + call met_derived(nr) !compute derived meteo fields used in BLPhysics - div = 1./real(nmax-(nstep-1)) - do ix=1,Nmetfields - if(met(ix)%time_interpolate)then - - if(me==0.and.DEBUG_MET)write(*,*)'interpolating in time ',ix,met(ix)%name + call BLPhysics() - met(ix)%field(:,:,:,1) = met(ix)%field(:,:,:,1) & - + (met(ix)%field(:,:,:,2) - met(ix)%field(:,:,:,1))*div + call met_derived(1) !compute derived meteo fields for nr=1 "now" - endif - enddo + !windspeed of neighbor subdomains at edges (used for advection) + !It the windspeed divided by xm which must be used here. + ! send to WEST neighbor if any + if (neighbor(WEST) .ne. NOPROC) then + if(neighbor(WEST) .ne. me)then + buf_uw(:,:) = u_xmj(1,:,:,nr) + CALL MPI_ISEND(buf_uw, 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(WEST), MSG_EAST2, MPI_COMM_CALC, request_w, IERROR) + else + ! cyclic grid: own neighbor + ue(:,:,nr) = u_xmj(1,:,:,nr) + end if + end if + + ! send to EAST neighbor if any + if (neighbor(EAST) .ne. NOPROC) then + if (neighbor(EAST) .ne. me) then + buf_ue(:,:) = u_xmj(limax-1,:,:,nr) + CALL MPI_ISEND(buf_ue, 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(EAST), MSG_WEST2, MPI_COMM_CALC, request_e, IERROR) else + ! cyclic grid: own neighbor + uw(:,:,nr) = u_xmj(limax-1,:,:,nr) + end if + end if + + ! send to SOUTH neighbor if any + if (neighbor(SOUTH) .ne. NOPROC) then + buf_vs(:,:) = v_xmi(:,1,:,nr) + CALL MPI_ISEND(buf_vs, 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(SOUTH), MSG_NORTH2, MPI_COMM_CALC, request_s, IERROR) + end if + + ! send to NORTH neighbor if any + if (neighbor(NORTH) .ne. NOPROC) then + buf_vn(:,:) = v_xmi(:,ljmax-1,:,nr) + CALL MPI_ISEND(buf_vn, 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(NORTH), MSG_SOUTH2, MPI_COMM_CALC, request_n, IERROR) + end if + + ! receive from EAST neighbor if any + if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then + CALL MPI_RECV(ue(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(EAST), MSG_EAST2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + + ! receive from WEST neighbor if any + if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then + CALL MPI_RECV(uw(1,1,nr), 8*LJMAX*KMAX_MID, MPI_BYTE, & + neighbor(WEST), MSG_WEST2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + + ! receive from NORTH neighbor if any + if (neighbor(NORTH) .ne. NOPROC) then + CALL MPI_RECV(vn(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(NORTH), MSG_NORTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + + ! receive from SOUTH neighbor if any + if (neighbor(SOUTH) .ne. NOPROC) then + CALL MPI_RECV(vs(1,1,nr), 8*LIMAX*KMAX_MID, MPI_BYTE, & + neighbor(SOUTH), MSG_SOUTH2, MPI_COMM_CALC, MPISTATUS, IERROR) + end if + + if (neighbor(EAST) .ne. NOPROC .and. neighbor(EAST) .ne. me) then + CALL MPI_WAIT(request_e, MPISTATUS, IERROR) + end if + if (neighbor(WEST) .ne. NOPROC .and. neighbor(WEST) .ne. me) then + CALL MPI_WAIT(request_w, MPISTATUS, IERROR) + end if + if (neighbor(NORTH) .ne. NOPROC) then + CALL MPI_WAIT(request_n, MPISTATUS, IERROR) + end if + if (neighbor(SOUTH) .ne. NOPROC) then + CALL MPI_WAIT(request_s, MPISTATUS, IERROR) + end if + + if(USE_FASTJ)then + !compute photolysis rates from FastJ + if(nr==2)rcphot_3D(:,:,:,:,1)=rcphot_3D(:,:,:,:,2) + do j = 1,ljmax + do i = 1,limax + call setup_phot_fastj(i,j,INFO,nr) + end do + end do + end if - do ix=1,Nmetfields - if(met(ix)%time_interpolate)then - met(ix)%field(:,:,:,1) = met(ix)%field(:,:,:,2) - endif - enddo + if(first_call.and.next_inptime%hour>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + implicit none - subroutine met_derived(nt) + real :: div + integer :: ix - ! This routine calculates fields derived from meteofields. - ! The interpolation in time is done for the meteofields and the - ! fields here are derived from the interpolated fields after - ! each interpolation (i.e. every dt_advec). - ! CPU costly fields (those with special functions like log ) - ! can be computed in MeteoRead only once every METSTEP and interpolated - ! in metint. + if (nstep.lt.nmax) then + div = 1./real(nmax-(nstep-1)) + do ix=1,Nmetfields + if(met(ix)%time_interpolate)then + if(me==0.and.DEBUG_MET)& + write(*,*)'interpolating in time ',ix,met(ix)%name - !horizontal wind speed (averaged over the four edges) - !Note that u_xmj and v_xmi are wind velocities divided by xm - !At present u_ref is defined at KMAX_MID + met(ix)%field(:,:,:,1) = met(ix)%field(:,:,:,1) & + + (met(ix)%field(:,:,:,2) - met(ix)%field(:,:,:,1))*div + end if + end do - implicit none - integer, intent(in) :: nt ! set to 1 from metint or nr from matvar - integer ::i,j, k - logical :: DEBUG_DERIV = .false. + else + do ix=1,Nmetfields + if(met(ix)%time_interpolate)then + met(ix)%field(:,:,:,1) = met(ix)%field(:,:,:,2) + end if + end do + end if - do k = 1, KMAX_MID - do j = 1,ljmax - do i = 1,limax - u_mid(i,j,k) = 0.5*( u_xmj(i,j,k,nt)*xm_j(i,j) + & - u_xmj(i-1,j,k,nt)*xm_j(i-1,j) ) - v_mid(i,j,k) = 0.5*( v_xmi(i,j-1,k,nt)*xm_i(i,j-1) + & - v_xmi(i,j,k,nt)*xm_i(i,j)) - enddo - enddo - enddo !k - do j = 1,ljmax - do i = 1,limax - u_ref(i,j)= sqrt( u_mid(i,j,KMAX_MID)**2 + v_mid(i,j,KMAX_MID)**2 ) - enddo - enddo - if(LANDIFY_MET) & - call landify(u_ref(:,:),"u_ref") + call met_derived(1) !update derived meteo fields +end subroutine metfieldint +subroutine met_derived(nt) + ! Calculates fields derived from meteofields. + ! The interpolation in time is done for the meteofields and the + ! fields here are derived from the interpolated fields after + ! each interpolation (i.e. every dt_advec). + ! CPU costly fields (those with special functions like log ) + ! can be computed in MeteoRead only once every METSTEP and interpolated + ! in metint. - ! Tmp ustar solution. May need re-consideration for MM5 etc., but - ! basic principal should be that fm is interpolated with time, and - ! ustar derived from this. + ! horizontal wind speed (averaged over the four edges) + ! Note that u_xmj and v_xmi are wind velocities divided by xm + ! At present u_ref is defined at KMAX_MID - !aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + implicit none + integer, intent(in) :: nt ! set to 1 from metint or nr from matvar + integer ::i,j, k + logical :: DEBUG_DERIV = .false. - forall( i=1:limax, j=1:ljmax ) - rho_surf(i,j) = ps(i,j,nt)/(RGAS_KG * t2_nwp(i,j,nt) ) - end forall + do k = 1, KMAX_MID + do j = 1,ljmax + do i = 1,limax + u_mid(i,j,k) = 0.5*(u_xmj(i,j,k,nt) *xm_j(i,j) & + +u_xmj(i-1,j,k,nt)*xm_j(i-1,j)) + v_mid(i,j,k) = 0.5*(v_xmi(i,j-1,k,nt)*xm_i(i,j-1) & + +v_xmi(i,j,k,nt) *xm_i(i,j)) + end do + end do + end do !k + do j = 1,ljmax + do i = 1,limax + u_ref(i,j)= sqrt( u_mid(i,j,KMAX_MID)**2 + v_mid(i,j,KMAX_MID)**2 ) + end do + end do + if(LANDIFY_MET) & + call landify(u_ref(:,:),"u_ref") -!update z_bnd - !z_bnd(:,:,KMAX_MID+1)=0.0 !should never change - do k = KMAX_MID,1,-1 - do j = 1,ljmax - do i = 1,limax - z_bnd(i,j,k)=z_bnd(i,j,k+1) + (dA(k)+dB(k)*ps(i,j,nt))/(roa(i,j,k,nt)*GRAV) - enddo - enddo - enddo - -! if(.not. foundustar)then -!17/12/2013 : always use tau, since ustar_nwp is not interpolated in time (in metfieldint) - forall( i=1:limax, j=1:ljmax ) - ustar_nwp(i,j) = sqrt( tau(i,j,nt)/rho_surf(i,j) ) - end forall -! endif - - ! we limit u* to a physically plausible value over land - ! to prevent numerical problems, and to account for enhanced - ! mixing which is usually found over real terrain - - where ( mainly_sea ) - ustar_nwp = max( ustar_nwp, 1.0e-5 ) - elsewhere - ustar_nwp = max( ustar_nwp, MIN_USTAR_LAND ) - end where - - forall( i=1:limax, j=1:ljmax ) - invL_nwp(i,j) = KARMAN * GRAV * fh(i,j,nt) & ! - disliked by gfortran - / (CP*rho_surf(i,j) * ustar_nwp(i,j)**3 * t2_nwp(i,j,nt) ) - end forall - where ( invL_nwp < -1.0 ) - invL_nwp = -1.0 - else where ( invL_nwp > 1.0 ) - invL_nwp = 1.0 - end where - - - if ( DEBUG_DERIV .and. debug_proc ) then - i = debug_iloc - j = debug_jloc - write(*,*) "MET_DERIV DONE ", me, nt, ustar_nwp(i,j), rho_surf(i,j), & - fh(i,j,nt), invL_nwp(i,j) - end if - !aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ! Tmp ustar solution. May need re-consideration for MM5 etc., but + ! basic principal should be that fm is interpolated with time, and + ! ustar derived from this. + forall( i=1:limax, j=1:ljmax ) + rho_surf(i,j) = ps(i,j,nt)/(RGAS_KG * t2_nwp(i,j,nt) ) + end forall - end subroutine met_derived + ! update z_bnd +! z_bnd(:,:,KMAX_MID+1)=0.0 !should never change + do k = KMAX_MID,1,-1 + do j = 1,ljmax + do i = 1,limax + z_bnd(i,j,k)=z_bnd(i,j,k+1)+(dA(k)+dB(k)*ps(i,j,nt))/(roa(i,j,k,nt)*GRAV) + end do + end do + end do - !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + ! always use tau, since ustar_nwp is not interpolated in time (in metfieldint) + forall( i=1:limax, j=1:ljmax ) + ustar_nwp(i,j) = sqrt( tau(i,j,nt)/rho_surf(i,j) ) + end forall + ! we limit u* to a physically plausible value over land + ! to prevent numerical problems, and to account for enhanced + ! mixing which is usually found over real terrain + where ( mainly_sea ) + ustar_nwp = max( ustar_nwp, 1.0e-5 ) + elsewhere + ustar_nwp = max( ustar_nwp, MIN_USTAR_LAND ) + end where + forall( i=1:limax, j=1:ljmax ) + invL_nwp(i,j) = KARMAN * GRAV * fh(i,j,nt) & ! - disliked by gfortran + / (CP*rho_surf(i,j) * ustar_nwp(i,j)**3 * t2_nwp(i,j,nt) ) + end forall - subroutine MetModel_LandUse(callnum) + where ( invL_nwp < -1.0 ) + invL_nwp = -1.0 + else where ( invL_nwp > 1.0 ) + invL_nwp = 1.0 + end where - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! - ! This subroutine reads parameterfields from file - ! reading surface roughness classes from file: landsea_mask.dat - ! - ! ... fields as used in meteorological model - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - implicit none + if ( DEBUG_DERIV .and. debug_proc ) then + i = debug_iloc + j = debug_jloc + write(*,*) "MET_DERIV DONE ", me, nt, ustar_nwp(i,j), rho_surf(i,j), & + fh(i,j,nt), invL_nwp(i,j) + end if +end subroutine met_derived - integer, intent(in) :: callnum - integer :: i,j +subroutine MetModel_LandUse(callnum) + ! Reads parameterfields from file + ! reading surface roughness classes from file: landsea_mask.dat + ! ... fields as used in meteorological model - character*20 fname - logical :: needed_found + implicit none - ios = 0 + integer, intent(in) :: callnum - if ( callnum == 1 ) then + character(len=20) :: fname + ios = 0 -!.. Clay soil content ! - ios = 0 + if ( callnum == 1 ) then + !.. Clay soil content ! + ios = 0 + if(USE_DUST)then + if(TEGEN_DATA)then + !use global data interpolated to present grid - if ( USE_DUST ) then - if ( TEGEN_DATA ) then - !use global data interpolated to present grid + fname='Soil_Tegen.nc' + if(MasterProc)write(6,*)'Sand and clay fractions from ',fname - fname='Soil_Tegen.nc' - if(MasterProc)write(6,*)'Sand and clay fractions from ',fname - - call ReadField_CDF(fname,'clay',clay_frac,1, & + call ReadField_CDF(fname,'clay',clay_frac,1, & + interpol='conservative',needed=.true.,debug_flag=.false.) + call ReadField_CDF(fname,'sand',sand_frac,1, & interpol='conservative',needed=.true.,debug_flag=.false.) - call ReadField_CDF(fname,'sand',sand_frac,1, & - interpol='conservative',needed=.true.,debug_flag=.false.) - - else - !use grid specific data - if (MasterProc)write(6,*)'ASCII DUST NO MORE AVAILABLE! ' - stop - endif - end if ! USE_DUST - - end if ! callnum == 1 - - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - end subroutine MetModel_LandUse - !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - - - - - !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - - subroutine BLPhysics() - !c - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - !c First written by Trond Iversen, modified by Hugo Jakobsen, 060994 - !c Extensive modifications to structure by Dave Simpson, March 2010. - !c Some code moved to BLPhysics_ml, together with additinal options. - !c Also now includes Haldis's use of NWP Kz values. - !c ** not optimised, bujt called only at 3 h intervals - !c - !c----------------------------------------------------------------- - !c - !! This routine calculates the exner function, - !! the geopotential height, and the vertical exchange coefficient - !! in sigma surfaces. - !! The height zi of the "well mixed layer" or ABL-height - !! is also calculated. - !c - !c - !c if nroa = 1 also roa is calculated. - !c if nfirst=1 for the initial timelevel - !c - !c - !c----------------------------------------------------------------- - !c routines called: - !c - !c Several options for Kz, Hmix - !c smoosp - !c - !c - !c----------------------------------------------------------------- - !c - !c********************************************************************** - logical, parameter :: TKE_DIFF = .false. !!! CODE NEEDS TESTING/TIDY UP - - real, dimension(LIMAX,LJMAX,KMAX_MID)::exnm - real, dimension(LIMAX,LJMAX,KMAX_BND)::exns - - real :: p_m, p_s, hs - - real, dimension(KMAX_BND) :: p_bnd !TESTzi - real, dimension(KMAX_MID) :: Kz_nwp - real :: Kz_min, stab_h - - integer i,j,k,nr - real :: theta2 - logical :: debug_flag - logical,save :: first_call = .true. - - call CheckStop( KZ_SBL_LIMIT < 1.01*KZ_MINIMUM, & - "SBLlimit too low! in Met_ml") - - ! Preliminary definitions - - nr = 2 - if (first_call) nr = 1 - - Kz_m2s(:,:,:)= 0. - Kz_nwp(:) = -99.0 ! store for printout. only set if read from NWP - - !c.................................. - !c..exner-functions (j/k kg) - !c - do k=1,KMAX_MID - do j=1,ljmax - do i=1,limax - p_m = A_mid(k)+B_mid(k)*ps(i,j,nr) - p_s = A_bnd(k)+B_bnd(k)*ps(i,j,nr) + elseif(MasterProc)then + !use grid specific data + call CheckStop('ASCII DUST NO MORE AVAILABLE! ') + end if + end if ! USE_DUST + + end if ! callnum == 1 +end subroutine MetModel_LandUse + +subroutine BLPhysics() + !----------------------------------------------------------------- + ! First written by Trond Iversen, modified by Hugo Jakobsen, 060994 + ! Extensive modifications to structure by Dave Simpson, March 2010. + ! Some code moved to BLPhysics_ml, together with additinal options. + ! Also now includes Haldis's use of NWP Kz values. + ! ** not optimised, bujt called only at 3 h intervals + !----------------------------------------------------------------- + ! Calculate the exner function, geopotential height, + ! and vertical exchange coefficient in sigma surfaces. + ! The height zi of the "well mixed layer" or ABL-height is also calculated. + !----------------------------------------------------------------- + + real, dimension(LIMAX,LJMAX,KMAX_MID)::exnm + real, dimension(LIMAX,LJMAX,KMAX_BND)::exns + + real :: p_m, p_s, hs + + real, dimension(KMAX_BND) :: p_bnd !TESTzi + real, dimension(KMAX_MID) :: Kz_nwp + real :: Kz_min, stab_h + + integer i,j,k,nr + real :: theta2 + logical :: debug_flag + logical,save :: first_call = .true. + + call CheckStop(KZ_SBL_LIMIT < 1.01*KZ_MINIMUM, "SBLlimit too low! in Met_ml") + + ! Preliminary definitions + nr = 2 + if (first_call) nr = 1 + + Kz_m2s(:,:,:)= 0. + Kz_nwp(:) = -99.0 ! store for printout. only set if read from NWP + + !.................................. + ! exner-functions (j/k kg) + !.................................. + do k=1,KMAX_MID + do j=1,ljmax + do i=1,limax + p_m = A_mid(k)+B_mid(k)*ps(i,j,nr) + p_s = A_bnd(k)+B_bnd(k)*ps(i,j,nr) - exnm(i,j,k)= CP * Exner_nd(p_m) !c..exner (j/k kg) - exns(i,j,k)= CP * Exner_nd(p_s) - end do - end do + exnm(i,j,k)= CP * Exner_nd(p_m) ! exner (j/k kg) + exns(i,j,k)= CP * Exner_nd(p_s) + end do end do + end do - if ( debug_proc .and. DEBUG_Kz) then - i = debug_iloc - j = debug_jloc - write(*,"(a,i4,2f12.5)") "TESTNR th ", nr , th(i,j,20,1), th(i,j,20,nr) - write(*,"(a,i4,2f12.5,es10.2)") "TESTNR fh ", nr , fh(i,j,1), fh(i,j,nr), invL_nwp(i,j) - write(*,"(a,i4,2es10.2)") "TESTNR ps ", nr , ps(i,j,1), ps(i,j,nr) - end if - - - - !SSSSSSSSSSSSSSSSSS Start choice of Kz and Hmix methods SSSSSSSSSSSSSSSSSS + if ( debug_proc .and. DEBUG_Kz) then + i = debug_iloc + j = debug_jloc + write(*,"(a,i4,2f12.5)") "TESTNR th ",nr,th(i,j,20,[1,nr]) + write(*,"(a,i4,2f12.5,es10.2)") "TESTNR fh ",nr,fh(i,j,[1,nr]),invL_nwp(i,j) + write(*,"(a,i4,2es10.2)") "TESTNR ps ",nr,ps(i,j,[1,nr]) + end if + !.................................. + ! Start choice of Kz and Hmix methods + !.................................. - if (NWP_Kz .and. foundKz_met ) then ! read from met data + if (NWP_Kz .and. foundKz_met ) then ! read from met data + ! LAter we should remove Kz_met and Kz_m2s + forall(i=1:limax,j=1:ljmax,k=2:KMAX_MID) + SigmaKz(i,j,k,nr)=Kz_met(i,j,k,nr)/(60*60*METSTEP) + end forall - ! LAter we should remove Kz_met and Kz_m2s + call SigmaKz_2_m2s( SigmaKz(:,:,:,nr), roa(:,:,:,nr),ps(:,:,nr), Kz_m2s ) - forall(i=1:limax,j=1:ljmax,k=2:KMAX_MID) - SigmaKz(i,j,k,nr)=Kz_met(i,j,k,nr)/(60*60*METSTEP) + if( debug_proc ) Kz_nwp(:) = Kz_m2s(debug_iloc,debug_jloc,:) !for printout - end forall + if( debug_proc .and. DEBUG_Kz)then + write(6,*) '*** After Set SigmaKz', sum(SigmaKz(:,:,:,nr)), & + minval(SigmaKz(:,:,:,nr)), maxval(SigmaKz(:,:,:,nr)), & + DEBUG_Kz, 'NWP_Kz:',NWP_Kz, & + '*** After convert to z',sum(Kz_m2s(:,:,:)), & + minval(Kz_m2s(:,:,:)), maxval(Kz_m2s(:,:,:)) + write(6,*) 'After Set SigmaKz KTOP', Kz_met(debug_iloc,debug_jloc,1,nr) + end if - call SigmaKz_2_m2s( SigmaKz(:,:,:,nr), roa(:,:,:,nr),ps(:,:,nr), Kz_m2s ) + else ! Not NWP Kz. Must calculate - if( debug_proc ) Kz_nwp(:) = Kz_m2s(debug_iloc,debug_jloc,:) !for printout + ! Get Kz first from PielkeBlackadar methods + ! Use for all methods except NWP_Kz + ! Do the physics for each i,j for now. Optimise later + do j=1,ljmax + do i=1,limax - if( debug_proc .and. DEBUG_Kz)then - write(6,*) '*** After Set SigmaKz', sum(SigmaKz(:,:,:,nr)), & - minval(SigmaKz(:,:,:,nr)), maxval(SigmaKz(:,:,:,nr)), & - DEBUG_Kz, 'NWP_Kz:',NWP_Kz, & - '*** After convert to z',sum(Kz_m2s(:,:,:)), & - minval(Kz_m2s(:,:,:)), maxval(Kz_m2s(:,:,:)) - write(6,*) 'After Set SigmaKz KTOP', Kz_met(debug_iloc,debug_jloc,1,nr) - endif + debug_flag = ( DEBUG_Kz .and. debug_proc .and. & + i == debug_iloc .and. j == debug_jloc ) - else ! Not NWP Kz. Must calculate + call PielkeBlackadarKz ( & + u_mid(i,j,:), v_mid(i,j,:), & + z_mid(i,j,:), z_bnd(i,j,:), & + th(i,j,:,nr), Kz_m2s(i,j,:), & + PIELKE, debug_flag ) - ! 1/ Get Kz first from PielkeBlackadar methods - ! Use for all methods except NWP_Kz - ! Do the physics for each i,j for now. Optimise later + end do + end do + !====================================================================== + ! Hmix choices: + if ( HmixMethod == "TIZi" ) then + ! Get Mixing height from "orig" method + ! "old" exner-function of the full-levels + + do j=1,ljmax + do i=1,limax + p_bnd(:) = A_bnd(:)+B_bnd(:)*ps(i,j,nr) + + call TI_Hmix ( & ! Original EMEP method + Kz_m2s(i,j,:), z_mid(i,j,:), & + z_bnd(i,j,:), fh(i,j,nr), & + th(i,j,:,nr), exnm(i,j,:), & + p_bnd(:), pzpbl(i,j), & + .false.) + + pzpbl(i,j) = max( PBL%ZiMIN, pzpbl(i,j)) ! Keep old fixed height ZiMin here + pzpbl(i,j) = min( PBL%ZiMAX, pzpbl(i,j)) + end do + end do + + else ! Newer non-TI methods + if ( HmixMethod == "SbRb" ) then + call SeibertRiB_Hmix_3d(& + u_mid(1:limax,1:ljmax,:), & + v_mid(1:limax,1:ljmax,:), & + z_mid(1:limax,1:ljmax,:), & + th(1:limax,1:ljmax,:,nr), & + pzpbl(1:limax,1:ljmax)) + + elseif ( HmixMethod == "JcRb" ) then + do i=1,limax do j=1,ljmax - do i=1,limax - - debug_flag = ( DEBUG_Kz .and. debug_proc .and. & - i == debug_iloc .and. j == debug_jloc ) - - call PielkeBlackadarKz ( & - u_mid(i,j,:), v_mid(i,j,:), & - z_mid(i,j,:), z_bnd(i,j,:), & - th(i,j,:,nr), Kz_m2s(i,j,:), & - PIELKE, debug_flag ) - - enddo - enddo - - !====================================================================== - ! Hmix choices: + theta2 = t2_nwp(i,j,nr) * T_2_Tpot(ps(i,j,nr)) + call JericevicRiB_Hmix0(& + u_mid(i,j,:), v_mid(i,j,:), & + z_mid(i,j,:), th(i,j,:,nr), pzpbl(i,j)) + end do + end do + else + call CheckStop("Need HmixMethod") + end if ! end of newer methods - if ( HmixMethod == "TIZi" ) then - - ! 2/ Get Mixing height from "orig" method - ! "old" exner-function of the full-levels + ! Set limits on Zi + forall(i=1:limax,j=1:ljmax) + pzpbl(i,j) = max( PBL%ZiMIN, pzpbl(i,j)) + pzpbl(i,j) = min( PBL%ZiMAX, pzpbl(i,j) ) + end forall - do j=1,ljmax - do i=1,limax - - p_bnd(:) = A_bnd(:)+B_bnd(:)*ps(i,j,nr) - ! p_mid(:) = sigma_mid(:)*(ps(i,j,nr) - PT) + PT - !exf2(:) = CP * Exner_nd(p_mid(:)) - - call TI_Hmix ( & ! Original EMEP method - Kz_m2s(i,j,:), z_mid(i,j,:), & - z_bnd(i,j,:), fh(i,j,nr), & - th(i,j,:,nr), exnm(i,j,:), & - p_bnd(:), pzpbl(i,j), & - .false.) - - pzpbl(i,j) = max( PBL_ZiMIN, pzpbl(i,j)) ! Keep old fixed height ZiMin here - pzpbl(i,j) = min( PBL_ZiMAX, pzpbl(i,j)) - - enddo - enddo - - else ! Newer non-TI methods - if ( HmixMethod == "SbRb" ) then - - call SeibertRiB_Hmix_3d(& - u_mid(1:limax,1:ljmax,:), & - v_mid(1:limax,1:ljmax,:), & - z_mid(1:limax,1:ljmax,:), & - th(1:limax,1:ljmax,:,nr), & - pzpbl(1:limax,1:ljmax)) - - else if ( HmixMethod == "JcRb" ) then - - do i=1,limax - do j=1,ljmax - - theta2 = t2_nwp(i,j,nr) * T_2_Tpot(ps(i,j,nr)) - call JericevicRiB_Hmix0(& - u_mid(i,j,:), v_mid(i,j,:), & - z_mid(i,j,:), th(i,j,:,nr), & ! WHY nr?? - pzpbl(i,j), theta2, likely_coastal(i,j) ) -! if( pzpbl(i,j) < z_bnd(i,j,20) ) then -! write(*,"(a8,i2,2i4,5f8.3,f7.2)") "PZPBL ", nr, i_fdom(i), j_fdom(j), t2_nwp(i,j,nr), theta2, th(i,j,20,nr), u_mid(i,j,20), v_mid(i,j,20),pzpbl(i,j) -! end if !OS_TEST debug - end do - end do - - else - call CheckStop("Need HmixMethod") - end if ! end of newer methods - - ! Set limits on Zi - forall(i=1:limax,j=1:ljmax) - pzpbl(i,j) = max( PBL_ZiMIN, pzpbl(i,j)) - pzpbl(i,j) = min( PBL_ZiMAX, pzpbl(i,j) ) - end forall - ! mid-call at k=19 is lowest we can resolve, so set as min - !ORIG forall(i=1:limax,j=1:ljmax) - !ORIG pzpbl(i,j) = max( z_mid(i,j,KMAX_MID-1), pzpbl(i,j)) - !ORIG pzpbl(i,j) = min( PBL_ZiMAX, pzpbl(i,j) ) - !ORIG end forall - - end if ! Hmix done + end if ! Hmix done !..spatial smoothing of new zi: Need fixed minimum here. 100 or 50 m is okay ! First, we make sure coastal areas had "land-like" values. if(LANDIFY_MET) & - call landify(pzpbl,"pzbpl") - call smoosp(pzpbl,PBL_ZiMIN,PBL_ZiMAX) -! and for later... - - !====================================================================== - ! Kz choices: - - if ( KzMethod == "JG" ) then ! Jericevic/Grisogono for both Stable/Unstable + call landify(pzpbl,"pzbpl") + call smoosp(pzpbl,PBL%ZiMIN,PBL%ZiMAX) + + !====================================================================== + ! Kz choices: + + if ( KzMethod == "JG" ) then ! Jericevic/Grisogono for both Stable/Unstable + do k = 2, KMAX_MID + do j=1,ljmax + do i=1,limax + Kz_m2s(i,j,k) = JericevicKz(z_bnd(i,j,k),pzpbl(i,j),& + ustar_nwp(i,j),Kz_m2s(i,j,k)) + end do + end do + end do + + else ! Specify unstable, stable separately: + if ( StableKzMethod == "JG" ) then ! Jericevic/Grisogono for both Stable/Unstable + do j=1,ljmax + do i=1,limax + if ( invL_nwp(i,j) >= OB_invL_LIMIT ) then !neutral and unstable do k = 2, KMAX_MID - do j=1,ljmax - do i=1,limax - Kz_m2s(i,j,k) = JericevicKz( z_bnd(i,j,k), pzpbl(i,j), ustar_nwp(i,j), Kz_m2s(i,j,k) ) - !if v.low zi, then set Kz at bottom boundary - ! to zero to stop dispersion. -! if ( k==KMAX_MID .and. pzpbl(i,j) <= z_bnd(i,j,KMAX_MID) ) then -! Kz_m2s(i,j,k) = 0.0 -! end if - end do + if( z_bnd(i,j,k) < pzpbl(i,j) ) then + Kz_m2s(i,j,k) = JericevicKz(z_bnd(i,j,k),pzpbl(i,j),& + ustar_nwp(i,j),Kz_m2s(i,j,k)) + !else: keep Kz from Pielke/BLackadar + end if end do + end if + end do + end do + if(debug_proc ) then + i = debug_iloc + j = debug_jloc + if(DEBUG_Kz .and. invL_nwp(i,j) >= OB_invL_LIMIT ) then + do k = 15, KMAX_MID + print "(a,i3,f7.1,3es11.3)", "DEBUG SKz_m2s",k,& + pzpbl(i,j), invL_nwp(i,j), ustar_nwp(i,j), Kz_m2s(i,j,k) end do + end if + end if - else ! Specify unstable, stable separately: - - if ( StableKzMethod == "JG" ) then ! Jericevic/Grisogono for both Stable/Unstable - + elseif ( StableKzMethod == "BW" ) then + do k = 2, KMAX_MID + do j=1,ljmax + do i=1,limax + if ( invL_nwp(i,j) > 1.0e-10 ) then !stable ! leaves gap near zero + Kz_m2s(i,j,k) = BrostWyngaardKz(z_bnd(i,j,k),pzpbl(i,j),& + ustar_nwp(i,j),invL_nwp(i,j),Kz_m2s(i,j,k)) + !else: keep Kz from Pielke/BLackadar + end if + end do + end do + end do + else if ( StableKzMethod == "PB" ) then + ! no change (keep Kz from Pielke/BLackadar) + else + call CheckStop("Need StableKzMethod") + end if ! Stable Kz + + if ( UnstableKzMethod == "OB" ) then + do j=1,ljmax + do i=1,limax + if ( invL_nwp(i,j) < OB_invL_LIMIT ) then !neutral and unstable + call O_BrienKz ( & ! Original EMEP method + pzpbl(i,j), z_bnd(i,j,:), & + ustar_nwp(i,j), invL_nwp(i,j), & + Kz_m2s(i,j,:), .false.) + end if + end do + end do + if(debug_proc) then + i = debug_iloc + j = debug_jloc + if(DEBUG_Kz .and. invL_nwp(i,j) < OB_invL_LIMIT ) then + do k = 15, KMAX_MID + write(*,"(a,f7.1,3es10.3)") "DEBUG UKz_m2s", & + pzpbl(i,j), invL_nwp(i,j), ustar_nwp(i,j), Kz_m2s(i,j,k) + end do + end if + end if - do j=1,ljmax - do i=1,limax - if ( invL_nwp(i,j) >= OB_invL_LIMIT ) then !neutral and unstable - do k = 2, KMAX_MID - if( z_bnd(i,j,k) < pzpbl(i,j) ) then - Kz_m2s(i,j,k) = & - JericevicKz( z_bnd(i,j,k), pzpbl(i,j), ustar_nwp(i,j) , Kz_m2s(i,j,k)) - !else - ! keep Kz from Pielke/BLackadar - end if - end do - end if - end do - end do - if(debug_proc ) then - i = debug_iloc - j = debug_jloc - if(DEBUG_Kz .and. invL_nwp(i,j) >= OB_invL_LIMIT ) then - do k = 15, KMAX_MID - print "(a,i3,f7.1,3es11.3)", "DEBUG SKz_m2s",k,& - pzpbl(i,j), invL_nwp(i,j), ustar_nwp(i,j), Kz_m2s(i,j,k) - end do - endif - endif - - - else if ( StableKzMethod == "BW" ) then - - do k = 2, KMAX_MID - do j=1,ljmax - do i=1,limax - if ( invL_nwp(i,j) > 1.0e-10 ) then !stable ! leaves gap near zero - Kz_m2s(i,j,k) = BrostWyngaardKz(z_bnd(i,j,k),pzpbl(i,j),& - ustar_nwp(i,j),invL_nwp(i,j), Kz_m2s(i,j,k)) - end if - end do - end do - end do - - else if ( StableKzMethod == "PB" ) then - ! no change - else - call CheckStop("Need StableKzMethod") - end if ! Stable Kz - - if ( UnstableKzMethod == "OB" ) then - do j=1,ljmax - do i=1,limax - if ( invL_nwp(i,j) < OB_invL_LIMIT ) then !neutral and unstable - call O_BrienKz ( & ! Original EMEP method - pzpbl(i,j), z_bnd(i,j,:), & - ustar_nwp(i,j), invL_nwp(i,j), & - Kz_m2s(i,j,:), .false.) - end if - end do - end do - if(debug_proc) then - i = debug_iloc - j = debug_jloc - if(DEBUG_Kz .and. invL_nwp(i,j) < OB_invL_LIMIT ) then - do k = 15, KMAX_MID - print "(a,f7.1,3es10.3)", "DEBUG UKz_m2s", pzpbl(i,j), invL_nwp(i,j), ustar_nwp(i,j), Kz_m2s(i,j,k) - end do - endif - endif - - else - call CheckStop("Need UnstableKzMethod") - end if + else + call CheckStop("Need UnstableKzMethod") + end if - end if ! Specify unstable, stable separately: - end if + end if ! Specify unstable, stable separately: + end if ! NWP_Kz .and. foundKz_met - !..spatial smoothing of new zi: Need fixed minimum here. 100 or 50 m is okay - ! First, we make sure coastal areas had "land-like" values. + ! spatial smoothing of new zi: Need fixed minimum here. 100 or 50 m is okay + ! First, we make sure coastal areas had "land-like" values. !************************************************************************! ! test some alternative options for Kz and Hmix - if( DEBUG_BLM .and. debug_proc .and. modulo( current_date%hour, 3) == 0 & + if( DEBUG_BLM .and. debug_proc .and. modulo( current_date%hour, 3) == 0 & .and. current_date%seconds == 0 ) then - i = debug_iloc - j = debug_jloc - p_bnd(:) = A_bnd(:)+B_bnd(:)*ps(i,j,nr) + i = debug_iloc + j = debug_jloc + p_bnd(:) = A_bnd(:)+B_bnd(:)*ps(i,j,nr) !************************************************************************! ! We test all the various options here. Pass in data as keyword arguments ! to avoid possible errors! - call Test_BLM( mm=current_date%month, dd=current_date%day, & + call Test_BLM( mm=current_date%month, dd=current_date%day, & hh=current_date%hour, fH=fh(i,j,nr), & u=u_mid(i,j,:),v=v_mid(i,j,:), zm=z_mid(i,j,:), & zb=z_bnd(i,j,:), exnm=exnm(i,j,:), Kz=Kz_m2s(i,j,:), & @@ -1947,1212 +1818,1114 @@ subroutine BLPhysics() q=q(i,j,:,nr), & ! TEST Vogel ustar=ustar_nwp(i,j), th=th(i,j,:,nr), pb=p_bnd(:), zi=pzpbl(i,j)) !************************************************************************! - ! if ( USE_MIN_Kz) then - !hs = min( z_bnd(i,j,KMAX_MID), 0.04*pzpbl(i,j)) - hs = z_bnd(i,j,KMAX_MID) + hs = z_bnd(i,j,KMAX_MID) - stab_h = min( PsiH(hs*invL_nwp(i,j)), 0.9 ) - Kz_min = ustar_nwp(i,j)*KARMAN*hs /( 1 - stab_h ) - write(*,"(a,10f10.3)") "PSIH ", stab_h, fh(i,j,nr), invL_nwp(i,j), & + stab_h = min( PsiH(hs*invL_nwp(i,j)), 0.9 ) + Kz_min = ustar_nwp(i,j)*KARMAN*hs /( 1 - stab_h ) + write(*,"(a,10f10.3)") "PSIH ", stab_h, fh(i,j,nr), invL_nwp(i,j), & PsiH(hs*invL_nwp(i,j)),Kz_min - ! end if - end if ! end of debug extra options + end if ! end of debug extra options - !*************************************************** - if ( .not. (NWP_Kz .and. foundKz_met) ) then ! convert to Sigma units + !*************************************************** + if ( .not. (NWP_Kz .and. foundKz_met) ) then ! convert to Sigma units - call Kz_m2s_toSigmaKz (Kz_m2s(1:limax,1:ljmax,:),roa(1:limax,1:ljmax,:,nr),& - ps(1:limax,1:ljmax,nr),SigmaKz(1:limax,1:ljmax,:,nr)) - call Kz_m2s_toEtaKz (Kz_m2s(1:limax,1:ljmax,:),roa(1:limax,1:ljmax,:,nr),& - ps(1:limax,1:ljmax,nr),EtaKz(1:limax,1:ljmax,:,nr),Eta_mid,A_mid,B_mid) + call Kz_m2s_toSigmaKz (Kz_m2s(1:limax,1:ljmax,:),roa(1:limax,1:ljmax,:,nr),& + ps(1:limax,1:ljmax,nr),SigmaKz(1:limax,1:ljmax,:,nr)) + call Kz_m2s_toEtaKz (Kz_m2s(1:limax,1:ljmax,:),roa(1:limax,1:ljmax,:,nr),& + ps(1:limax,1:ljmax,nr),EtaKz(1:limax,1:ljmax,:,nr),Eta_mid,A_mid,B_mid) - end if - !*************************************************** + end if + !*************************************************** first_call=.false. - return +end subroutine BLPhysics + +subroutine smoosp(f,rmin,rmax) + !----------------------------------------------------------------- + ! Written by Trond Iversen, modified by Hugo Jakobsen, 080994 + ! parallellized and modified by Peter February 2003 + !---------------------------------------------------------------------- + ! Apply the shapiro filter with s=0.5 and s=-0.5 + ! to the field f using h as a work space also the boundaries + ! are smoothed. f contains the smoothed field upon return. + !---------------------------------------------------------------------- + implicit none - end subroutine BLPhysics - - !c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - - subroutine smoosp(f,rmin,rmax) - - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - !c - !c written by Trond Iversen, modified by Hugo Jakobsen, 080994 - ! parallellized and modified by Peter February 2003 - !c - !c Called from: BLPhysics.f - !c - !c---------------------------------------------------------------------- - !c - !c This routine applies the shapiro filter with s=0.5 and s=-0.5 - !c to the field f using h as a work space also the boundaries - !c are smoothed. f contains the smoothed field upon return. - !c - - !c Definition of the variables: - !c - !c - !c f : data to be smoothed - !c iif : =limax - !c jjf : =ljmax - !c h1,h2 : = help variable - !c rmin : min allowed - !c rmax : max allowed - !c - implicit none - - real, intent(inout) :: f(LIMAX,LJMAX) - real, intent(in) :: rmin,rmax - - real, dimension(LIMAX+4,LJMAX+4) :: h1, h2 - real, dimension(LIMAX,2) :: f_south,f_north - real, dimension(LJMAX+2*2,2) :: f_west,f_east - real s - - integer thick - integer iif,jjf,is,i,j,ii,jj,iifl,jjfl - - iif=limax - jjf=ljmax - - thick=2 !we fetch 2 neighbors at once, so that we don't need to call - ! readneighbours twice - iifl=iif+2*thick - jjfl=jjf+2*thick - - call readneighbors(f,f_south,f_north,f_west,f_east,thick) - - do j=1,jjf - jj=j+thick - do i=1,iif - ii=i+thick - h1(ii,jj) = f(i,j) - enddo - enddo - do j=1,thick - do i=1,iif - ii=i+thick - h1(ii,j) = f_south(i,j) - enddo - enddo - - do j=1,thick - jj=j+jjf+thick - do i=1,iif - ii=i+thick - h1(ii,jj) = f_north(i,j) - enddo - enddo - - do j=1,jjfl - do i=1,thick - h1(i,j) = f_west(j,i) - enddo - enddo - - do j=1,jjfl - do i=1,thick - ii=i+iif+thick - h1(ii,j) = f_east(j,i) - enddo - enddo - - do j=1,jjfl - h2(1,j) = 0. - h2(iifl,j) = 0. - enddo - - do i=1,iifl - h2(i,1) = 0. - h2(i,jjfl) = 0. - enddo - !! 44 format(I2,30F5.0) - - do is=2,1,-1 - - s=is-1.5 !s=0,5 s=-0.5 - if(is /= 2)h1=h2 - - !..the smoothing - - do j=2,jjfl-1 - do i=2,iifl-1 - h2(i,j)=(1.-2.*s+s*s)*h1(i,j)& - + 0.5*s*(1.-s)*(h1(i+1,j)+h1(i-1,j)+h1(i,j+1)+h1(i,j-1)) & - + s*s*(h1(i+1,j+1)+h1(i-1,j-1)+h1(i+1,j-1)+h1(i-1,j+1))/4. - h2(i,j) = amax1(h2(i,j),rmin) - h2(i,j) = amin1(h2(i,j),rmax) - end do - end do + real, intent(inout) :: f(LIMAX,LJMAX) ! data to be smoothed + real, intent(in) :: rmin,rmax ! min/max allowed + + real, dimension(LIMAX+4,LJMAX+4) :: h1,h2 ! help variables + real, dimension(LIMAX,2) :: f_south,f_north + real, dimension(LJMAX+2*2,2) :: f_west,f_east + real s + + integer :: thick + integer :: iif,jjf,is,i,j,ii,jj,iifl,jjfl + + iif=limax + jjf=ljmax + + thick=2 !we fetch 2 neighbors at once, so that we don't need to call + ! readneighbours twice + iifl=iif+2*thick + jjfl=jjf+2*thick + + call readneighbors(f,f_south,f_north,f_west,f_east,thick) + + do j=1,jjf + jj=j+thick + do i=1,iif + ii=i+thick + h1(ii,jj) = f(i,j) + end do + end do + do j=1,thick + do i=1,iif + ii=i+thick + h1(ii,j) = f_south(i,j) + end do + end do + do j=1,thick + jj=j+jjf+thick + do i=1,iif + ii=i+thick + h1(ii,jj) = f_north(i,j) end do + end do + do j=1,jjfl + do i=1,thick + h1(i,j) = f_west(j,i) + end do + end do - do j=1,jjf - jj=j+thick - do i=1,iif - ii=i+thick - f(i,j)=h2(ii,jj) - enddo - enddo + do j=1,jjfl + do i=1,thick + ii=i+iif+thick + h1(ii,j) = f_east(j,i) + end do + end do + + do j=1,jjfl + h2(1,j) = 0. + h2(iifl,j) = 0. + end do + + do i=1,iifl + h2(i,1) = 0. + h2(i,jjfl) = 0. + end do + + do is=2,1,-1 + s=is-1.5 !s=0,5 s=-0.5 + if(is /= 2)h1=h2 + + ! the smoothing + do j=2,jjfl-1 + do i=2,iifl-1 + h2(i,j)=(1.-2.*s+s*s)*h1(i,j)& + + 0.5*s*(1.-s)*(h1(i+1,j)+h1(i-1,j)+h1(i,j+1)+h1(i,j-1)) & + + s*s*(h1(i+1,j+1)+h1(i-1,j-1)+h1(i+1,j-1)+h1(i-1,j+1))/4. + h2(i,j) = amax1(h2(i,j),rmin) + h2(i,j) = amin1(h2(i,j),rmax) + end do + end do + end do - end subroutine smoosp - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + do j=1,jjf + jj=j+thick + do i=1,iif + ii=i+thick + f(i,j)=h2(ii,jj) + end do + end do - subroutine extendarea(f,h,debug_flag) +end subroutine smoosp - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - !c - ! based upon the smoosp routine - ! - returns extended array array, reading neighbour procs as needed - !c---------------------------------------------------------------------- +subroutine extendarea(f,h,debug_flag) + !---------------------------------------------------------------------- + ! based upon the smoosp routine + ! returns extended array array, reading neighbour procs as needed + !---------------------------------------------------------------------- - real, intent(in) :: f(LIMAX,LJMAX) - real, intent(inout) :: h(:,:) - logical, intent(in), optional :: debug_flag - logical :: mydebug = .false. + real, intent(in) :: f(LIMAX,LJMAX) + real, intent(inout) :: h(:,:) + logical, intent(in), optional :: debug_flag + logical :: mydebug = .false. - real, dimension(size(f,1),2) :: f_south,f_north - real, dimension(size(f,2)+2*2,2) :: f_west,f_east + real, dimension(size(f,1),2) :: f_south,f_north + real, dimension(size(f,2)+2*2,2) :: f_west,f_east - integer :: thick ! = size(h,1) - size(f,1) ! Caller has to make h > f - integer :: iif,jjf,i,j,ii,jj,iifl,jjfl - if ( present(debug_flag) ) mydebug = debug_flag + integer :: thick ! = size(h,1) - size(f,1) ! Caller has to make h > f + integer :: iif,jjf,i,j,ii,jj,iifl,jjfl + if ( present(debug_flag) ) mydebug = debug_flag - thick = ( size(h,1) - size(f,1) ) ! Caller has to make h > f ;NB: NOT SAFE! - iif=limax - jjf=ljmax + thick = ( size(h,1) - size(f,1) ) ! Caller has to make h > f ;NB: NOT SAFE! + iif=limax + jjf=ljmax - if( modulo(thick,2) /= 0 ) then - print *, "ERROR extendarea para,s ", me, iif , jjf, thick - print *, "ERROR extendarea mod ", modulo(thick,2) - call StopAll("ERROR extendarea thickness not even!") - end if - thick = thick / 2 - - - ! readneighbours twice - iifl=iif+2*thick - jjfl=jjf+2*thick - if(mydebug .and. MasterProc ) write(*,*) "DEBUG extendarea", iif,jjf,thick - - call readneighbors(f,f_south,f_north,f_west,f_east,thick) - - do j=1,jjf - jj=j+thick - do i=1,iif - ii=i+thick - h(ii,jj) = f(i,j) - enddo - enddo - do j=1,thick - do i=1,iif - ii=i+thick - h(ii,j) = f_south(i,j) - enddo - enddo - - do j=1,thick - jj=j+jjf+thick - do i=1,iif - ii=i+thick - h(ii,jj) = f_north(i,j) - enddo - enddo - - do j=1,jjfl - do i=1,thick - h(i,j) = f_west(j,i) - enddo - enddo - - do j=1,jjfl - do i=1,thick - ii=i+iif+thick - h(ii,j) = f_east(j,i) - enddo - enddo - - end subroutine extendarea - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - subroutine landify(x,intxt,xmin,xmax,wfmin,xmask) - real, dimension(LIMAX,LJMAX), intent(inout) :: x - character(len=*), intent(in), optional :: intxt - real, intent(in), optional :: xmin, xmax ! Limits of valid data for x - real, intent(in), optional :: wfmin ! Limits of valid data for water frac - logical, dimension(LIMAX,LJMAX), intent(in), optional :: xmask - - logical, dimension(LIMAX,LJMAX) :: mask - real, dimension(LIMAX+2*NEXTEND,LJMAX+2*NEXTEND) :: xx ! extended - character(len=30) :: txt, masktxt - real :: xwfmin, xxmin, xxmax - logical :: debug_flag=.false. - real :: sumland, sumx, landfrac, oldx - integer :: i,j, ii, jj, ii2, jj2 - - txt = "Landify: " - if ( present(intxt) ) txt = trim(txt) // trim(intxt) - xwfmin = 0.5 ! Default fraction of water - if ( present(wfmin) ) xwfmin = wfmin - xxmin = 1.0e-10 ! Default min value x - if ( present(xmin) ) xxmin = xmin - xxmax = 1.0e30 ! Default max value x - if ( present(xmax) ) xxmax = xmax - - if(DEBUG_LANDIFY.and.MasterProc) then - write(*,*) trim(txt) , water_frac_set - write(*,"(a,2g12.4)") 'Data Limits ', xxmin, xxmax - write(*,"(a,g12.4)") 'Water Limit ', xwfmin - end if + if( modulo(thick,2) /= 0 ) then + write(*,*) "ERROR extendarea para,s ", me, iif , jjf, thick + write(*,*) "ERROR extendarea mod ", modulo(thick,2) + call CheckStop("ERROR extendarea thickness not even!") + end if + thick = thick / 2 - if( .not. water_frac_set ) then - if(MasterProc) write(*,*) trim(txt) // " skips 1st NTERM" - write(*,*) trim(txt) // " skips 1st NTERM" - return ! on 1st time-step water_frac hasnt yet been set. - end if - if ( present(xmask) ) then - mask = xmask - masktxt = "Input mask" - else - mask = likely_coastal - masktxt = "Coastal mask" - end if + ! readneighbours twice + iifl=iif+2*thick + jjfl=jjf+2*thick + if(mydebug .and. MasterProc ) write(*,*) "DEBUG extendarea", iif,jjf,thick - if ( DEBUG_LANDIFY.and. debug_proc ) then - write(*,"(a,6i4,L2,1x,a)") "DLandify start ", & - debug_li, debug_lj, 1, limax, 1, ljmax, xwf_done, trim(masktxt) - end if + call readneighbors(f,f_south,f_north,f_west,f_east,thick) - ! We need the extended water-fraction too, but just once - if ( .not. xwf_done ) then ! only need to do this once - if ( DEBUG_MET .and. debug_proc) write(*,*) "Landify xwf" - call extendarea( water_fraction(:,:), xwf, debug_flag) - xwf_done = .true. - end if + do j=1,jjf + jj=j+thick + do i=1,iif + ii=i+thick + h(ii,jj) = f(i,j) + end do + end do + do j=1,thick + do i=1,iif + ii=i+thick + h(ii,j) = f_south(i,j) + end do + end do - ! Then the data we are working with: - - call extendarea( x(:,:), xx(:,:), debug_flag ) - - if ( DEBUG_LANDIFY .and. debug_proc) write(*,*) "Landify now ", & - xwf_done , likely_coastal(debug_li,debug_lj), mask(debug_li,debug_lj) - - oldx = 0.0 - if( debug_proc ) oldx = x(debug_li, debug_lj) - - do j = 1, ljmax - do i = 1, limax - - ! Take a 5x5 average of the land-weighted values for SW. Seems - ! best not to "believe" NWP models too much for this param, and - ! the variation in a grid is so big anyway. We aim at the broad - ! effect. - - sumland = 0.0 - sumx = 0.0 - debug_flag = ( DEBUG_LANDIFY .and. debug_proc .and. & - i==debug_li .and. j==debug_lj ) - - if( mask(i,j) ) then ! likely coastal or water_frac <0.0 for SW - do jj = -NEXTEND, NEXTEND - do ii = -NEXTEND, NEXTEND - ii2=i+ii+NEXTEND ! coord in extended array !CHECK! - jj2=j+jj+NEXTEND - - -!Had 0.5, 1.0e-10 in original for met-data - if( xwf(ii2,jj2)<= wfmin .and. &! was 0.5 likely not NWP sea - xx(ii2,jj2) <= xxmax .and. &! Valid x range - xx(ii2,jj2) >= xxmin ) then ! - landfrac = 1.0 - xwf(ii2,jj2) - sumland = sumland + landfrac - sumx = sumx + landfrac * xx(ii2,jj2) - if ( debug_flag ) then - write(*,"(a,4i4,2f7.4,3g11.3,2f7.4)") "DBG"//trim(intxt), i,j, & - ii2, jj2,& - water_fraction(i,j), xwf(ii2,jj2), x(i,j), & - xx(ii2,jj2), sumx, landfrac, sumland - end if ! DEBUG - end if ! xsw - end do!ii - end do!jj - - if ( sumland > 0.001 ) then ! replace x with land-weighted values - - x(i,j) = sumx/sumland - if ( debug_flag ) then - write(*,"(a,2i4,8g12.3)") "DBGDONE", i,j, & - water_fraction(i,j), sumx, sumland, x(i,j) - end if - - end if ! water_fraction - - end if ! likely_coastal - end do ! i - end do ! j - - !if ( DEBUG_MET .and. debug_proc ) write(*,*) "Landify done" - if ( DEBUG_LANDIFY .and. debug_proc ) then - call datewrite("LandifyDONE: "//trim(intxt), (/ oldx, x(debug_li,debug_lj) /) ) - end if + do j=1,thick + jj=j+jjf+thick + do i=1,iif + ii=i+thick + h(ii,jj) = f_north(i,j) + end do + end do - end subroutine landify + do j=1,jjfl + do i=1,thick + h(i,j) = f_west(j,i) + end do + end do - subroutine readneighbors(data,data_south,data_north,data_west,data_east,thick) + do j=1,jjfl + do i=1,thick + ii=i+iif+thick + h(ii,j) = f_east(j,i) + end do + end do + +end subroutine extendarea + +subroutine landify(x,intxt,xmin,xmax,wfmin,xmask) + real, dimension(LIMAX,LJMAX), intent(inout) :: x + character(len=*), intent(in), optional :: intxt + real, intent(in), optional :: xmin, xmax ! Limits of valid data for x + real, intent(in), optional :: wfmin ! Limits of valid data for water frac + logical, dimension(LIMAX,LJMAX), intent(in), optional :: xmask + + logical, dimension(LIMAX,LJMAX) :: mask + real, dimension(LIMAX+2*NEXTEND,LJMAX+2*NEXTEND) :: xx ! extended + character(len=30) :: txt, masktxt + real :: xwfmin, xxmin, xxmax + logical :: debug_flag=.false. + real :: sumland, sumx, landfrac, oldx + integer :: i,j, ii, jj, ii2, jj2 + + txt = "Landify: " + if ( present(intxt) ) txt = trim(txt) // trim(intxt) + xwfmin = 0.5 ! Default fraction of water + if ( present(wfmin) ) xwfmin = wfmin + xxmin = 1.0e-10 ! Default min value x + if ( present(xmin) ) xxmin = xmin + xxmax = 1.0e30 ! Default max value x + if ( present(xmax) ) xxmax = xmax + + if(DEBUG_LANDIFY.and.MasterProc) then + write(*,*) trim(txt) , water_frac_set + write(*,"(a,2g12.4)") 'Data Limits ', xxmin, xxmax + write(*,"(a,g12.4)") 'Water Limit ', xwfmin + end if + + if( .not. water_frac_set ) then + if(MasterProc) write(*,*) trim(txt) // " skips 1st NTERM" + write(*,*) trim(txt) // " skips 1st NTERM" + return ! on 1st time-step water_frac hasnt yet been set. + end if + + if ( present(xmask) ) then + mask = xmask + masktxt = "Input mask" + else + mask = likely_coastal + masktxt = "Coastal mask" + end if + + if ( DEBUG_LANDIFY.and. debug_proc ) then + write(*,"(a,6i4,L2,1x,a)") "DLandify start ", & + debug_li, debug_lj, 1, limax, 1, ljmax, xwf_done, trim(masktxt) + end if + + ! We need the extended water-fraction too, but just once + if ( .not. xwf_done ) then ! only need to do this once + if ( DEBUG_MET .and. debug_proc) write(*,*) "Landify xwf" + call extendarea( water_fraction(:,:), xwf, debug_flag) + xwf_done = .true. + end if + + ! Then the data we are working with: + + call extendarea( x(:,:), xx(:,:), debug_flag ) + + if ( DEBUG_LANDIFY .and. debug_proc) write(*,*) "Landify now ", & + xwf_done , likely_coastal(debug_li,debug_lj), mask(debug_li,debug_lj) + + oldx = 0.0 + if( debug_proc ) oldx = x(debug_li, debug_lj) + + do j = 1, ljmax + do i = 1, limax + ! Take a 5x5 average of the land-weighted values for SW. Seems + ! best not to "believe" NWP models too much for this param, and the + ! variation in a grid is so big anyway. We aim at the broad effect. + + sumland = 0.0 + sumx = 0.0 + debug_flag = ( DEBUG_LANDIFY .and. debug_proc .and. & + i==debug_li .and. j==debug_lj ) + + if( mask(i,j) ) then ! likely coastal or water_frac <0.0 for SW + do jj = -NEXTEND, NEXTEND + do ii = -NEXTEND, NEXTEND + ii2=i+ii+NEXTEND ! coord in extended array !CHECK! + jj2=j+jj+NEXTEND + + !Had 0.5, 1.0e-10 in original for met-data + if( xwf(ii2,jj2)<= wfmin .and. &! was 0.5 likely not NWP sea + xx(ii2,jj2) <= xxmax .and. &! Valid x range + xx(ii2,jj2) >= xxmin ) then ! + landfrac = 1.0 - xwf(ii2,jj2) + sumland = sumland + landfrac + sumx = sumx + landfrac * xx(ii2,jj2) + if ( debug_flag ) then + write(*,"(a,4i4,2f7.4,3g11.3,2f7.4)") "DBG"//trim(intxt), i,j, & + ii2, jj2, water_fraction(i,j), xwf(ii2,jj2), x(i,j), & + xx(ii2,jj2), sumx, landfrac, sumland + end if ! DEBUG + end if ! xsw + end do ! ii + end do ! jj + + if ( sumland > 0.001 ) then ! replace x with land-weighted values + x(i,j) = sumx/sumland + if ( debug_flag ) then + write(*,"(a,2i4,8g12.3)") "DBGDONE", i,j, & + water_fraction(i,j), sumx, sumland, x(i,j) + end if + end if ! water_fraction + + end if ! likely_coastal + end do ! i + end do ! j + + if ( DEBUG_LANDIFY .and. debug_proc ) then + call datewrite("LandifyDONE: "//trim(intxt), (/ oldx, x(debug_li,debug_lj) /) ) + end if + +end subroutine landify + +subroutine readneighbors(data,data_south,data_north,data_west,data_east,thick) + !---------------------------------------------------------------------- + ! Read data at the other side of the boundaries + ! + ! thick is the number of gridcells in each direction to be transferred + ! Note that we also fetch data from processors in the "diagonal" + ! directions + ! + ! Written by Peter February 2003 + ! + ! Note, + ! The data_west(jj,:)=data(1,j) is not a bug: when there is no west + ! neighbour, + ! the data is simply copied from the nearest points: data_west(jj,:) should + ! be =data(-thick+1:0,j), but since this data does not exist, we + ! put it =data(1,j). + !---------------------------------------------------------------------- - ! Read data at the other side of the boundaries - ! - ! thick is the number of gridcells in each direction to be transferred - ! Note that we also fetch data from processors in the "diagonal" - ! directions - ! - ! Written by Peter February 2003 - ! - !Note, - !The data_west(jj,:)=data(1,j) is not a bug: when there is no west - !neighbour, - !the data is simply copied from the nearest points: data_west(jj,:) should - !be =data(-thick+1:0,j), but since this data does not exist, we - !put it =data(1,j). - - - implicit none - - integer, intent(in) :: thick - real,intent(in), dimension(LIMAX,LJMAX) ::data - real,intent(out), dimension(LIMAX,thick) ::data_south,data_north - real,intent(out), dimension(LJMAX+2*thick,thick) ::data_west,data_east - real, dimension(LIMAX,thick) ::data_south_snd,data_north_snd - real, dimension(LJMAX+2*thick,thick) ::data_west_snd,data_east_snd - - integer :: msgnr,info - integer :: j,tj,jj,jt - - !check that limax and ljmax are large enough - call CheckStop(limax < thick, "ERROR readneighbors in Met_ml") - call CheckStop(ljmax < thick, "ERROR readneighbors in Met_ml") - - - msgnr=1 - - data_south_snd(:,:)=data(:,1:thick) - data_north_snd(:,:)=data(:,ljmax-thick+1:ljmax) - if(neighbor(SOUTH) >= 0 )then - CALL MPI_ISEND( data_south_snd , 8*LIMAX*thick, MPI_BYTE,& - neighbor(SOUTH), msgnr, MPI_COMM_CALC, request_s,IERROR) - endif - if(neighbor(NORTH) >= 0 )then - CALL MPI_ISEND( data_north_snd , 8*LIMAX*thick, MPI_BYTE,& - neighbor(NORTH), msgnr+9, MPI_COMM_CALC, request_n,IERROR) - endif - - if(neighbor(SOUTH) >= 0 )then - CALL MPI_RECV( data_south, 8*LIMAX*thick, MPI_BYTE,& - neighbor(SOUTH), msgnr+9, MPI_COMM_CALC, MPISTATUS, IERROR) - else - do tj=1,thick - data_south(:,tj)=data(:,1) - enddo - endif - if(neighbor(NORTH) >= 0 )then - CALL MPI_RECV( data_north, 8*LIMAX*thick, MPI_BYTE,& - neighbor(NORTH), msgnr, MPI_COMM_CALC, MPISTATUS, IERROR) - else - do tj=1,thick - data_north(:,tj)=data(:,ljmax) - enddo - endif + implicit none + integer, intent(in) :: thick + real,intent(in), dimension(LIMAX,LJMAX) ::data + real,intent(out), dimension(LIMAX,thick) ::data_south,data_north + real,intent(out), dimension(LJMAX+2*thick,thick) ::data_west,data_east + real, dimension(LIMAX,thick) ::data_south_snd,data_north_snd + real, dimension(LJMAX+2*thick,thick) ::data_west_snd,data_east_snd + + integer :: msgnr + integer :: j,tj,jj,jt + + !check that limax and ljmax are large enough + call CheckStop(limax < thick, "ERROR readneighbors in Met_ml") + call CheckStop(ljmax < thick, "ERROR readneighbors in Met_ml") + + + msgnr=1 + + data_south_snd(:,:)=data(:,1:thick) + data_north_snd(:,:)=data(:,ljmax-thick+1:ljmax) + if(neighbor(SOUTH) >= 0 )then + CALL MPI_ISEND( data_south_snd , 8*LIMAX*thick, MPI_BYTE,& + neighbor(SOUTH), msgnr, MPI_COMM_CALC, request_s,IERROR) + end if + if(neighbor(NORTH) >= 0 )then + CALL MPI_ISEND( data_north_snd , 8*LIMAX*thick, MPI_BYTE,& + neighbor(NORTH), msgnr+9, MPI_COMM_CALC, request_n,IERROR) + end if + + if(neighbor(SOUTH) >= 0 )then + CALL MPI_RECV( data_south, 8*LIMAX*thick, MPI_BYTE,& + neighbor(SOUTH), msgnr+9, MPI_COMM_CALC, MPISTATUS, IERROR) + else + do tj=1,thick + data_south(:,tj)=data(:,1) + end do + end if + if(neighbor(NORTH) >= 0 )then + CALL MPI_RECV( data_north, 8*LIMAX*thick, MPI_BYTE,& + neighbor(NORTH), msgnr, MPI_COMM_CALC, MPISTATUS, IERROR) + else + do tj=1,thick + data_north(:,tj)=data(:,ljmax) + end do + end if + + jj=0 + do jt=1,thick + jj=jj+1 + data_west_snd(jj,:)=data_south(1:thick,jt) + data_east_snd(jj,:)=data_south(limax-thick+1:limax,jt) + end do + do j=1,ljmax + jj=jj+1 + data_west_snd(jj,:)=data(1:thick,j) + data_east_snd(jj,:)=data(limax-thick+1:limax,j) + end do + do jt=1,thick + jj=jj+1 + data_west_snd(jj,:)=data_north(1:thick,jt) + data_east_snd(jj,:)=data_north(limax-thick+1:limax,jt) + end do + + if(neighbor(WEST) >= 0 )then + CALL MPI_ISEND( data_west_snd , 8*(LJMAX+2*thick)*thick, MPI_BYTE,& + neighbor(WEST), msgnr+3, MPI_COMM_CALC, request_w,IERROR) + end if + if(neighbor(EAST) >= 0 )then + CALL MPI_ISEND( data_east_snd , 8*(LJMAX+2*thick)*thick, MPI_BYTE,& + neighbor(EAST), msgnr+7, MPI_COMM_CALC, request_e,IERROR) + end if + + if(neighbor(WEST) >= 0 )then + CALL MPI_RECV( data_west, 8*(LJMAX+2*thick)*thick, MPI_BYTE,& + neighbor(WEST), msgnr+7, MPI_COMM_CALC, MPISTATUS, IERROR) + else jj=0 do jt=1,thick - jj=jj+1 - data_west_snd(jj,:)=data_south(1:thick,jt) - data_east_snd(jj,:)=data_south(limax-thick+1:limax,jt) - enddo + jj=jj+1 + data_west(jj,:)=data_south(1,jt) + end do do j=1,ljmax - jj=jj+1 - data_west_snd(jj,:)=data(1:thick,j) - data_east_snd(jj,:)=data(limax-thick+1:limax,j) - enddo + jj=jj+1 + data_west(jj,:)=data(1,j) + end do do jt=1,thick - jj=jj+1 - data_west_snd(jj,:)=data_north(1:thick,jt) - data_east_snd(jj,:)=data_north(limax-thick+1:limax,jt) - enddo - - if(neighbor(WEST) >= 0 )then - CALL MPI_ISEND( data_west_snd , 8*(LJMAX+2*thick)*thick, MPI_BYTE,& - neighbor(WEST), msgnr+3, MPI_COMM_CALC, request_w,IERROR) - endif - if(neighbor(EAST) >= 0 )then - CALL MPI_ISEND( data_east_snd , 8*(LJMAX+2*thick)*thick, MPI_BYTE,& - neighbor(EAST), msgnr+7, MPI_COMM_CALC, request_e,IERROR) - endif - - - - if(neighbor(WEST) >= 0 )then - CALL MPI_RECV( data_west, 8*(LJMAX+2*thick)*thick, MPI_BYTE,& - neighbor(WEST), msgnr+7, MPI_COMM_CALC, MPISTATUS, IERROR) - else - jj=0 - do jt=1,thick - jj=jj+1 - data_west(jj,:)=data_south(1,jt) - enddo - do j=1,ljmax - jj=jj+1 - data_west(jj,:)=data(1,j) - enddo - do jt=1,thick - jj=jj+1 - data_west(jj,:)=data_north(1,jt) - enddo - endif - if(neighbor(EAST) >= 0 )then - CALL MPI_RECV( data_east, 8*(LJMAX+2*thick)*thick, MPI_BYTE, & - neighbor(EAST), msgnr+3, MPI_COMM_CALC, MPISTATUS, IERROR) - else - jj=0 - do jt=1,thick - jj=jj+1 - data_east(jj,:)=data_south(limax,jt) - enddo - do j=1,ljmax - jj=jj+1 - data_east(jj,:)=data(limax,j) - enddo - do jt=1,thick - jj=jj+1 - data_east(jj,:)=data_north(limax,jt) - enddo - endif - - if(neighbor(SOUTH) >= 0 )then - CALL MPI_WAIT(request_s, MPISTATUS,IERROR) - endif - if(neighbor(NORTH) >= 0 )then - CALL MPI_WAIT(request_n, MPISTATUS,IERROR) - endif - if(neighbor(WEST) >= 0 )then - CALL MPI_WAIT(request_w, MPISTATUS, IERROR) - endif - if(neighbor(EAST) >= 0 )then - CALL MPI_WAIT(request_e, MPISTATUS,IERROR) - endif - - end subroutine readneighbors + jj=jj+1 + data_west(jj,:)=data_north(1,jt) + end do + end if + if(neighbor(EAST) >= 0 )then + CALL MPI_RECV( data_east, 8*(LJMAX+2*thick)*thick, MPI_BYTE, & + neighbor(EAST), msgnr+3, MPI_COMM_CALC, MPISTATUS, IERROR) + else + jj=0 + do jt=1,thick + jj=jj+1 + data_east(jj,:)=data_south(limax,jt) + end do + do j=1,ljmax + jj=jj+1 + data_east(jj,:)=data(limax,j) + end do + do jt=1,thick + jj=jj+1 + data_east(jj,:)=data_north(limax,jt) + end do + end if + + if(neighbor(SOUTH) >= 0 )then + CALL MPI_WAIT(request_s, MPISTATUS,IERROR) + end if + if(neighbor(NORTH) >= 0 )then + CALL MPI_WAIT(request_n, MPISTATUS,IERROR) + end if + if(neighbor(WEST) >= 0 )then + CALL MPI_WAIT(request_w, MPISTATUS, IERROR) + end if + if(neighbor(EAST) >= 0 )then + CALL MPI_WAIT(request_e, MPISTATUS,IERROR) + end if + +end subroutine readneighbors + +subroutine tkediff (nr) + !---------------------------------------------------------------------- + ! Compute vertical eddy diffusivities as a function + ! altitude, height of PBL, and a velocity scale, square root of + ! turbulent kinetic energy (TKE). This is a non-local scheme. + ! The TKE at the surface is diagnosed using scales for horizontaland + ! vertical velocities (ustar and wstar) in the surface layer + ! (Alapaty 2004; Holstag et al. 1990 and Mihailovic et al. 2004) + ! PBL ht is calculated using the EMEP formulation + ! + ! Written by DT Mihailovic (October 2004) + ! EMEP polishing and comments: JE Jonson and P Wind + !---------------------------------------------------------------------- + implicit none + ! Local constants + real, parameter :: & + SZKM=1600. & ! Constant (Blackadar, 1976) + ,CKZ=0.001 & ! Constant (Zhang and Athens, 1982) +! ,REFPR=1.0E+05 & ! Referent pressure + ,KZ0LT=1.0E-04 & ! Constant (Alapaty et al., 1997) + ,RIC=0.10 !& ! Critical Richardson number (Holstlag et al., 1993) +! ,ROVG=RGAS_KG/GRAV ! Used in Calculation of R-number + + ! INPUT + integer, intent(in) :: nr ! Number of meteorological stored in arrays (1 or 2) + + ! OUTPUT + ! skh(i,j,k,nr) array + ! Values of the Kz coefficients (eddyz (i,j,k)) are transformed nto + ! sigma system and then they stored in this array which is later used + ! in ADVECTION module + + ! Local arrays + integer, dimension(LIMAX,LJMAX) :: iblht ! Level of the PBL top + real, dimension(LIMAX,LJMAX,KMAX_BND):: eddyz ! Eddy coefficients (m2/s) + real, dimension(LIMAX,LJMAX,KMAX_MID):: & + t_virt, & ! Potential temperature (K) + e, & ! Kinetic energy with respect to height (m2/s2) + dzq, & ! Thickness of sigma interface layers (m) + u_mid, & ! Wind speed in x-direction (m/s) + v_mid ! Wind speed in y-direction (m/s) + + real, dimension(LIMAX,LJMAX,KMAX_MID-1):: & + dza ! Thickness of half sigma layers (m) + real, dimension(LIMAX,LJMAX):: & + pblht , & ! PBL (Holstag, 1990) (m) + h_flux, & ! Sensible heat flux (W/m2) + ust_r , & ! Friction velocity (m/s) + mol , & ! Monin-obukhov length (m) + wstar ! Convective velocity (m/s) + + real, dimension(KMAX_BND) :: & + rib ! Bulk Richardson number + + real, dimension(KMAX_MID) :: & + rich, & ! Richardson number + psi_zi ! Used in the vertical integration + + real, dimension (10) :: & + psi_z, & ! Used for calculating + zovh ! TKE + + ! Local variables + real :: dtmp, tog, wssq1, wssq2, wssq, tconv, wss, wst, PSI_TKE, & + dusq, dvsq, ri, ss, dthdz, busfc, zvh, & + part1, part2, fract1, fract2, apbl, kz0, u_s, goth + + integer :: i, j, k, l, kcbl + + call CheckStop('This routine is not ready. for example ust_r and kcbl are not set!') + + ! Functions for averaging the vertical turbulent kinetic energy + ! (Alapaty, 2003) + data psi_z /0.00,2.00,1.85,1.51,1.48,1.52,1.43,1.10,1.20,0.25/ + data zovh /0.00,0.05,0.10,0.20,0.40,0.60,0.80,1.00,1.10,1.20/ + + ! Store the NMW meteorology and variables derived from its + + ! Change the sign + h_flux(1:limax,1:ljmax)=-fh(1:limax,1:ljmax,nr) + + ! Avoid devision by zero later in the code + where (ABS(h_flux(1:limax,1:ljmax))<0.0001) h_flux(1:limax,1:ljmax)=0.0001 + + ! Check PBL height + ! strange tests! Negative pzpbl check? From 1 to 100m, odd! + do i=1,limax + do j=1,ljmax + if(ABS(pzpbl(i,j)) < 1.) then + pzpbl(i,j)=100. + end if + end do + end do - !************************************************************************! - subroutine tkediff (nr) ! - !************************************************************************! - ! ! - ! This routine computes vertical eddy diffusivities as a function ! - ! altitude, height of PBL, and a velocity scale, square root of ! - ! turbulent kinetic energy (TKE). This is a non-local scheme. ! - ! The TKE at the surface is diagnosed using scales for horizontaland ! - ! vertical velocities (ustar and wstar) in the surface layer ! - ! (Alapaty 2004; Holstag et al. 1990 and Mihailovic et al. 2004) ! - ! PBL ht is calculated using the EMEP formulation ! - ! ! - ! Written by DT Mihailovic (October 2004) ! - ! EMEP polishing and comments: JE Jonson and P Wind ! - !************************************************************************! - - implicit none - - ! Local constants - real , parameter :: SZKM=1600. & ! Constant (Blackadar, 1976) - ,CKZ=0.001 & ! Constant (Zhang and Athens, 1982) - ,REFPR=1.0E+05 & ! Referent pressure - ,KZ0LT=1.0E-04 & ! Constant (Alapaty et al., 1997) - ,RIC=0.10 & ! Critical Richardson number - ! (Holstlag et al., 1993) - ,ROVG=RGAS_KG/GRAV ! Used in Calculation of R-number - - ! INPUT - integer, intent(in) :: nr ! Number of meteorological stored - ! in arrays (1 or 2) - - ! OUTPUT - ! skh(i,j,k,nr) array - ! Values of the Kz coefficients (eddyz (i,j,k)) are transformed nto - ! sigma system and then they stored in this array which is later used - ! in ADVECTION module - - - ! Local arrays - - integer, dimension(LIMAX,LJMAX) :: iblht ! Level of the PBL top - real, dimension(LIMAX,LJMAX,KMAX_BND):: eddyz ! Eddy coefficients - ! (m2/s) - real, dimension(LIMAX,LJMAX,KMAX_MID):: & - t_virt &! Potential temperature (K) - ,e &! Kinetic energy with respect to height (m2/s2) - ,dzq &! Thickness of sigma interface layers (m) - ,u_mid &! Wind speed in x-direction (m/s) - ,v_mid ! Wind speed in y-direction (m/s) - - real, dimension(LIMAX,LJMAX,KMAX_MID-1):: & - dza ! Thickness of half sigma layers (m) - - real, dimension(LIMAX,LJMAX):: & - pblht , &! PBL (Holstag, 1990) (m) - h_flux, &! Sensible heat flux (W/m2) - ust_r , &! Friction velocity (m/s) - mol , &! Monin-obukhov length (m) - wstar ! Convective velocity (m/s) - - real, dimension(KMAX_BND) :: rib ! Bulk Richardson number - - real, dimension(KMAX_MID) :: & - rich, &! Richardson number - psi_zi ! Used in the vertical integration - - real, dimension (10) :: & - psi_z & ! Used for calculating - , zovh ! TKE - - ! Local variables - real dtmp, tog, wssq1, wssq2, wssq, tconv, wss, wst, PSI_TKE, & - dusq, dvsq, ri, ss, dthdz, busfc, zvh, & - part1, part2, fract1, fract2, apbl, kz0, & - u_s, goth - - integer i, j, k, l, kcbl - - write(*,*)& - 'This routine is not ready. for example ust_r and kcbl are not set!' - stop - - ! Functions for averaging the vertical turbulent kinetic energy - ! (Alapaty, 2003) - data psi_z /0.00,2.00,1.85,1.51,1.48,1.52,1.43,1.10,1.20,0.25/ - data zovh /0.00,0.05,0.10,0.20,0.40,0.60,0.80,1.00,1.10,1.20/ - - ! Store the NMW meteorology and variables derived from its - - ! Change the sign - h_flux(1:limax,1:ljmax)=-fh(1:limax,1:ljmax,nr) - - ! Avoid devision by zero later in the code - - where (ABS(h_flux(1:limax,1:ljmax))<0.0001) h_flux(1:limax,1:ljmax)=0.0001 - - ! Check PBL height ! strange tests! Negative pzpbl check? From 1 to 100m - ! - odd! + ! Calculate velocity components in the (h) poits (Arakawa notation) + do k=1,KMAX_MID do i=1,limax - do j=1,ljmax - if(ABS(pzpbl(i,j)) < 1.) then - pzpbl(i,j)=100. - endif - enddo - enddo - - ! Calculate velocity components in the (h) poits (Arakawa notation) - do k=1,KMAX_MID - do i=1,limax - do j=1,ljmax - ! u_mid(i,j,k)=0.5*(u_xmj(i-1,j ,k,nr)+u_xmj(i,j,k,nr)) - ! v_mid(i,j,k)=0.5*(v_xmi(i ,j-1,k,nr)+v_xmi(i,j,k,nr)) + do j=1,ljmax + ! u_mid(i,j,k)=0.5*(u_xmj(i-1,j ,k,nr)+u_xmj(i,j,k,nr)) + ! v_mid(i,j,k)=0.5*(v_xmi(i ,j-1,k,nr)+v_xmi(i,j,k,nr)) + u_mid(i,j,k)=u_xmj(i,j,k,nr) + v_mid(i,j,k)=v_xmi(i,j,k,nr) + end do + end do + end do - u_mid(i,j,k)=u_xmj(i,j ,k,nr) - v_mid(i,j,k)=v_xmi(i ,j,k,nr) + ! Avoid small values + where (ABS(u_mid(1:limax,1:ljmax,1:KMAX_MID))<0.001) & + u_mid(1:limax,1:ljmax,1:KMAX_MID)=0.001 + where (ABS(v_mid(1:limax,1:ljmax,1:KMAX_MID))<0.001) & + v_mid(1:limax,1:ljmax,1:KMAX_MID)=0.001 - enddo - enddo - enddo + ! Initialize eddy difussivity arrays + eddyz(1:limax,1:ljmax,1:KMAX_MID)=0. - ! Avoid small values - where (ABS(u_mid(1:limax,1:ljmax,1:KMAX_MID))<0.001) & - u_mid(1:limax,1:ljmax,1:KMAX_MID)=0.001 - where (ABS(v_mid(1:limax,1:ljmax,1:KMAX_MID))<0.001) & - v_mid(1:limax,1:ljmax,1:KMAX_MID)=0.001 + ! Calculate tickness of the full layers + dzq(1:limax,1:ljmax,1:KMAX_MID) = z_bnd(1:limax,1:ljmax,1:KMAX_MID) & + - z_bnd(1:limax,1:ljmax,2:KMAX_BND) - ! Initialize eddy difussivity arrays - eddyz(1:limax,1:ljmax,1:KMAX_MID)=0. + ! ... and the half sigma layers + dza(1:limax,1:ljmax,1:KMAX_MID-1) = z_mid(1:limax,1:ljmax,1:KMAX_MID-1) & + - z_mid(1:limax,1:ljmax,2:KMAX_MID) - ! Calculate tickness of the full layers - dzq(1:limax,1:ljmax,1:KMAX_MID) = z_bnd(1:limax,1:ljmax,1:KMAX_MID) & - - z_bnd(1:limax,1:ljmax,2:KMAX_BND) + ! Calculate virtual temperature + t_virt(1:limax,1:ljmax,1:KMAX_MID) = th(1:limax,1:ljmax,1:KMAX_MID,nr) & + * (1.0+0.622*q(1:limax,1:ljmax,1:KMAX_MID,nr)) - ! ... and the half sigma layers - dza(1:limax,1:ljmax,1:KMAX_MID-1) = z_mid(1:limax,1:ljmax,1:KMAX_MID-1) & - - z_mid(1:limax,1:ljmax,2:KMAX_MID) + ! Calculate Monin-Obuhkov length (Garratt, 1994) + do i=1,limax + do j=1,ljmax + u_s = ustar_nwp(i,j) + mol(i,j) = -(ps(i,j,nr)*u_s*u_s*u_s)/(KARMAN*GRAV*h_flux(i,j)*KAPPA) + end do + end do - ! Calculate virtual temperature + ! Calculate the convective velocity (wstar) + do i=1,limax + do j=1,ljmax + wstar(i,j) = GRAV*h_flux(i,j)*pzpbl(i,j)/rho_surf(i,j) & + /CP/th(i,j,KMAX_MID,nr) + if(wstar(i,j) < 0.) then + wstar(i,j)=-ABS(wstar(i,j))**(0.3333) + else + wstar(i,j)=(wstar(i,j))**(0.3333) + end if + end do + end do - t_virt(1:limax,1:ljmax,1:KMAX_MID) = th(1:limax,1:ljmax,1:KMAX_MID,nr) & - * (1.0+0.622*q(1:limax,1:ljmax,1:KMAX_MID,nr)) + ! Start with a long loop + DO i=1,limax + DO j=1,ljmax + rib(1:KMAX_MID) = 0.0 ! Initialize bulk Richardson number - ! Calculate Monin-Obuhkov length (Garratt, 1994) + part1=ust_r(i,j)*ust_r(i,j)*ust_r(i,j) + wst=AMAX1(wstar(i,j),1.0E-20) + part2=0.6*wst*wst*wst + wss=AMAX1(1.0E-4,(part1+part2)) + wss=EXP(0.333333*ALOG(wss)) + if (h_flux(i,j) < 0.0) then + tconv=0.0 ! Holstlag et al. (1990) + else + tconv=8.5*h_flux(i,j)/rho_surf(i,j)/CP/wss ! Conversion to kinematic flux + end if + + do k=KMAX_MID,1,-1 + dtmp=t_virt(i,j,k)-t_virt(i,j,KMAX_MID)-tconv + tog=0.5*(t_virt(i,j,k)+t_virt(i,j,KMAX_MID))/GRAV + wssq1=u_mid(i,j,k)*u_mid(i,j,k) + wssq2=v_mid(i,j,k)*v_mid(i,j,k) + wssq=wssq1+wssq2 + wssq=AMAX1(wssq,1.0E-4) + rib(k)=z_mid(i,j,k)*dtmp/(tog*wssq) + if(rib(k).ge.RIC) go to 9001 + end do +9001 continue + + ! Calculate PBL height according to Holtslag et al. (1993) + pblht(i,j)=0. + if(k.ne.KMAX_MID) then + fract1=(RIC-rib(k+1))/(rib(k)-rib(k+1)) + fract2=1.-fract1 + apbl=z_mid(i,j,k)*fract1 + pblht(i,j)=apbl+z_mid(i,j,k+1)*fract2 + if(pblht(i,j) > z_bnd(i,j,k+1)) then + kcbl=k + else + kcbl=k+1 + end if + end if + iblht(i,j)=kcbl + + if(pblht(i,j) 0.) then + eddyz(i,j,k)=kz0 + else + eddyz(i,j,k)=kz0+SZKM*SQRT(ss)*(rich(k)-ri)/rich(k) + end if + eddyz(i,j,k)=AMIN1(eddyz(i,j,k),100.) + end do + + ! Eddy diffusivity coefficients for all regimes in the mixed layer + do k=iblht(i,j),KMAX_MID + if (mol(i,j) < 0.0) then !Unstable conditions + ri=(1.0-15.*z_mid(i,j,k)/mol(i,j))**(-0.25) + ri=ri/KARMAN/z_mid(i,j,k) + ri=ri*AMAX1(0.0,pblht(i,j)-z_mid(i,j,k)) + dthdz=ri*ust_r(i,j)**3. + goth=AMAX1(wstar(i,j),0.0) + dusq=0.4*goth**3. + ri=(dthdz+dusq)**(2./3.) + e(i,j,k)=0.5*ri*(2.6)**(2./3.) !Moeng and Sullivan (1994) + else + ri=z_bnd(i,j,k)/pblht(i,j) !Stable + ri=z_mid(i,j,k)/pblht(i,j) !New + ri=(1.0-ri) + ri=AMAX1(0.0,ri) + ri=(1.0-ri)**1.75 + e(i,j,k)=6.*ust_r(i,j)*ust_r(i,j)*ri !Lenshow(1988) + end if + + ! Calculate Ksi function using interpolation in the vertical + ! Alapaty (2001, 2003) + zvh=z_mid(i,j,k)/pblht(i,j) + do l=1,9 + if (zvh > zovh(l).and. zvh < zovh(l+1)) then + psi_zi(k)=(psi_z(l+1)-psi_z(l))/(zovh(l+1)-zovh(l)) + psi_zi(k)=psi_zi(k)*(zvh-zovh(l)) + psi_zi(k)=psi_zi(k)+psi_z(l) + psi_zi(k)=psi_zi(k)/2.0 !Normalized the value + end if + end do + end do + + ! Calculate integral for Ksi + psi_tke=0. + do k=KMAX_MID,iblht(i,j),-1 + psi_tke=psi_tke+psi_zi(k)*dzq(i,j,k)*sqrt(e(i,j,k)) + end do + psi_tke=psi_tke/pblht(i,j) + + do k=iblht(i,j),KMAX_MID !Calculate coefficients + goth=psi_tke + goth=goth*KARMAN*z_mid(i,j,k) + dthdz=z_mid(i,j,k)/pblht(i,j) + dthdz=1.0-dthdz + dthdz=AMAX1(1.0E-2,dthdz) + if(mol(i,j) > 0.0) then ! Stable + goth=sqrt(e(i,j,iblht(i,j))) ! Mihailovic (2004) + goth=goth*KARMAN*z_mid(i,j,k) + dthdz=z_mid(i,j,k)/pzpbl(i,j) + dthdz=1.0-dthdz + dthdz=AMAX1(1.0E-2,dthdz) + busfc=0.74+4.7*z_mid(i,j,KMAX_MID)/mol(i,j) + busfc=AMAX1(busfc,1.0) + dthdz=dthdz**1.50 ! test (2004) + eddyz(i,j,k)=goth*dthdz/busfc + else + dthdz=dthdz*dthdz + busfc=1.0 + eddyz(i,j,k)=goth*dthdz/busfc + end if + end do + + ! Checking procedure + do k=2,iblht(i,j)-1 + if(eddyz(i,j,k).le.0.0) THEN + eddyz(i,j,k)= KZ0LT + end if + end do + + ! Avoid phisically unrealistic values + do k=2,KMAX_MID + IF(eddyz(i,j,k).le.0.1) then + eddyz(i,j,k)=0.1 + end if + end do + + ! To avoid loss of mass/energy through top of the model + ! put eddyz (I,J,K) to zero at the last level from top + eddyz(i,j,KMAX_BND)=0.0 + + ! Calculate eddy coefficients at the interfaces + do k=2,KMAX_MID + eddyz(i,j,k)=0.5*(eddyz(i,j,k-1)+eddyz(i,j,k)) + ! if(i.eq.10.and.j.eq.10.) then + ! if (abs(u_xmj(i,j ,k,nr)-u_mid(i,j,k)).gt.5.) then + ! print *,"NEW ",i,j,u_xmj(i,j ,KMAX_MID,nr),u_mid(i,j,KMAX_MID) + ! end if + end do + + ! Transform values of the eddy coeficients into the the sigma coordinate + do k=2,KMAX_MID + eddyz(i,j,k)=eddyz(i,j,k)*((sigma_mid(k)-sigma_mid( k-1))/ & + ( z_mid(i,j,k)-z_mid(i,j,k-1)))**2. + end do + ENDDO + ENDDO ! long loop + + ! Store diffusivity coefficients into skh(i,j,k,nr) array + do k=2,KMAX_MID do i=1,limax - do j=1,ljmax - u_s = ustar_nwp(i,j) - mol(i,j) = -(ps(i,j,nr)*u_s*u_s*u_s)/ & - (KARMAN*GRAV*h_flux(i,j)*KAPPA) - enddo - enddo - - ! Calculate the convective velocity (wstar) - do i=1,limax - do j=1,ljmax - wstar(i,j) = GRAV*h_flux(i,j)*pzpbl(i,j)/rho_surf(i,j) & - /CP/th(i,j,KMAX_MID,nr) - if(wstar(i,j) < 0.) then - wstar(i,j)=-ABS(wstar(i,j))**(0.3333) - else - wstar(i,j)=(wstar(i,j))**(0.3333) - endif - enddo - enddo - - ! ------------------------------------------> - ! Start with a long loop ------------------------------------------> - ! ------------------------------------------> - DO i=1,limax - DO j=1,ljmax - - rib(1:KMAX_MID) = 0.0 ! Initialize bulk Richardson number - - part1=ust_r(i,j)*ust_r(i,j)*ust_r(i,j) - wst=AMAX1(wstar(i,j),1.0E-20) - part2=0.6*wst*wst*wst - wss=AMAX1(1.0E-4,(part1+part2)) - wss=EXP(0.333333*ALOG(wss)) - - if (h_flux(i,j) < 0.0) then - tconv=0.0 ! Holstlag et al. (1990) - else - tconv=8.5*h_flux(i,j)/rho_surf(i,j)/CP/wss ! Conversion to - ! kinematic flux - endif - - do k=KMAX_MID,1,-1 - dtmp=t_virt(i,j,k)-t_virt(i,j,KMAX_MID)-tconv - tog=0.5*(t_virt(i,j,k)+t_virt(i,j,KMAX_MID))/GRAV - wssq1=u_mid(i,j,k)*u_mid(i,j,k) - wssq2=v_mid(i,j,k)*v_mid(i,j,k) - wssq=wssq1+wssq2 - wssq=AMAX1(wssq,1.0E-4) - rib(k)=z_mid(i,j,k)*dtmp/(tog*wssq) - if(rib(k).ge.RIC) go to 9001 - enddo -9001 continue - - ! Calculate PBL height according to Holtslag et al. (1993) - pblht(i,j)=0. - if(k.ne.KMAX_MID) then - fract1=(RIC-rib(k+1))/(rib(k)-rib(k+1)) - fract2=1.-fract1 - apbl=z_mid(i,j,k)*fract1 - pblht(i,j)=apbl+z_mid(i,j,k+1)*fract2 - if(pblht(i,j) > z_bnd(i,j,k+1)) then - kcbl=k - else - kcbl=k+1 - endif - endif - iblht(i,j)=kcbl - - if(pblht(i,j) 0.) then - eddyz(i,j,k)=kz0 - else - eddyz(i,j,k)=kz0+SZKM*SQRT(ss)*(rich(k)-ri)/rich(k) - endif - eddyz(i,j,k)=AMIN1(eddyz(i,j,k),100.) - enddo - - ! Eddy diffusivity coefficients for all regimes in the mixed layer - - do k=iblht(i,j),KMAX_MID - if (mol(i,j) < 0.0) then !Unstable conditions - ri=(1.0-15.*z_mid(i,j,k)/mol(i,j))**(-0.25) - ri=ri/KARMAN/z_mid(i,j,k) - ri=ri*AMAX1(0.0,pblht(i,j)-z_mid(i,j,k)) - dthdz=ri*ust_r(i,j)**3. - goth=AMAX1(wstar(i,j),0.0) - dusq=0.4*goth**3. - ri=(dthdz+dusq)**(2./3.) - e(i,j,k)=0.5*ri*(2.6)**(2./3.) !Moeng and Sullivan (1994) - else - ri=z_bnd(i,j,k)/pblht(i,j) !Stable - ri=z_mid(i,j,k)/pblht(i,j) !New - ri=(1.0-ri) - ri=AMAX1(0.0,ri) - ri=(1.0-ri)**1.75 - e(i,j,k)=6.*ust_r(i,j)*ust_r(i,j)*ri !Lenshow(1988) - endif - - ! Calculate Ksi function using interpolation in the vertical - ! Alapaty (2001, 2003) - - zvh=z_mid(i,j,k)/pblht(i,j) - do l=1,9 - if (zvh > zovh(l).and. zvh < zovh(l+1)) then - psi_zi(k)=(psi_z(l+1)-psi_z(l))/(zovh(l+1)-zovh(l)) - psi_zi(k)=psi_zi(k)*(zvh-zovh(l)) - psi_zi(k)=psi_zi(k)+psi_z(l) - psi_zi(k)=psi_zi(k)/2.0 !Normalized the value - endif - enddo - enddo - - ! Calculate integral for Ksi - psi_tke=0. - do k=KMAX_MID,iblht(i,j),-1 - psi_tke=psi_tke+psi_zi(k)*dzq(i,j,k)*sqrt(e(i,j,k)) - enddo - - psi_tke=psi_tke/pblht(i,j) - - - - do k=iblht(i,j),KMAX_MID !Calculate coefficients - goth=psi_tke - goth=goth*KARMAN*z_mid(i,j,k) - dthdz=z_mid(i,j,k)/pblht(i,j) - dthdz=1.0-dthdz - dthdz=AMAX1(1.0E-2,dthdz) - if(mol(i,j) > 0.0) then !Stable - goth=sqrt(e(i,j,iblht(i,j))) ! Mihailovic (2004) - goth=goth*KARMAN*z_mid(i,j,k) ! ----------------- - dthdz=z_mid(i,j,k)/pzpbl(i,j) ! ----------------- - dthdz=1.0-dthdz - dthdz=AMAX1(1.0E-2,dthdz) - busfc=0.74+4.7*z_mid(i,j,KMAX_MID)/mol(i,j) - busfc=AMAX1(busfc,1.0) - dthdz=dthdz**1.50 !test (2004) - eddyz(i,j,k)=goth*dthdz/busfc - else - dthdz=dthdz*dthdz - busfc=1.0 - eddyz(i,j,k)=goth*dthdz/busfc - endif - enddo - - ! Checking procedure - do k=2,iblht(i,j)-1 - if(eddyz(i,j,k).le.0.0) THEN - eddyz(i,j,k)= KZ0LT - endif - enddo - - ! Avoid phisically unrealistic values - do k=2,KMAX_MID - IF(eddyz(i,j,k).le.0.1) then - eddyz(i,j,k)=0.1 - endif - enddo - - ! To avoid loss of mass/energy through top of the model - ! put eddyz (I,J,K) to zero at the last level from top - eddyz(i,j,KMAX_BND)=0.0 - - ! Calculate eddy coefficients at the interfaces - do k=2,KMAX_MID - eddyz(i,j,k)=0.5*(eddyz(i,j,k-1)+eddyz(i,j,k)) !! - - ! if(i.eq.10.and.j.eq.10.) then - ! if (abs(u_xmj(i,j ,k,nr)-u_mid(i,j,k)).gt.5.) then - ! - ! print *,"NEW ",i,j,u_xmj(i,j ,KMAX_MID,nr),u_mid(i,j,KMAX_MID) - ! endif - enddo - - ! Transform values of the eddy coeficients into the the sigma coordinate - - do k=2,KMAX_MID - eddyz(i,j,k)=eddyz(i,j,k)*((sigma_mid(k)-sigma_mid( k-1))/ & - ( z_mid(i,j,k)-z_mid(i,j,k-1)))**2. - - enddo - - ENDDO !----------------------------------------> - ENDDO !----------------------------------------> - !----------------------------------------> - - ! Store diffusivity coefficients into skh(i,j,k,nr) array - do k=2,KMAX_MID - do i=1,limax - do j=1,ljmax - SigmaKz(i,j,k,nr)=eddyz(i,j,k) - enddo - enddo - enddo - - ! For plotting set pblht = pzpbl - - pzpbl(:,:) = pblht(:,:) - - end subroutine tkediff - !--------------------------------------------------------------- - - - subroutine Getmeteofield(meteoname,namefield,nrec,& - ndim,unit,validity,field,needed,found) - ! - ! Read the meteofields and distribute to nodes - ! - - - implicit none - - real, dimension(*),intent(out) :: field ! dimensions: (LIMAX,LJMAX) + do j=1,ljmax + SigmaKz(i,j,k,nr)=eddyz(i,j,k) + end do + end do + end do - character(len=*),intent(in) :: meteoname,namefield - character(len=*),intent(out) :: unit,validity - integer,intent(in) :: nrec,ndim - logical,intent(in) ,optional :: needed - logical,intent(out),optional :: found - character(len=len(namefield)) :: namefield_met - ! integer*2, allocatable ::var_global(:,:,:) ! faster if defined with - ! fixed dimensions for all - ! nodes? - real :: scalefactors(2),x,y - integer :: KMAX,ijk,i,k,j,nfetch,k1,k2,istart,jstart,Nlevel,kstart,kend - logical :: reverse_k - real, allocatable,save ::meteo_3D(:,:,:) + ! For plotting set pblht = pzpbl + pzpbl(:,:) = pblht(:,:) +end subroutine tkediff +subroutine Getmeteofield(meteoname,namefield,nrec,& + ndim,unit,validity,field,needed,found) + !---------------------------------------------------------------------- + ! Read the meteofields and distribute to nodes + !---------------------------------------------------------------------- + implicit none - validity='' - call_msg = "GetMeteofield" // trim(namefield) + real, dimension(*),intent(out) :: field ! dimensions: (LIMAX,LJMAX) + + character(len=*),intent(in) :: meteoname,namefield + character(len=*),intent(out) :: unit,validity + integer,intent(in) :: nrec,ndim + logical,intent(in) ,optional :: needed + logical,intent(out),optional :: found + character(len=len(namefield)) :: namefield_met + + real :: scalefactors(2) + integer :: KMAX,ijk,i,k,j,nfetch,k1,k2,istart,jstart,Nlevel,kstart,kend + logical :: reverse_k + real, allocatable,save ::meteo_3D(:,:,:) + + validity='' + call_msg = "GetMeteofield" // trim(namefield) + + if(ndim==3)KMAX=KMAX_MET + if(ndim==2)KMAX=1 + + if(MANUAL_GRID)then + Nlevel=37 +! call ReadField_CDF(meteoname,namefield,field, & +! Nlevel,interpol='conservative',needed=.true.,debug_flag=.false.) + if(.not.allocated(meteo_3D))allocate(meteo_3D(Nlevel,LIMAX,LJMAX)) + meteo_3D=0.0 + if(ndim==3)then + if(trim(namefield)=='u_wind')then +! call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & + call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='conservative', & +! use_lat_name='lat_u', use_lon_name='lon_u', & + stagg='stagg_u',& + needed=needed,found=found,unit=unit,debug_flag=.false.) + elseif(trim(namefield)=='v_wind') then +! call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & + call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='conservative', & +! use_lat_name='lat_v', use_lon_name='lon_v', & + stagg='stagg_v',& + needed=needed,found=found,unit=unit,debug_flag=.false.) + else + call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & + needed=needed,found=found,unit=unit,debug_flag=.false.) + end if + validity='not set' + ! CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) - if(ndim==3)KMAX=KMAX_MET - if(ndim==2)KMAX=1 + ! interpolate vertically + call vertical_interpolate(meteoname,meteo_3D,Nlevel,field,.false.) - if(MANUAL_GRID)then - Nlevel=37 -! call ReadField_CDF(meteoname,namefield,field, & -! Nlevel,interpol='conservative',needed=.true.,debug_flag=.false.) - if(.not.allocated(meteo_3D))allocate(meteo_3D(Nlevel,LIMAX,LJMAX)) - meteo_3D=0.0 - if(ndim==3)then - if(trim(namefield)=='u_wind')then -! call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & - call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='conservative', & -! use_lat_name='lat_u', use_lon_name='lon_u', & - stagg='stagg_u',& - needed=needed,found=found,unit=unit,debug_flag=.false.) - else if(trim(namefield)=='v_wind') then -! call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & - call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='conservative', & -! use_lat_name='lat_v', use_lon_name='lon_v', & - stagg='stagg_v',& - needed=needed,found=found,unit=unit,debug_flag=.false.) - else - call ReadField_CDF(meteoname,namefield,meteo_3D,nstart=nrec,kstart=1,kend=Nlevel,interpol='zero_order', & - needed=needed,found=found,unit=unit,debug_flag=.false.) - endif - validity='not set' - ! CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) - !interpolate vertically - - call vertical_interpolate(meteoname,meteo_3D,Nlevel,field,.false.) - - elseif(ndim==2)then - call ReadField_CDF(meteoname,namefield,field(1),nstart=nrec,interpol='zero_order', & + elseif(ndim==2)then + call ReadField_CDF(meteoname,namefield,field(1),nstart=nrec,interpol='zero_order', & needed=needed,found=found,unit=unit,debug_flag=.false.) - !write(*,*)'METVAL ',trim(namefield),me,field(40),nrec - !NB: need to fix validity - validity='not set' - - endif + ! write(*,*)'METVAL ',trim(namefield),me,field(40),nrec + ! NB: need to fix validity + validity='not set' + end if elseif(MET_SHORT)then - if(MasterProc)then - ! allocate(var_global(GIMAX,GJMAX,KMAX)) - nfetch=1 - call GetCDF_short(namefield,meteoname,var_global,GIMAX,IRUNBEG,GJMAX, & + if(MasterProc)then + nfetch=1 + call GetCDF_short(namefield,meteoname,var_global,GIMAX,IRUNBEG,GJMAX, & JRUNBEG,KMAX,nrec,nfetch,scalefactors,unit,validity,needed=needed) - else - ! allocate(var_global(1,1,1)) !just to have the array defined - endif + end if - !note: var_global is defined only for me=0 - call global2local_short(var_global,var_local,MSG_READ4,GIMAX,GJMAX,& + !note: var_global is defined only for me=0 + call global2local_short(var_global,var_local,MSG_READ4,GIMAX,GJMAX,& KMAX,1,1) - CALL MPI_BCAST(scalefactors,8*2,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(validity,50,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(unit,50,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - !scalefactors=1.0 - !validity=' ' - !unit=' ' - if(present(found))found=(validity/=field_not_found) - - ! deallocate(var_global) - - if(KMAX==1)then + CALL MPI_BCAST(scalefactors,8*2,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(validity,50,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(unit,50,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + !scalefactors=1.0 + !validity=' ' + !unit=' ' + if(present(found))found=(validity/=field_not_found) + + if(KMAX==1)then + ijk=0 + k=1 + do j=1,LJMAX + do i=1,LIMAX + ijk=ijk+1 + field(ijk)=var_local(i,j,k)*scalefactors(1)+scalefactors(2) + end do + end do + else + if(External_Levels_Def)then + !interpolate vertically if the levels are not identical + ijk=0 + do k=1,KMAX_MID + k1=k1_met(k) + k2=k2_met(k) + do j=1,LJMAX + do i=1,LIMAX + ijk=ijk+1 + field(ijk)=(x_k1_met(k)*var_local(i,j,k1)& + +(1.0-x_k1_met(k))*var_local(i,j,k2))*scalefactors(1)& + +scalefactors(2) + end do + end do + end do + else ijk=0 - k=1 - do j=1,LJMAX - do i=1,LIMAX + do k=1,KMAX_MID!=KMAX + do j=1,LJMAX + do i=1,LIMAX ijk=ijk+1 field(ijk)=var_local(i,j,k)*scalefactors(1)+scalefactors(2) - enddo - enddo - else - if(External_Levels_Def)then - !interpolate vertically if the levels are not identical - ijk=0 - do k=1,KMAX_MID - k1=k1_met(k) - k2=k2_met(k) - do j=1,LJMAX - do i=1,LIMAX - ijk=ijk+1 - field(ijk)=(x_k1_met(k)*var_local(i,j,k1)+(1.0-x_k1_met(k))*var_local(i,j,k2))& - *scalefactors(1)+scalefactors(2) - enddo - enddo - enddo - else - ijk=0 - do k=1,KMAX_MID!=KMAX - do j=1,LJMAX - do i=1,LIMAX - ijk=ijk+1 - field(ijk)=var_local(i,j,k)*scalefactors(1)+scalefactors(2) - enddo - enddo - enddo - endif - endif + end do + end do + end do + end if + end if else - !data are read as real - !could also use ReadField to interpolate into a different grid! - - nfetch=1 - istart=1 - jstart=1 - - if(namefield==met(ix_u_xmj)%name .and. MET_C_GRID)istart=2!set origin at (2,1) for u-wind - if(namefield==met(ix_v_xmi)%name .and. MET_C_GRID)jstart=2!set origin at (1,2) for v-wind - reverse_k=.false. - - if(MET_REVERSE_K)reverse_k=.true. - - if(.not.allocated(meteo_3D))then - allocate(meteo_3D(LIMAX,LJMAX,KMAX_MET)) - meteo_3D=0.0 - endif - kstart=1 - kend=KMAX - namefield_met=namefield - if(namefield=='SMI1' .and. WRF_MET_CORRECTIONS)then - !has to fetch level 1 - kstart=1 - kend=1 - namefield_met='SMOIS' - endif - if(namefield=='SMI3' .and. WRF_MET_CORRECTIONS)then - !has to fetch level 3 - kstart=3 - kend=3 - namefield_met='SMOIS' - endif - - - call GetCDF_modelgrid(namefield_met,meteoname,meteo_3D,kstart,kend,nrec,nfetch,i_start=istart,& - j_start=jstart,reverse_k=reverse_k,needed=needed,found=found) - - if(KMAX==1)then + !data are read as real + !could also use ReadField to interpolate into a different grid! + + nfetch=1 + istart=1 + jstart=1 + + if(namefield==met(ix_u_xmj)%name .and. MET_C_GRID)istart=2!set origin at (2,1) for u-wind + if(namefield==met(ix_v_xmi)%name .and. MET_C_GRID)jstart=2!set origin at (1,2) for v-wind + + reverse_k=.false. + if(MET_REVERSE_K)reverse_k=.true. + + if(.not.allocated(meteo_3D))then + allocate(meteo_3D(LIMAX,LJMAX,KMAX_MET)) + meteo_3D=0.0 + end if + kstart=1 + kend=KMAX + namefield_met=namefield + if(namefield=='SMI1' .and. WRF_MET_CORRECTIONS)then + !has to fetch level 1 + kstart=1 + kend=1 + namefield_met='SMOIS' + end if + if(namefield=='SMI3' .and. WRF_MET_CORRECTIONS)then + !has to fetch level 3 + kstart=3 + kend=3 + namefield_met='SMOIS' + end if + + call GetCDF_modelgrid(namefield_met,meteoname,meteo_3D,kstart,kend,nrec,& + nfetch,i_start=istart,j_start=jstart,reverse_k=reverse_k,& + needed=needed,found=found) + + if(KMAX==1)then + ijk=0 + k=1 + do j=1,LJMAX + do i=1,LIMAX + ijk=ijk+1 + field(ijk)=meteo_3D(i,j,k) + end do + end do + else + if(External_Levels_Def)then + ! interpolate vertically if the levels are not identical ijk=0 - k=1 - do j=1,LJMAX - do i=1,LIMAX + do k=1,KMAX_MID + k1=k1_met(k) + k2=k2_met(k) + do j=1,LJMAX + do i=1,LIMAX + ijk=ijk+1 + field(ijk)=x_k1_met(k)*meteo_3D(i,j,k1)+(1.0-x_k1_met(k))*meteo_3D(i,j,k2) + end do + end do + end do + else + ! use same vertical coordinates as meteo + ijk=0 + do k=1,KMAX_MID + do j=1,LJMAX + do i=1,LIMAX ijk=ijk+1 field(ijk)=meteo_3D(i,j,k) - enddo - enddo - else - if(External_Levels_Def)then - !interpolate vertically if the levels are not identical - ijk=0 - do k=1,KMAX_MID - k1=k1_met(k) - k2=k2_met(k) - do j=1,LJMAX - do i=1,LIMAX - ijk=ijk+1 - field(ijk)=x_k1_met(k)*meteo_3D(i,j,k1)+(1.0-x_k1_met(k))*meteo_3D(i,j,k2) - enddo - enddo - enddo - else - !use same vertical coordinates as meteo - ijk=0 - do k=1,KMAX_MID - do j=1,LJMAX - do i=1,LIMAX - ijk=ijk+1 - field(ijk)=meteo_3D(i,j,k) - enddo - enddo - enddo - - endif - endif - - endif + end do + end do + end do + + end if + end if + end if end subroutine Getmeteofield - subroutine GetCDF_short(varname,fileName,var,GIMAX,IRUNBEG,GJMAX,JRUNBEG & - ,KMAX,nstart,nfetch,scalefactors,unit,validity,needed) - ! - ! open and reads CDF file - ! - ! The nf90 are functions which return 0 if no error occur. - ! check is only a subroutine which check wether the function returns zero - ! - ! - implicit none - - character(len=*),intent(in) :: fileName - - character(len=*),intent(in) ::varname - character(len=*),intent(out) ::unit,validity - real,intent(out) :: scalefactors(2) - integer, intent(in) :: nstart,GIMAX,IRUNBEG,GJMAX,JRUNBEG,KMAX - integer, intent(inout) :: nfetch - integer(kind=2), dimension(GIMAX*GJMAX*KMAX*NFETCH),intent(out) :: var - logical,intent(in),optional :: needed - integer :: varID,ndims - integer :: ncFileID,status - real :: scale,offset - character(len=100) :: period_read=' ' - character(len=200),save :: filename_save='notsaved' - integer,save :: ncFileID_save=-99 - logical :: is_needed=.false. - - validity=' ' !initialisation - period_read=' ' !initialisation - scalefactors(1) = 1.0 !default - scalefactors(2) = 0. !default - call_msg = "GetCDF_short:"//trim(fileName) - is_needed=.false.;if(present(needed))is_needed=needed - - ndims=3 - if(KMAX==1)ndims=2 - !open an existing netcdf dataset - if(trim(filename_save)==trim(filename))then - ncFileID=ncFileID_save - else - if(ncFileID_save/=-99)then - call check(nf90_close(ncFileID_save)) - filename_save='notsaved' - endif +subroutine GetCDF_short(varname,fileName,var,GIMAX,IRUNBEG,GJMAX,JRUNBEG & + ,KMAX,nstart,nfetch,scalefactors,unit,validity,needed) + !---------------------------------------------------------------------- + ! open and reads CDF file + ! + ! The nf90 are functions which return 0 if no error occur. + ! check is only a subroutine which check wether the function returns zero + !---------------------------------------------------------------------- + implicit none + + character(len=*),intent(in) :: varname,fileName + character(len=*),intent(out) :: unit,validity + real,intent(out) :: scalefactors(2) + integer, intent(in) :: nstart,GIMAX,IRUNBEG,GJMAX,JRUNBEG,KMAX + integer, intent(inout) :: nfetch + integer(kind=2), dimension(GIMAX*GJMAX*KMAX*NFETCH),intent(out) :: var + logical,intent(in),optional :: needed + integer :: varID,ndims + integer :: ncFileID,status + real :: scale,offset + character(len=100) :: period_read=' ' + character(len=200),save :: filename_save='notsaved' + integer,save :: ncFileID_save=-99 + logical :: is_needed=.false. + + validity=' ' !initialisation + period_read=' ' !initialisation + scalefactors(1) = 1.0 !default + scalefactors(2) = 0. !default + call_msg = "GetCDF_short:"//trim(fileName) + is_needed=.false.;if(present(needed))is_needed=needed + + ndims=3 + if(KMAX==1)ndims=2 + !open an existing netcdf dataset + if(trim(filename_save)==trim(filename))then + ncFileID=ncFileID_save + else + if(ncFileID_save/=-99)then + call check(nf90_close(ncFileID_save)) + filename_save='notsaved' + end if call check(nf90_open(path=trim(fileName),mode=nf90_nowrite,ncid=ncFileID)) - ncFileID_save=ncFileID -filename_save=trim(filename) - endif - !get varID: - status = nf90_inq_varid(ncid=ncFileID,name=trim(varname),varID=VarID) - if(status/=nf90_noerr)then - call CheckStop(is_needed,"meteo field not found:"//trim(varname)) - validity=field_not_found - var=0.0 - ! call check(nf90_close(ncFileID)) - return - endif - - - !get scale factors - - status = nf90_get_att(ncFileID, VarID, "scale_factor", scale ) - if(status == nf90_noerr) scalefactors(1) = scale - status = nf90_get_att(ncFileID, VarID, "add_offset", offset ) - if(status == nf90_noerr) scalefactors(2) = offset - - !find unit - unit=' ' - status = nf90_get_att(ncFileID, VarID, "units", unit ) - if(status /= nf90_noerr)then - unit='unknown' !default - endif - !find validity - status = nf90_get_att(ncFileID, VarID, "validity", period_read ) - if(status == nf90_noerr)then - validity = trim(period_read) - else - status = nf90_get_att(ncFileID, VarID, "period_of_validity", & - period_read ) - if(status /= nf90_noerr)then - validity='instantaneous' !default - endif - endif - - ! if(Nfetch0.0)then - found_wrf_bucket = .true. - write(*,*)'assuming constant bucket size: ',wrf_bucket - else - write(*,*)'Not using buckets ',wrf_bucket - - endif - endif - endif + !check if the "bucket" method is used + status = nf90_get_att(ncFileID,nf90_global,"BUCKET_MM",wrf_bucket) + if(status == nf90_noerr)then + if(wrf_bucket>0.0)then + found_wrf_bucket = .true. + write(*,*)'assuming constant bucket size: ',wrf_bucket + else + write(*,*)'Not using buckets ',wrf_bucket + end if + end if + end if call check(nf90_close(ncFileID)) - endif + end if if(me_calc>=0)then - CALL MPI_BCAST(nhour_first,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(Nhh,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(METSTEP,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(found_wrf_bucket,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(nhour_first,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(Nhh,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(METSTEP,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(found_wrf_bucket,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) else - CALL MPI_BCAST(nhour_first,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) - CALL MPI_BCAST(Nhh,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) - CALL MPI_BCAST(METSTEP,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) - CALL MPI_BCAST(found_wrf_bucket,1,MPI_LOGICAL,0,MPI_COMM_IO,IERROR) - endif + CALL MPI_BCAST(nhour_first,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) + CALL MPI_BCAST(Nhh,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) + CALL MPI_BCAST(METSTEP,4*1,MPI_BYTE,0,MPI_COMM_IO,IERROR) + CALL MPI_BCAST(found_wrf_bucket,1,MPI_LOGICAL,0,MPI_COMM_IO,IERROR) + end if if(found_wrf_bucket)then - if(me_calc>=0)CALL MPI_BCAST(wrf_bucket,8,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - if(me_calc<0)CALL MPI_BCAST(wrf_bucket,8,MPI_BYTE,0,MPI_COMM_IO,IERROR) - met(ix_irainc)%read_meteo = found_wrf_bucket - met(ix_irainc)%needed = found_wrf_bucket - met(ix_irainnc)%read_meteo = found_wrf_bucket - met(ix_irainnc)%needed = found_wrf_bucket - endif -endsubroutine Check_Meteo_Date - -endmodule met_ml -! MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD MOD -! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + if(me_calc>=0)CALL MPI_BCAST(wrf_bucket,8,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + if(me_calc<0)CALL MPI_BCAST(wrf_bucket,8,MPI_BYTE,0,MPI_COMM_IO,IERROR) + met(ix_irainc)%read_meteo = found_wrf_bucket + met(ix_irainc)%needed = found_wrf_bucket + met(ix_irainnc)%read_meteo = found_wrf_bucket + met(ix_irainnc)%needed = found_wrf_bucket + end if +end subroutine Check_Meteo_Date + +end module met_ml diff --git a/MicroMet_ml.f90 b/MicroMet_ml.f90 index d69fbe7..bcfa6bd 100644 --- a/MicroMet_ml.f90 +++ b/MicroMet_ml.f90 @@ -1,7 +1,7 @@ ! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -165,7 +165,6 @@ function PsiH(zL) result (stab_h) ! Local real :: x - real, parameter :: a=1, b=0.667, c=5.0, d=0.35 if (zL < 0) then !unstable x = sqrt(1.0 - 16.0 * zL) @@ -190,7 +189,6 @@ function PsiM(zL) result (stab_m) ! notation must be preserved real :: stab_m real :: x - real, parameter :: a=1, b=0.667, c=5.0, d=0.35 if( zL < 0) then !unstable x = sqrt(sqrt(1.0 - 16.0*zL)) diff --git a/ModelConstants_ml.f90 b/ModelConstants_ml.f90 index 074d83f..05117b2 100644 --- a/ModelConstants_ml.f90 +++ b/ModelConstants_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -27,13 +27,14 @@ module ModelConstants_ml !---------------------------------------------------------------------------- ! Specifies a number of constants used in the model, and reads namelist -! file to (re-)configure where possible. +! file to (re-)configure where possible. ! Note that physical constants (e.g. gravity, Cp, etc ( are specified in ! the module PhysicalConstants_ml.f90) !---------------------------------------------------------------------------- use Aerofunctions, only: DpgV2DpgN use CheckStop_ml, only: CheckStop use ChemSpecs, only: species +use emep_Config_mod, only: PBL, EmBio, YieldModifications, LandCoverInputs use Io_Nums_ml, only: IO_NML, IO_LOG, IO_TMP use OwnDataTypes_ml, only: typ_ss, uEMEP_type use Precision_ml, only: dp @@ -70,7 +71,7 @@ module ModelConstants_ml type, public :: emep_useconfig character(len=10) :: testname = "STD" logical :: & ! Forest fire options - FOREST_FIRES = .true. &! + FOREST_FIRES = .true. &! ,SURF_AREA = .true. &! For improved aerosol uptake ,MACEHEADFIX = .true. &! Correction to O3 BCs (Mace Head Obs.) ,MACEHEAD_AVG = .false. &! Uses 10-year avg. Good for e.g. RCA runs. @@ -81,21 +82,25 @@ module ModelConstants_ml ,DEGREEDAY_FACTORS = .false. &! ,EMISSTACKS = F &! ,PFT_MAPS = .false. ! Future option - + + ! Mar 2017. Allow new MEGAN-like BVOC + ! Moved to emep_Config + ! character(len=10) :: GlobBvocMethod = "-" ! MEGAN + ! If USES%EMISTACKS, need to set: character(len=4) :: PlumeMethod = "none" !MKPS:"ASME","NILU","PVDI" ! N2O5 hydrolysis - ! During 2015 the aersol surface area calculation was much improved, and this + ! During 2015 the aersol surface area calculation was much improved, and this ! leads to the need for new n2o5 hydrolysis methods. DO NOT USE EmepReimer, ! but one of :; 'SmixTen' , 'Smix', 'Gamma:0.002' - character(len=20) :: n2o5HydrolysisMethod = 'SmixTen' + character(len=20) :: n2o5HydrolysisMethod = 'Smix' ! Selection of method for Whitecap calculation for Seasalt character(len=15) :: WHITECAPS = 'Callaghan' -end type emep_useconfig +end type emep_useconfig type(emep_useconfig), public, save :: USES type, public :: emep_debug @@ -105,15 +110,16 @@ module ModelConstants_ml ,AQUEOUS = .false. & ,BCS = .false. & ! BoundaryConditions ,BIO = .false. & !< Biogenic emissions - ,COLUMN = .false. & ! Used in Derived_ml for column integratton - ,DERIVED = .false. & ! + ,COLUMN = .false. & ! Used in Derived_ml for column integration + ,COLSRC = .false. & ! Volcanic emissions and Emergency scenarios + ,DERIVED = .false. & ! ,DRYDEP = .false. & ! Skips fast chemistry to save some CPU ,DRYRUN = .false. & ! Skips fast chemistry to save some CPU ,EQUIB = .false. & !MARS, EQSAM etc. ,FORESTFIRE = .false. & ,GLOBBC = .false. & ,GRIDVALUES = .false. & - ,HOURLY_OUTPUTS = .false. & ! + ,HOURLY_OUTPUTS = .false. & ! ,IOPROG = .false. & ,LANDDEFS = .false. & ,MAINCODE = .false. & !< debugs main code (Unimod) driver @@ -121,7 +127,7 @@ module ModelConstants_ml ,MY_DERIVED = .false. & ,pH = .false. & ,PHYCHEM = .false. & - ,RSUR = .false. & ! Surface resistance + ,RSUR = .false. & ! Surface resistance ,RUNCHEM = .false. & ! DEBUG%RUNCHEM is SPECIAL ,MY_WETDEP = .false. & ,SEASALT = .false. & @@ -130,16 +136,17 @@ module ModelConstants_ml ,SITES = .false. & ,SOLVER = .false. & ,SOA = .false. & - ,STOFLUX = .false. + ,STOFLUX = .false. ! integer debug options allow different levels of verbosity integer :: & PFT_MAPS = 0 & !< Future option ,LANDUSE = 0 & ! - ,DO3SE = 0 & ! + ,DO3SE = 0 & ! ,STOP_HH = -1 ! If positive, code will quite when hh==STOP_HH !---------------------------------------------------------- integer, dimension(2) :: IJ = [-999,-999] ! index for debugging print out - character(len=20) :: SPEC = 'O3' ! default. + character(len=20) :: SPEC = 'O3' ! default. + character(len=20) :: datetxt = '-' ! default. integer :: ISPEC = -999 ! Will be set after NML end type emep_debug type(emep_debug), public, save :: DEBUG @@ -155,9 +162,11 @@ module ModelConstants_ml character(len=40), dimension(20) :: pollemepName = "NOTSET" character(len=40) :: periodicity = "once" !How often new data should be read in character(len=40) :: type = "sectors" !steers special treatments -endtype emis_in +end type emis_in type(emis_in), public, dimension(5) :: emis_inputlist = emis_in() +character(len=40), dimension(20), public, save :: SecEmisOutPoll = "NOTSET" + character(len=40), public, save :: SECTORS_NAME='SNAP' character(len=200), public, save :: & @@ -167,7 +176,9 @@ module ModelConstants_ml meteo= 'DataDir/GRID/metdata_EC/YYYY/meteoYYYYMMDD.nc', & ! template for meteofile DegreeDayFactorsFile = 'MetDir/HDD18-GRID-YYYY.nc' ! template for DegreeDayFactors.nc -integer, public, save :: startdate(4),enddate(4) ! start and end of the run + + +integer, public, save :: startdate(4)=(/0,0,0,0/),enddate(4)=(/0,0,0,24/) ! start and end of the run !----------------------------------------------------------- ! Convection factor - reduces convective fluxes (which can be @@ -182,7 +193,7 @@ module ModelConstants_ml ! ! Might sometimes change for scenario runs (e.g. EnsClim): ,USE_AIRCRAFT_EMIS = .true. & ! Needs global file, see manual - ,USE_LIGHTNING_EMIS = .true. & + ,USE_LIGHTNING_EMIS = .true. & ! ! More experimental: ,USE_ROADDUST = .false. & ! TNO Road Dust routine. So far with simplified "climate-correction" factor @@ -190,51 +201,52 @@ module ModelConstants_ml ,TEGEN_DATA = .true. & ! Interpolate global data to make dust if USE_DUST=.true. ,INERIS_SNAP1 = .false. & !(EXP_NAME=="TFMM"), & ! Switches off decadal trend ,INERIS_SNAP2 = .false. & !(EXP_NAME=="TFMM"), & ! Allows near-zero summer values - ,USE_ASH = .false. & ! Ash from Volcanic Eruption + ,USE_ASH = .false. & ! Ash from Volcanic Eruption, w/gravitational settling + ,USE_PreADV = .false. & ! Column Emissions are preadvected when winds are very strong + ,USE_NOCHEM = .false. & ! Turns of chemistry for emergency runs ,USE_AOD = .false. & ,USE_POLLEN = .false. & ! EXPERIMENTAL. Only works if start Jan 1 -!,USE_GRAVSET = .false. & ! Gravitationsl settlign, very hardcoded, just testing ,USE_AMINEAQ = .false. & ! MKPS ,ANALYSIS = .false. & ! EXPERIMENTAL: 3DVar data assimilation ,USE_FASTJ = .false. & ! use FastJ_ml for computing rcphot ! ! Output flags ,SELECT_LEVELS_HOURLY = .false. & ! for FORECAST, 3DPROFILES - ,JUMPOVER29FEB = .false. ! When current date is 29th February, jump to next date. - !NB: this is not identical to assuming not a leap year, - !for instance the assumed number of days in the year will still be 366 + ,ZERO_ORDER_ADVEC = .false. & ! force zero order horizontal and vertical advection + ,JUMPOVER29FEB = .false. ! When current date is 29th February, jump to next date. + logical, public, save :: USE_uEMEP = .false. ! make local fraction of pollutants -type(uEMEP_type), public, save :: uEMEP ! could be moved to own file when uEMEP is more mature +type(uEMEP_type), public, save :: uEMEP ! The parameters steering uEMEP + - integer, public, save :: & FREQ_HOURLY = 1 ! 3Dhourly netcdf special output frequency -! Soil NOx. Choose EURO for better spatial and temp res, but for +! Soil NOx. Choose EURO for better spatial and temp res, but for ! global runs need global monthly. Variable USE_SOILNOX set from ! these below. ! ! Also, is scaling needed for EURO_SOILNOX? -! The Euro soil NO emissions are based upon average Nr-deposition calculated -! for the 2000s, as given in the AnnualNdep.nc files. For future years a -! new AnnualNdep.nc could be pre-calculated. A simpler but approximate -! way is to scale with some other factor, e.g. the ratio of emissions over -! some area (EMEP, or EU) in year YYYY divided by year 2005 values. +! The Euro soil NO emissions are based upon average Nr-deposition calculated +! for the 2000s, as given in the AnnualNdep.nc files. For future years a +! new AnnualNdep.nc could be pre-calculated. A simpler but approximate +! way is to scale with some other factor, e.g. the ratio of emissions over +! some area (EMEP, or EU) in year YYYY divided by year 2005 values. ! Remember, soil-NO emissions are *very* uncertain. logical, public, save :: & USE_EURO_SOILNOX = .true. & ! ok, but diff for global + Euro runs ,USE_GLOBAL_SOILNOX = .false. & ! Need to design better switch ,USE_SOILNOX = .true. ! DO NOT ALTER: Set after config - real, public, save :: EURO_SOILNOX_DEPSCALE = 1.0 ! + real, public, save :: EURO_SOILNOX_DEPSCALE = 1.0 ! !NB: *OCEAN* are internal variables. Cannot be set manually. logical, public, save :: USE_OCEAN_DMS = .false. !set automatically true if found. logical, public, save :: FOUND_OCEAN_DMS = .false. !set automatically true if found logical, public, save :: USE_OCEAN_NH3 = .false. !set automatically true if found -! Methane background. - real, public, save :: BGND_CH4 = -1 ! -1 gives defaults in BoundaryConditions_ml, +! Methane background. + real, public, save :: BGND_CH4 = -1 ! -1 gives defaults in BoundaryConditions_ml, ! To skip rct value (jAero work) integer, public, save, dimension(10) :: SKIP_RCT = -1 ! -1 gives defaults ! @@ -252,7 +264,7 @@ module ModelConstants_ml USE_SOILNH3 = .false., & ! DUMMY VALUES, DO NOT USE! USE_ZREF = .false., & ! testing EXTENDEDMASSBUDGET = .false., & ! extended massbudget outputs - LANDIFY_MET = .false. + LANDIFY_MET = .false. logical, public :: & USE_EtaCOORDINATES=.true. ! default since October 2014 @@ -280,7 +292,7 @@ module ModelConstants_ml logical, public, save :: & SEAFIX_GEA_NEEDED = .false. ! only if problems. Read from ModelConstants_config - + !============================================================================= !+ 1) Define first dimensions that might change quite often - for different ! run domains @@ -298,7 +310,7 @@ module ModelConstants_ml ! EMIS_TEST can be merged with EMIS_SOURCE after tests character(len=20), save, public :: & EMIS_SOURCE = "Mixed", & ! "Mixed" or old formats: "emislist" or "CdfFractions" - EMIS_TEST = "None" ! "None" or "CdfSnap" + EMIS_TEST = "None" ! "None" or "CdfSnap" Logical , save, public :: & EMIS_OUT = .false. ! output emissions in separate files (memory demanding) @@ -322,7 +334,7 @@ module ModelConstants_ml integer, public, save :: & ! Actual number of processors in longitude, latitude NPROCX, NPROCY, NPROC ! and total. NPROCY must be 2 for GLOBAL runs. - + CHARACTER(LEN=3), public, save :: & DOMAIN_DECOM_MODE='' ! override parinit(Pole_singular) option (Par_ml) @@ -345,7 +357,6 @@ module ModelConstants_ml ,PALEO_TEST = .false. & ,DEBUG_BLM = .false. & ! Produces matrix of differnt Kz and Hmix ,DEBUG_DERIVED = .false. & - ,DEBUG_COLUMN = .false. & ! Extra option in Derived ,DEBUG_ECOSYSTEMS = .false. & ,DEBUG_EMISSTACKS = .false. & ,DEBUG_Kz = .false. & @@ -366,7 +377,7 @@ module ModelConstants_ml ,DEBUG_NH3 = .false. & ! NH3Emis experimental ,DEBUG_OUTPUTCHEM = .false. & ! Output of netcdf results ,DEBUG_OUT_HOUR = .false. & ! Debug Output_hourly.f90 - ,DEBUG_POLLEN = .false. & + ,DEBUG_POLLEN = .false. & !MV ,DEBUG_RUNCHEM = .false. & ! DEBUG_RUNCHEM is SPECIAL ,DEBUG_DUST = .false. & ! Skips fast chemistry to save some CPU ,DEBUG_ROADDUST = .false. & @@ -374,8 +385,7 @@ module ModelConstants_ml ,DEBUG_WETDEP = .false. & ,DEBUG_RB = .false. & ,DEBUG_SOILWATER = .false. & - ,DEBUG_SOILNOX = .false. & - ,DEBUG_COLSRC = .false. ! Volcanic emissions and Emergency scenarios + ,DEBUG_SOILNOX = .false. !============================================================================= ! 3) Source-receptor runs? @@ -407,7 +417,7 @@ module ModelConstants_ml ! generally only change when switching Met-driver integer, public, parameter :: & !TREEX NLANDUSEMAX = 19 & ! Number of land use types in Inputs.Landuse file - NLANDUSEMAX = 30 & ! Max num land use types in Inputs.Landuse file + NLANDUSEMAX = 40 & ! Max num land use types in Inputs.Landuse file , KTOP = 1 & ! K-value at top of domain , KWINDTOP = 5 & ! Define extent needed for wind-speed array , NMET = 2 & ! No. met fields in memory @@ -419,18 +429,18 @@ module ModelConstants_ml !Namelist controlled: aerosols !Number of aerosol sizes (1-fine, 2-coarse, 3-'giant' for sea salt ) -! FINE_PM = 1, COAR_NO3 = 2, COAR_SS = 3, COAR DUST = 4,pollen = 5 +! FINE_PM = 1, COAR_NO3 = 2, COAR_SS = 3, COAR DUST = 4,pollen = 5 integer, parameter :: NSAREA_DEF = 8 ! needs to be consistent with type below type, public :: aero_t character(len=15) :: EQUILIB = 'MARS ' !aerosol themodynamics logical :: DYNAMICS = .false. - integer :: NSIZE = 5 - real, dimension(5) :: & - DpgV =[0.33e-6, 3.0e-6,4.8e-6,5.0e-6,22e-6] & ! diameter [m] - ,DpgN =[ -1.0, -1.0, -1.0, -1.0, -1.0] & ! to be calculated - ,sigma =[ 1.8, 2.0, 2.0, 2.2, 2.0] & - ,PMdens=[ 1600.0, 2200.0,2200.0,2600.0,800.0] & ! density [kg/m3] + integer :: NSIZE = 7 + real, dimension(7) :: & + DpgV =[0.33e-6,3.0e-6,4.8e-6,5.0e-6,22e-6,28e-6,32e-6] & ! diameter [m] + ,DpgN =[ -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0] & ! to be calculated + ,sigma =[ 1.8, 2.0, 2.0, 2.2, 2.0, 2.0, 2.0] & + ,PMdens=[ 1600.0,2200.0,2200.0,2600.0,800.0,800.0,800.0] & ! density [kg/m3] ,Vs = 0.0 ! Settling velocity (m/s). Easiest to define here ! For surface area we track the following (NSD=not seasalt or dust) @@ -453,6 +463,7 @@ module ModelConstants_ml !! We will put the filename, and params (SGS, EGS, etc) in !! the _Params array. character(len=15), public, save, dimension(20) :: FLUX_VEGS="" +character(len=15), public, save, dimension(20) :: FLUX_IGNORE="" ! e.g. Water, desert.. character(len=15), public, save, dimension(20) :: VEG_2dGS="" character(len=99), public, save, dimension(10) :: VEG_2dGS_Params="" integer, public, save :: nFluxVegs = 0 ! reset in Landuse_ml @@ -467,7 +478,7 @@ module ModelConstants_ml integer, public, parameter :: END_OF_EMEPDAY = 6 real, public, save :: & - dt_advec, & ! time-step for advection (s), grid resolution dependent + dt_advec = -999.9, & ! time-step for advection (s), grid resolution dependent dt_advec_inv ! =1/dt_advec ! NTDAY: Number of 2D O3 to be saved each day (for SOMO) @@ -530,11 +541,13 @@ module ModelConstants_ml IOU_INST=1,IOU_YEAR=2,IOU_MON=3,IOU_DAY=4,IOU_HOUR=5,IOU_HOUR_INST=6, & ! Derived output IOU_HOUR_EXTRA=7,IOU_HOUR_EXTRA_MEAN=8, & ! additional hourly output IOU_MAX_MAX=8 ! Max values for of IOU (for array declarations) + !IOU_MAX_MAX hardcoded in OwnDataTypes: please modify consistently! character, public, parameter :: & ! output shorthands, order should match IOU_* IOU_KEY(IOU_YEAR:IOU_HOUR_INST)=['Y','M','D','H','I'] character(len=*), public, parameter :: model="EMEP_MSC-W " +character(len=200), public :: fileName_O3_Top = "NOTSET" logical, parameter, public :: EmisSplit_OUT = .false. @@ -548,33 +561,42 @@ subroutine Config_ModelConstants(iolog) integer :: i, j, ispec, iostat logical,save :: first_call = .true. character(len=len(meteo)) :: MetDir='./' ! path from meteo - + character(len=*), parameter :: dtxt='Config_MC:' + NAMELIST /ModelConstants_config/ & DegreeDayFactorsFile, meteo & !meteo template with full path ,EXP_NAME & ! e.g. EMEPSTD, FORECAST, TFMM, TodayTest, .... ,USES & ! just testname so far + ,PBL & ! Mar2017 testing + ,EmBio & ! Mar2017 testing + ,YieldModifications & ! Allows dynamic change of chemical yields + ,LandCoverInputs & ! Apr2017 for CLM, etc ,AERO & ! Aerosol settings ,DEBUG & ! - ,MY_OUTPUTS & ! e.g. EMEPSTD, FORECAST, TFMM + ,MY_OUTPUTS & ! e.g. EMEPSTD, FORECAST, TFMM ,USE_SOILWATER, USE_CONVECTION, CONVECTION_FACTOR & ,USE_AIRCRAFT_EMIS, USE_LIGHTNING_EMIS, USE_ROADDUST, USE_DUST & ,USE_EURO_SOILNOX, USE_GLOBAL_SOILNOX, EURO_SOILNOX_DEPSCALE & - ,USE_SEASALT, USE_POLLEN, USE_ASH, USE_AOD & + ,USE_SEASALT, USE_POLLEN, USE_ASH, USE_NOCHEM, USE_AOD,USE_PreADV & ,USE_uEMEP, uEMEP & ,INERIS_SNAP1, INERIS_SNAP2 & ! Used for TFMM time-factors ,SELECT_LEVELS_HOURLY, FREQ_HOURLY & ! incl. FORECAST, 3DPROFILES ,FORECAST, ANALYSIS, SOURCE_RECEPTOR, VOLCANO_SR & ,SEAFIX_GEA_NEEDED & ! only if problems, see text above. - ,BGND_CH4 & ! Can reset background CH4 values - ,SKIP_RCT & ! Can skip some rct + ,BGND_CH4 & ! Can reset background CH4 values + ,SKIP_RCT & ! Can skip some rct ,EMIS_SOURCE, EMIS_TEST, EMIS_OUT, emis_inputlist, EmisDir & + ,SecEmisOutPoll & ! to output sectorwise emissions ,FLUX_VEGS & ! Allows user to add veg categories for eg IAM ouput + ,FLUX_IGNORE & ! Specify which landcovers don't need FLUX ,VEG_2dGS & ! Allows 2d maps of growing seasons ,VEG_2dGS_Params & ! Allows 2d maps of growing seasons ,PFT_MAPPINGS & ! Allows use of external LAI maps ,NETCDF_DEFLATE_LEVEL, RUNDOMAIN, DOMAIN_DECOM_MODE & - ,JUMPOVER29FEB, HOURLYFILE_ending, USE_WRF_MET_NAMES - + ,JUMPOVER29FEB, HOURLYFILE_ending, USE_WRF_MET_NAMES & + ,dt_advec & ! can be set to override dt_advec + ,ZERO_ORDER_ADVEC &! force zero order horizontal and vertical advection + ,fileName_O3_Top NAMELIST /Machine_config/ DataPath NAMELIST /INPUT_PARA/GRID,iyr_trend,runlabel1,runlabel2,& @@ -587,7 +609,7 @@ subroutine Config_ModelConstants(iolog) USE_SOILNOX = USE_EURO_SOILNOX .or. USE_GLOBAL_SOILNOx ! Convert DEBUG%SPEC to index - if(first_call) then + if(first_call)then ispec = find_index( DEBUG%SPEC, species(:)%name ) ! print *, "debug%spec testing", ispec, trim(DEBUG%SPEC) call CheckStop(ispec<1,"debug%spec not found"//trim(DEBUG%SPEC)) @@ -596,16 +618,16 @@ subroutine Config_ModelConstants(iolog) do i = 1, size(AERO%DpgN(:)) AERO%DpgN(i) = DpgV2DpgN(AERO%DpgV(i),AERO%sigma(i)) - enddo - endif + end do + end if if(MasterProc)then - ! write(*, * ) "NAMELIST IS " + write(*, * ) dtxt//"NAMELIST START " ! write(*, NML=ModelConstants_config) ! write(*,* ) "NAMELIST IOLOG IS ", iolog - write(iolog,*) "NAMELIST IS " + write(iolog,*) dtxt//"NAMELIST IS " write(iolog, NML=ModelConstants_config) - endif + end if DataPath(1) = '.'!default rewind(IO_NML) @@ -614,28 +636,27 @@ subroutine Config_ModelConstants(iolog) do i=1,size(DataPath) if(DataPath(i)=="NOTSET")then if(MasterProc)then - write(*,*)'WARNING: Could not find valid DataDir. Tried:' + write(*,*)dtxt//'WARNING: Could not find valid DataDir. Tried:' do j=1,i-1 write(*,*)trim(DataPath(j)) - enddo + end do stop - endif + end if exit - endif + end if ! INQUIRE(...) does not behave consistently across intel/gfortran open(IO_TMP,file=trim(DataPath(i)),iostat=iostat,action='read')! does not work without action='read' if(iostat==0)then DataDir=trim(DataPath(i)) - if(MasterProc)write(*,*)'DataDir set to',trim(DataDir) + if(MasterProc)write(*,*)dtxt//'DataDir set to',trim(DataDir) close(IO_TMP) exit - endif - enddo + end if + end do + rewind(IO_NML) read(IO_NML,NML=INPUT_PARA) - startdate(4)=0 ! meteo hour to start/end the run - enddate (4)=0 ! are set in assign_NTERM meteo = key2str(meteo,'DataDir',DataDir) meteo = key2str(meteo,'GRID',GRID) @@ -644,10 +665,37 @@ subroutine Config_ModelConstants(iolog) DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'GRID',GRID) DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'YYYY',startdate(1)) if(MasterProc)then - write(*,*)'Defined DegreeDayFactorsFile as:' + write(*,*)dtxt//'Defined DegreeDayFactorsFile as:' write(*,*)trim(DegreeDayFactorsFile) + end if + + if(trim(fileName_O3_Top)/="NOTSET")then + fileName_O3_Top = key2str(fileName_O3_Top,'DataDir',DataDir) + fileName_O3_Top = key2str(fileName_O3_Top,'YYYY',startdate(1)) + if(MasterProc)then + write(*,*)dtxt//'Reading 3 hourly O3 at top from :' + write(*,*)trim(fileName_O3_Top) + end if endif -endsubroutine Config_ModelConstants + ! LandCoverInputs + !print *, dtxt//'Landcover data:', trim(DataDir) + do i = 1, size(LandCoverInputs%MapFile(:)) + if ( LandCoverInputs%MapFile(i) /= 'NOTSET' ) then + LandCoverInputs%MapFile(i)= & + key2str(LandCoverInputs%MapFile(i),'DataDir',DataDir) +! print *, dtxt//'Landcover file', i, trim(LandCoverInputs%MapFile(i)) + if(MasterProc)then + write(*,*)dtxt//'Landcover file', i, trim(LandCoverInputs%MapFile(i)) + end if + end if + end do + LandCoverInputs%LandDefs=& + key2str(LandCoverInputs%LandDefs,'DataDir',DataDir) + LandCoverInputs%Do3seDefs=& + key2str(LandCoverInputs%Do3seDefs,'DataDir',DataDir) + !print *, dtxt//'Landcover =>', LandCoverInputs + +end subroutine Config_ModelConstants endmodule ModelConstants_ml !_____________________________________________________________________________ diff --git a/MosaicOutputs_ml.f90 b/MosaicOutputs_ml.f90 index 1148d2e..b35b4da 100644 --- a/MosaicOutputs_ml.f90 +++ b/MosaicOutputs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -35,6 +35,7 @@ module MosaicOutputs_ml use DerivedFields_ml, only: f_2d, d_2d use EcoSystem_ml, only: NDEF_ECOSYSTEMS, DEF_ECOSYSTEMS, EcoSystemFrac, & FULL_ECOGRID, FULL_LCGRID, Is_EcoSystem +use GasParticleCoeffs_ml, only: NDRYDEP_CALC, CDDEP_O3 use Io_Progs_ml, only: datewrite use LandDefs_ml, only: LandDefs, LandType, Check_LandCoverPresent ! e.g. "CF" use Landuse_ml, only: LandCover ! for POD @@ -44,11 +45,10 @@ module MosaicOutputs_ml NLANDUSEMAX, IOU_INST,IOU_KEY use OwnDataTypes_ml, only: Deriv, print_deriv_type, typ_s5ind, typ_s1ind, typ_s3,& TXTLEN_DERIV, TXTLEN_SHORT -use SmallUtils_ml, only: find_index +use SmallUtils_ml, only: find_index, trims use SubMet_ml, only: Sub use TimeDate_ml, only: current_date, effectivdaynumber, print_date use Units_ml, only: Units_Scale,Group_Scale,group_umap -use Wesely_ml, only: NDRYDEP_CALC, CDDEP_O3 implicit none private @@ -62,11 +62,9 @@ module MosaicOutputs_ml public :: find_MosaicLC INCLUDE 'mpif.h' -INTEGER STATUS(MPI_STATUS_SIZE),INFO integer, public, save :: MMC_RH, MMC_CANO3, MMC_VPD, MMC_FST, & MMC_USTAR, MMC_INVL, MMC_GSTO, MMC_EVAP, MMC_LAI -character(len=30),private, save :: errmsg = "ok" ! Mosaic-specific outputs, e.g. VG_CF_HNO3 or Rns_GR_NH3 integer, public, save :: nMosaic = 0 @@ -100,7 +98,7 @@ subroutine Init_MosaicMMC(MOSAIC_METCONCS) MMC_GSTO = find_index("GSTO" ,MOSAIC_METCONCS) MMC_EVAP = find_index("EVAP" ,MOSAIC_METCONCS) MMC_LAI = find_index("LAI" ,MOSAIC_METCONCS) -endsubroutine Init_MosaicMMC +end subroutine Init_MosaicMMC !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Add_MosaicMetConcs(MOSAIC_METCONCS,MET_LCS,iotyp, nMET) character(len=*), intent(in) :: MOSAIC_METCONCS(:),MET_LCS(:),iotyp @@ -125,7 +123,7 @@ subroutine Add_MosaicMetConcs(MOSAIC_METCONCS,MET_LCS,iotyp, nMET) !-------------End of Check if LC present in this array ------! nMET = nMET + 1 - name = trim ( MOSAIC_METCONCS(ilab) ) // "_" // trim( MET_LCS(n) ) + name = trims ( MOSAIC_METCONCS(ilab) // "_" // MET_LCS(n) ) nMosaic = nMosaic + 1 call CheckStop(NMosaic>=MAX_MOSAIC_OUTPUTS,dtxt//"too many nMosaics, nMET") @@ -144,12 +142,12 @@ subroutine Add_MosaicMetConcs(MOSAIC_METCONCS,MET_LCS,iotyp, nMET) case("EVAP" );MosaicOutput(nMosaic)%unit = "mm" MosaicOutput(nMosaic)%avg = .false. ! accumulate MosaicOutput(nMosaic)%dt_scale = .true. - endselect + end select if(dbg0) call print_deriv_type(MosaicOutput(nMosaic)) - enddo MET_LC !n - enddo ! ilab -endsubroutine Add_MosaicMetConcs + end do MET_LC !n + end do ! ilab +end subroutine Add_MosaicMetConcs !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Add_NewMosaics(Mc,nMc) type(typ_s5ind), dimension(:), intent(in) :: Mc ! eg VG @@ -162,6 +160,7 @@ subroutine Add_NewMosaics(Mc,nMc) nMc = 0 MC_LOOP: do n = 1, size( Mc(:)%txt1 ) !------------------- Check if LC present in this array ------! + if ( Mc(n)%txt1 == '-' ) cycle MC_LOOP ! iLC = Check_LandCoverPresent("MMC-VG",n,Mc(:)%txt4,write_condition=.true.) if(iLC<0) cycle MC_LOOP !-------------End of Check if LC present in this array ------! @@ -169,13 +168,13 @@ subroutine Add_NewMosaics(Mc,nMc) typ = Mc(n)%txt2 ! VG poll = Mc(n)%txt3 ! O3, HNO3, ... lctxt = Mc(n)%txt4 ! Grid, SNL,.. - name = trim(typ)//"_"//trim(poll)//"_"//trim(lctxt) ! VG_O3_GRID? + name = trims( 'MSC_' // typ//"_"//poll//"_"//lctxt ) ! VG_O3_GRID? iadv = find_index(poll,species_adv(:)%name ) if(iadv<1) then if(MasterProc) write(*,*) "MOSSPEC not found ", iadv, trim(name) cycle MC_LOOP - endif + end if call CheckStop(iadv<1 .or. iadv>NSPEC_ADV,dtxt//" ERR: Mc _SPECS: Mc_SPECS") nMosaic = nMosaic + 1 @@ -193,12 +192,12 @@ subroutine Add_NewMosaics(Mc,nMc) MosaicOutput(nMosaic) = Deriv( & name, "Mosaic", typ, lctxt, "s/m", & iadv, -99, F , 1.0, T, Mc(n)%ind ) ! ind gives iotype - endselect + end select if(dbg0) write(*,*) "DEBUG nMc ", & - trim(name)//":"//trim(Mc(n)%txt2)//":"//trim(Mc(n)%txt3), iadv, iLC - enddo MC_LOOP -endsubroutine Add_NewMosaics + trims(name//":"//Mc(n)%txt2//":"//Mc(n)%txt3), iadv, iLC + end do MC_LOOP +end subroutine Add_NewMosaics !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Add_MosaicVegO3(nVEGO3) integer, intent(out) :: nVEGO3 @@ -231,7 +230,7 @@ subroutine Add_MosaicVegO3(nVEGO3) dt_scale = .true. case default call CheckStop(DEBUG%MOSAICS,dtxt//"vegclass errror"//veg%class ) - endselect + end select !------------------- Check if LC present in this array ------! iLC = Check_LandCoverPresent( "VEGO3_LCS", veg%TXTLC, .true. ) @@ -244,7 +243,7 @@ subroutine Add_MosaicVegO3(nVEGO3) nMosaic = nMosaic + 1 call CheckStop(NMosaic>=MAX_MOSAIC_OUTPUTS,dtxt//"too many nMos..EGO3") if(dbg0)& - write(*,*) "Moscaics", nMosaic, trim(name)// "->" //trim(veg%TXTLC) + write(*,*) "Moscaics", nMosaic, trims(name// "->" //veg%TXTLC) ! Deriv(name, class, subc, txt, unit ! Deriv index, f2d,LC, scale dt_scale avg? Inst Yr Mn Day @@ -253,8 +252,8 @@ subroutine Add_MosaicVegO3(nVEGO3) name, veg%class, veg%defn, veg%TXTLC, & units, n, -99, dt_scale, scale, F, veg%iotype ) - enddo VEGO3_LC !n -endsubroutine Add_MosaicVEGO3 + end do VEGO3_LC !n +end subroutine Add_MosaicVEGO3 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Add_MosaicDDEP(DDEP_ECOS,DDEP_WANTED,nDD) type(typ_s1ind), dimension(:), intent(in) :: DDEP_ECOS !e.g. (%name,DDEP_FREQ) @@ -292,17 +291,17 @@ subroutine Add_MosaicDDEP(DDEP_ECOS,DDEP_WANTED,nDD) xxname = xname if(xname(1:4)=="STO_") then xxname = xname(5:) - if(dbg0) print *, "STO_ ", trim(xname) // "=>"//trim(xxname) - endif + if(dbg0) print *, "STO_ ", trims(xname // "=>"// xxname) + end if iadv = find_index(xxname,species_adv(:)%name) ! Index in ix_adv arrays - if(iadv<1) print *, "OOPADVNOW", iadv, trim(xname) // trim(name) + if(iadv<1) print *, "OOPADVNOW", iadv, trims(xname // name) call CheckStop(iadv<1,dtxt//"Unknown in DDEP_WANTED SPEC: "//trim(xname)) call Units_Scale(DDEP_WANTED(i)%txt3,iadv,unitscale,units) if(dbg0) print *, "ADVNO ",n,iadv,trim(xname), unitscale case("GROUP") - igrp = find_index(xname,chemgroups(:)%name) ! array of members: chemgroups%ptr - if(igrp<1) print *, "OOPNOW", igrp, trim(xname) // trim(name) + igrp = find_index(xname,chemgroups(:)%name) ! array of members: chemgroups%specs + if(igrp<1) print *, "OOPNOW", igrp, trims(xname // name) call CheckStop(igrp<1,dtxt//"Unknown in DDEP_WANTED GROUP: "//trim(xname)) call Units_Scale(DDEP_WANTED(i)%txt3,-1,unitscale,units) ! Units_Scale(iadv=-1) returns 1.0 @@ -313,9 +312,9 @@ subroutine Add_MosaicDDEP(DDEP_ECOS,DDEP_WANTED,nDD) case default call CheckStop(DEBUG%MOSAICS,& dtxt//" unknown MosaicDDEP type "//trim(DDEP_WANTED(i)%txt2)) - endselect + end select - name = "DDEP_"//trim(xname)//"_m2"//trim(DDEP_ECOS(n)%name) + name = "DDEP_"//trims(xname//"_m2"//DDEP_ECOS(n)%name) ! Deriv(name, class, subc, txt, unit ! Deriv index, f2d,dt_scale, scale, avg? Inst/Yr/Mn/Day @@ -326,10 +325,10 @@ subroutine Add_MosaicDDEP(DDEP_ECOS,DDEP_WANTED,nDD) if(dbg0) then write(*,*) "DDEP setups", n, nMosaic call print_deriv_type(MosaicOutput(nMosaic)) - endif - enddo ! DDEP_SPECS - enddo ! DDEP_ECOS -endsubroutine Add_MosaicDDEP + end if + end do ! DDEP_SPECS + end do ! DDEP_ECOS +end subroutine Add_MosaicDDEP !<========================================================================== subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& Deploss) @@ -371,7 +370,7 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& invEcoFrac(:) = 0.0 do n=1,NDEF_ECOSYSTEMS if(EcoFrac(n)>1.0e-39) invEcoFrac(n)=1.0/EcoFrac(n) - enddo + end do ! Query - crops, outisde g.s. ???? if(first_call) then ! need to find indices @@ -379,17 +378,17 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& MosaicOutput(imc)%f2d = find_index(MosaicOutput(imc)%name,f_2d(:)%name) if(DEBUG%MOSAICS .and. MasterProc) write(*,*) dtxt//" f2D", imc, & trim(MosaicOutput(imc)%name), MosaicOutput(imc)%f2d - enddo + end do if(dbg)then write(*,*) dtxt//"ECOAREAS ", i,j do n=1,NDEF_ECOSYSTEMS write(*,"(a,i3,a,f14.4,g12.3)") dtxt//"ECOCHECK ", n, & DEF_ECOSYSTEMS(n), EcoFrac(n), invEcoFrac(n) - enddo + end do write(*,*) dtxt//"Done ECOCHECK ========================" - endif - endif + end if + end if first_call = .false. ! Ecosystem depositions, for grouped or individual species: @@ -410,7 +409,7 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& ! here and set d-2d at end if(dbg) write(*,"(a,a)") dtxt//"Add_Mosaic: "// & - trim(MosaicOutput(imc)%name), ", " // trim(subclass) + trims( MosaicOutput(imc)%name// ", "// subclass ) select case(subclass) case("DDEP") @@ -424,7 +423,7 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& Fflux = Fflux * Sub(0)%Gsto(CDDEP_O3)/Sub(0)%Gsur(CDDEP_O3) if(dbghh) print "(a,2i4,3es12.3)", dtxt//"NOWSDEP ", & nadv, current_date%hour, Sub(0)%Gsur(2), Sub(0)%Gsto(2), Fflux - endif + end if case(-size(chemgroups):-1) ! gropups gmap=>dryGroupUnits(imc) @@ -433,16 +432,16 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& nadv = gmap%iadv(n) Fflux = Fflux + Deploss(nadv)*gmap%uconv(n) & *sum(fluxfrac(nadv,:),Is_EcoSystem(iEco,:)) - enddo ! n + end do ! n case default call CheckStop(dtxt//" unknown DDEP Specie/Group") - endselect + end select if(DEBUG%MOSAICS.and.Fflux<0.0) then write(*,"(a,3i4,a)") dtxt//"DDEP Fflux CATASTR ", imc, f2d, iEco, & trim(MosaicOutput(imc)%name) call CheckStop(dtxt//"CATASTROPHE: "//MosaicOutput(imc)%name) - endif + end if ! - invEcoFracCF divides the flux per grid by the landarea of each ! ecosystem, to give deposition in units of mg/m2 of ecosystem. @@ -490,9 +489,9 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& write(*,*) "ERROR: DEPADV2CALC had size", size(DepAdv2Calc) do n = 1, size( DepAdv2Calc) write(*,*) "DEPADVLIST ", n, DepAdv2Calc(n) - enddo + end do call CheckStop(cdep<1,dtxt//"ERROR: Negative cdep") - endif + end if select case(subclass) case("VG" ) @@ -508,14 +507,14 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& ! output = -999.0 ! else ! output = 1.0/Gs - ! endif + ! end if !case("Rns") ! if(Gns < 1.0e-44)then ! output = -999.0 ! else ! output = 1.0/Gns - ! endif - endselect ! subclass + ! end if + end select ! subclass if(dbg) write(*,"(2i4,f9.3)") cdep, iLC, output @@ -525,16 +524,16 @@ subroutine Add_MosaicOutput(debug_flag,i,j,convfac,DepAdv2Calc,fluxfrac,& "name" ,MosaicOutput(imc)%name,& "subclass",MosaicOutput(imc)%subclass call CheckStop("OUTVEG UNDEF" // subclass ) - endif - endselect + end if + end select if(dbg) write(*,"(a,es12.3)") dtxt//"ADDED output: "// & trim(MosaicOutput(imc)%name), output d_2d(f2d,i,j,IOU_INST) = output - enddo ! Mosaic + end do ! Mosaic my_first_call = .false. -endsubroutine Add_MosaicOutput +end subroutine Add_MosaicOutput !<========================================================================== function find_MosaicLC(imc) result(iLC) ! Searches for index in LandType array, and sets to zero if grid or EU @@ -546,7 +545,7 @@ function find_MosaicLC(imc) result(iLC) case("Grid");iLC = FULL_LCGRID ! zero case("EU" );iLC = FULL_LCGRID ! zero case default;iLC = find_index(MosaicOutput(imc)%txt,LandDefs(:)%code) - endselect -endfunction find_MosaicLC + end select +end function find_MosaicLC !<========================================================================== endmodule MosaicOutputs_ml diff --git a/My_3DVar_ml.f90 b/My_3DVar_ml.f90 index 496d858..75004c4 100644 --- a/My_3DVar_ml.f90 +++ b/My_3DVar_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/My_Derived_ml.f90 b/My_Derived_ml.f90 index a29e963..4f2739b 100644 --- a/My_Derived_ml.f90 +++ b/My_Derived_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -48,7 +48,7 @@ module My_Derived_ml ! accessed here through subroutine calls - using just the (i,j) part ! of the bigger d_2d arrays ! -! NOTE (14/9/2015) - this routine will likely be deleted in future, as we are +! NOTE - this routine will likely be deleted in future, as we are ! moving most definitions to the config namelist system. !--------------------------------------------------------------------------- @@ -58,13 +58,13 @@ module My_Derived_ml use ChemSpecs ! Use IXADV_ indices... use ChemGroups_ml ! Allow all groups to ease compilation ! eg. OXN_GROUP, DDEP_OXNGROUP, BVOC_GROUP -use EmisDef_ml, only: EMIS_FILE +use EmisDef_ml, only: NSECTORS, EMIS_FILE, NEMIS_FILE, SecEmisOut, Nneighbors use EmisGet_ml, only: nrcemis, iqrc2itot use GridValues_ml, only: RestrictDomain use Io_Nums_ml, only: IO_NML use Io_Progs_ml, only: PrintLog use ModelConstants_ml,only: MasterProc, SOURCE_RECEPTOR, DEBUG, & !! => DEBUG_MY_DERIVED & - USE_AOD, USE_SOILNOX, USE_OCEAN_DMS, USE_uEMEP, & + USE_AOD, USE_SOILNOX, USE_OCEAN_DMS, USE_OCEAN_NH3, & IOU_KEY, & !'Y'=>IOU_YEAR,..,'I'=>IOU_HOUR_INST KMAX_MID, & ! => z dimension RUNDOMAIN, & @@ -75,7 +75,7 @@ module My_Derived_ml Add_NewMosaics, Add_MosaicVEGO3, Add_MosaicDDEP use OwnDataTypes_ml,only: Deriv, TXTLEN_DERIV, TXTLEN_SHORT,& - typ_s3, typ_s5ind, typ_s1ind + typ_s3, typ_s4, typ_s5ind, typ_s1ind use Par_ml, only: limax,ljmax ! => used x, y area use SmallUtils_ml, only: AddArray,LenArray,NOT_SET_STRING,WriteArray,find_index implicit none @@ -99,11 +99,14 @@ module My_Derived_ml !============ parameters for concentration + dep outputs ==================! integer, public, parameter :: & - MAX_NUM_DERIV2D = 250, & - MAX_NUM_DERIV3D = 16, & + MAX_NUM_DERIV2D = 343, & + MAX_NUM_DERIV3D = 179, & MAX_NUM_DDEP_ECOS = 6, & ! Grid, Conif, etc. MAX_NUM_DDEP_WANTED = NSPEC_ADV, & !plenty big - MAX_NUM_WDEP_WANTED = NSPEC_ADV !plenty big + MAX_NUM_WDEP_WANTED = NSPEC_ADV, & !plenty big + MAX_NUM_NEWMOS = 10, & !careful here, we multiply by next: + MAX_NUM_MOSCONCS = 10, & !careful here, we multiply by next: + MAX_NUM_MOSLCS = 10 !careful here, we multiply bY prev: character(len=TXTLEN_DERIV), public, save :: & wanted_deriv2d(MAX_NUM_DERIV2D) = NOT_SET_STRING, & wanted_deriv3d(MAX_NUM_DERIV3D) = NOT_SET_STRING @@ -136,13 +139,14 @@ module My_Derived_ml type(typ_s3), public, save, dimension(MAX_NUM_DDEP_WANTED) :: & DDEP_WANTED = typ_s3('-','-','-'), & ! e.g. typ_s3("SO2",SPEC,"mgS"), SDEP_WANTED = typ_s3('-','-','-') ! Stomatal deposition (for HTAP) -type(typ_s3), public, save, dimension(MAX_NUM_WDEP_WANTED) :: & - WDEP_WANTED = typ_s3('-','-','-') +type(typ_s4), public, save, dimension(MAX_NUM_WDEP_WANTED) :: & + WDEP_WANTED = typ_s4('-','-','-','-') character(len=TXTLEN_DERIV), public, parameter, dimension(4) :: & D2_SR = [character(len=TXTLEN_DERIV):: & ! all array members will have len=TXTLEN_DERIV - "SURF_MAXO3","SURF_PM25water","SOMO35","PSURF"] ! Surface pressure (for crosssection) + ! Surface pressure used for crosssection + "SURF_MAXO3","SURF_PM25water","SOMO35","PSURF"] !============ Extra parameters for model evaluation: ===================! !character(len=TXTLEN_DERIV), public, parameter, dimension(13) :: & @@ -162,26 +166,24 @@ module My_Derived_ml !- specify some species and land-covers we want to output ! dep. velocities for in netcdf files. Set in My_DryDep_ml. -type(typ_s5ind), public, parameter, dimension(1) :: & - NewMosaic =[typ_s5ind('Mosaic','VG','O3','Grid','cms','YMD')] +! NewMosaic seems to mean new-style, to avoid needing all combinations +! of MET & LC +type(typ_s5ind), public, save, dimension(MAX_NUM_NEWMOS) :: & + NewMosaic = typ_s5ind('-','-','-','-','-','-') + !A17 =[typ_s5ind('Mosaic','VG','O3','Grid','cms','YM')] +integer, private, save :: nOutputMosMet, nOutputMosLC, nOutputNewMos +character(len=10), private, save :: Mosaic_timefmt='YM' ! eg 'YMD' ! For met-data and canopy concs/fluxes ... -character(len=TXTLEN_DERIV), public, parameter, dimension(4) :: & - MOSAIC_METCONCS = [character(len=TXTLEN_DERIV):: & - ! all array members will have len=TXTLEN_DERIV - "USTAR","LAI","CanopyO3","FstO3"] ! SKIP CanopyO3 -!character(len=TXTLEN_DERIV), public, parameter, dimension(2) :: & -! MOSAIC_METCONCS = (/ "USTAR", "LAI " /) ! TFMM "VPD " & - ! ,"CanopyO3" & !SKIP - !,"VPD","FstO3","EVAP","Gsto" & !SKIP -!TFMM ,"USTAR","INVL"/) +character(len=TXTLEN_DERIV), public, save, dimension(MAX_NUM_MOSCONCS) :: & + MOSAIC_METCONCS = '-' ! = [character(len=TXTLEN_DERIV):: & + !,"VPD","FstO3","EVAP","Gsto" ,"USTAR","INVL"/) +! "USTAR","LAI","CanopyO3","FstO3"] ! SKIP CanopyO3 ! "g_sto" needs more work - only set as L%g_sto -character(len=TXTLEN_DERIV), public, save, dimension(6) :: & - MET_LCS = [character(len=TXTLEN_DERIV):: & - ! all array members will have len=TXTLEN_DERIV - !"DF","GR","CF","BF","NF"] - "DF","GR","BF","TC","IAM_DF","IAM_CR"] +character(len=TXTLEN_DERIV), public, save, dimension(MAX_NUM_MOSLCS) :: & + MET_LCS = '-' +! [character(len=TXTLEN_DERIV):: "DF","GR","BF","TC","IAM_DF","IAM_CR"] !---------------------- ! For some reason having this as a parameter caused problems for PC-gfortran runs. @@ -192,14 +194,14 @@ module My_Derived_ml logical, parameter, public :: EmisSplit_OUT = .false. -integer, private :: i,j,k,n, ivoc ! Local loop variables +integer, private :: i,j,k,n, ivoc, isec ! Local loop variables contains !========================================================================= subroutine Init_My_Deriv() - integer :: i, itot, nDD, nMET, nVEGO3=0, n1, istat, nMc + integer :: i, itot, nDD, nMET, nVEGO3=0, n1, istat, nMc, neigh integer :: nOutputConcs character(len=100) :: errmsg character(len=TXTLEN_DERIV), dimension(size(OutputConcs(:)%txt1)) :: & @@ -210,11 +212,13 @@ subroutine Init_My_Deriv() character(len=12), save :: sub='InitMyDeriv:' logical :: & lev3d_from_surface=.false. ! levels are to be read from surface up - + character(len=2):: isec_char + character(len=3):: neigh_char NAMELIST /OutputConcs_config/OutputMisc,OutputConcs,OutputVegO3 - NAMELIST /OutputDep_config/DDEP_ECOS, DDEP_WANTED, WDEP_WANTED, SDEP_WANTED - NAMELIST /OutputSize_config/fullrun_DOMAIN,month_DOMAIN,day_DOMAIN,hour_DOMAIN,& - num_lev3d,lev3d,lev3d_from_surface + NAMELIST /OutputDep_config/DDEP_ECOS, DDEP_WANTED, WDEP_WANTED,SDEP_WANTED,& + NewMosaic, MOSAIC_METCONCS, MET_LCS, Mosaic_timefmt + NAMELIST /OutputSize_config/fullrun_DOMAIN,month_DOMAIN,day_DOMAIN,& + hour_DOMAIN, num_lev3d,lev3d,lev3d_from_surface ! default output sizes fullrun_DOMAIN = RUNDOMAIN @@ -253,13 +257,16 @@ subroutine Init_My_Deriv() if(MasterProc)& call CheckStop(count(lev3d(1:i)==lev3d(i)),1,& "Init_My_Deriv, repeated levels in lev3d") - enddo + end do !! Find number of wanted OutoutConcs nOutputMisc = find_index("-", OutputMisc(:)%name, first_only=.true. ) -1 nOutputConcs = find_index("-", OutputConcs(:)%txt1, first_only=.true. ) -1 nOutputVegO3 = find_index("-", OutputVegO3(:)%name, first_only=.true. ) -1 nOutputWdep = find_index("-", WDEP_WANTED(:)%txt1, first_only=.true. ) -1 + nOutputMosMet = find_index("-", MOSAIC_METCONCS(:), first_only=.true. ) -1 + nOutputMosLC = find_index("-", MET_LCS(:), first_only=.true. ) -1 + nOutputNewMos = find_index("-", NewMosaic(:)%txt1, first_only=.true. ) -1 if(MasterProc) write(*,"(a,i3)") "NMLOUT nOUTMISC ", nOutputMisc do i = 1,nOutputMisc @@ -272,8 +279,8 @@ subroutine Init_My_Deriv() call AddArray(tag_name(1:1),wanted_deriv3d,NOT_SET_STRING,errmsg) else call AddArray(tag_name(1:1),wanted_deriv2d,NOT_SET_STRING,errmsg) - endif - enddo + end if + end do ! OutputVegO3 will be added to derived fields from within the Mosaics_ml ! after adding if(MasterProc) then @@ -285,15 +292,15 @@ subroutine Init_My_Deriv() do i = 1,size(DDEP_ECOS) if(all(SCAN(DDEP_ECOS(i)%ind,IOU_KEY)==0)) exit write(*,"(3a)") "NMLOUT DEP ", DDEP_ECOS(i)%name, DDEP_ECOS(i)%ind - enddo + end do do i = 1,size(DDEP_WANTED) if(DDEP_WANTED(i)%txt1=='-') exit write(*,"(2a)") "NMLOUT DDEP ", DDEP_WANTED(i)%txt1 - enddo + end do write(*,"(3a)")("NMLOUT WDEP ",& WDEP_WANTED(i)%txt1,WDEP_WANTED(i)%txt3, i=1,nOutputWdep) write(*,*) " END NMLOUT INSIDE Init_My_Deriv" - endif + end if call Init_MosaicMMC(MOSAIC_METCONCS) ! sets MMC_USTAR etc. @@ -308,35 +315,39 @@ subroutine Init_My_Deriv() do i = 1, size(EMIS_FILE) tag_name(1) = "Emis_mgm2_" // trim(EMIS_FILE(i)) call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) - enddo + end do + do i = 1, NEMIS_FILE + if(SecEmisOut(i))then + do isec=1,NSECTORS + write(tag_name(1),"(A,I0,A)")"Emis_mgm2_sec",isec,trim(EMIS_FILE(i)) + call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) + end do + endif + end do ! ind do i = 1, size(BVOC_GROUP) itot = BVOC_GROUP(i) tag_name(1) = "Emis_mgm2_BioNat" // trim(species(itot)%name) call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) - enddo + end do if(USE_SOILNOX) then tag_name(1) = "Emis_mgm2_BioNatNO" call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) - endif + end if if(USE_OCEAN_DMS)then tag_name(1) = "Emis_mgm2_DMS" call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) - endif - if(USE_uEMEP)then - !NOTE "Local_Fraction" must be AFTER "Local_Pollutant" and "Total_Pollutant" - tag_name(1:3) = [character(len=TXTLEN_DERIV)::& - "Local_Pollutant","Total_Pollutant","Local_Fraction"] - call AddArray( tag_name(1:3), wanted_deriv2d, NOT_SET_STRING, errmsg) -! tag_name(1:3) = [character(len=TXTLEN_DERIV)::& -! "Local_Fraction3D","Local_Pollutant3D","Total_Pollutant3D"] -! call AddArray( tag_name(1:3), wanted_deriv3d, NOT_SET_STRING, errmsg) - endif + end if + if(USE_OCEAN_NH3)then + tag_name(1) = "Emis_mgm2_Ocean_NH3" + call AddArray( tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) + end if + if(EmisSplit_OUT)then do i=1,max(18,nrcemis) tag_name(1) = "EmisSplit_mgm2_"//trim(species(iqrc2itot(i))%name) call AddArray(tag_name(1:1), wanted_deriv2d, NOT_SET_STRING, errmsg) - enddo - endif + end do + end if ! Do SR last, so we get PM25 after groups have been done call AddArray( D2_SR, wanted_deriv2d, NOT_SET_STRING, errmsg) @@ -344,7 +355,7 @@ subroutine Init_My_Deriv() if(.not.SOURCE_RECEPTOR) then !may want extra? call AddArray( D2_EXTRA, wanted_deriv2d, NOT_SET_STRING, errmsg) call CheckStop( errmsg, errmsg // "D2_EXTRA too long" ) - endif + end if !------------- Depositions to ecosystems -------------------------------- call Add_MosaicDDEP(DDEP_ECOS,DDEP_WANTED,nDD) @@ -359,28 +370,38 @@ subroutine Init_My_Deriv() do n = 1, nOutputVegO3 VEGO3_OUTPUTS(n) = OutputVegO3(n) - if(debug0) write(*,*) "VEGO3 NUMS ", n, n1, trim(OutputVegO3(n)%name) - enddo - if(MasterProc)call WriteArray(VEGO3_OUTPUTS(:)%name,nOutputVegO3," VEGO3 OUTPUTS:") - call Add_MosaicVEGO3(nOutVEGO3) ! nVEGO3 is output, excluding missing LC types + if(debug0) write(*,*) "VEGO3 NUMS ", n, trim(OutputVegO3(n)%name) + end do + if(MasterProc) call WriteArray(VEGO3_OUTPUTS(:)%name,nOutputVegO3,& + " VEGO3 OUTPUTS:") + ! nVEGO3 is output, excluding missing LC types: + call Add_MosaicVEGO3(nOutVEGO3) !----- some "luxury outputs" ------------------------------------------- if( .not.SOURCE_RECEPTOR)then !------------- Deposition velocities --------------------- call Add_NewMosaics(NewMosaic, nMc) - if(debug0) then - write(*,*) "NEWMOSAIC NUM ", nMc - write(*,*) "VEGO3 FINAL NUM ", nVEGO3 - endif + if(debug0) write(*,*) 'NewMos Nums ', nOutputNewMos, nMC !------------- Met data for d_2d ------------------------- ! We find the various combinations of met and ecosystem, ! adding them to the derived-type array LCC_Met (e.g. => Met_CF) !FEB2011 Daiyl output asked for just now. Change larer - call Add_MosaicMetConcs(MOSAIC_METCONCS,MET_LCS,'YMD', nMET) + call Add_MosaicMetConcs(MOSAIC_METCONCS(1:nOutputMosMet),& + MET_LCS(1:nOutputMosLC),Mosaic_timefmt, nMET) nOutMET = nMET !not needed? - endif ! SOURCE_RECEPTOR + + if(debug0) then + write(*,*) "NEWMOSAIC NUM ", nMc + write(*,*) "VEGO3 FINAL NUM ", nVEGO3 + write(*,*) "nOutputMosMet FINAL NUM ", nOutputMosMet + write(*,*) "nOutputMosLC FINAL NUM ", nOutputMosLC + write(*,*) "nOutputNewMos FINAL NUM ", nOutputNewMos + write(*,*) "nOutMet FINAL NUM ", nOutMet + write(*,*) "nMosaic FINAL NUM ", nMosaic + end if + end if ! SOURCE_RECEPTOR !------------- end LCC data for d_2d ------------------------- call CheckStop( NMosaic >= MAX_MOSAIC_OUTPUTS, sub//"too many nMosaics" ) @@ -420,16 +441,17 @@ subroutine Init_My_Deriv() case default if(outdim=='3d')Is3D=.true. tag_name(1)= trim(outname) ! Just use raw name here - endselect + end select - ! OutputConcs can redefine output param of an output that is wanted by default + ! OutputConcs can redefine output param of an output that is wanted by + ! default if(Is3D)then if(find_index(tag_name(1),wanted_deriv3d)<1)& call AddArray(tag_name(1:1),wanted_deriv3d,NOT_SET_STRING,errmsg) else if(find_index(tag_name(1),wanted_deriv2d)<1)& call AddArray(tag_name(1:1),wanted_deriv2d,NOT_SET_STRING,errmsg) - endif + end if call CheckStop(errmsg,errmsg//trim(outname)//" too long") nOutputFields = nOutputFields + 1 OutputFields(nOutputFields) = OutputConcs(n) @@ -440,14 +462,14 @@ subroutine Init_My_Deriv() case(SHL ) ;n1=find_index(outname,species(:)%name) case(GROUP) ;n1=find_index(outname,chemgroups(:)%name) case default;n1=-1 - endselect + end select if(n1<1) then if( debug0 ) write(*,*) "Xd-2d-SKIP ", n, trim(outname) call PrintLog("WARNING: Requested My_Derived OutputField not found: "& //trim(outclass)//":"//trim(outname), MasterProc) cycle - endif + end if select case(outdim) case("2d","2D","SURF") @@ -458,6 +480,14 @@ subroutine Init_My_Deriv() nOutputFields = nOutputFields + 1 OutputFields(nOutputFields) = OutputConcs(n) + case("Local_Correct") + tag_name(1) = "SURF_LF_" // trim(outunit) // "_" // trim(outname) + call AddArray( tag_name(1:1) , wanted_deriv2d, & + NOT_SET_STRING, errmsg) + call CheckStop( errmsg, errmsg // trim(outname) // " too long" ) + nOutputFields = nOutputFields + 1 + OutputFields(nOutputFields) = OutputConcs(n) + case("3d","3D","MLEV") tag_name(1) = "D3_" // trim(outunit) // "_" // trim(outname) call AddArray( tag_name(1:1) , wanted_deriv3d, & @@ -471,20 +501,20 @@ subroutine Init_My_Deriv() call PrintLog("WARNING: Unsupported My_Derived OutputField%outdim: "& //trim(outclass)//":"//trim(outname)//":"//trim(outdim), MasterProc) cycle - endselect + end select else call CheckStop("My_Deriv: Unsupported OutputConcs" // & trim(outname)//":"//trim(outtyp)//":"//trim(outdim)) - endif + end if if(debug0)write(*,*)"OutputFields-tags ",n,trim(outname),"->",tag_name(1) - enddo + end do ! ditto wanted_deriv3d.... if (.not.SOURCE_RECEPTOR.and.size(D3_OTHER)>0) then call AddArray( D3_OTHER, wanted_deriv3d, NOT_SET_STRING, errmsg) call CheckStop( errmsg, errmsg // "Wanted D3 too long" ) - endif + end if ! TEST HERE mynum_deriv2d = LenArray( wanted_deriv2d, NOT_SET_STRING ) @@ -494,12 +524,13 @@ subroutine Init_My_Deriv() if(DEBUG%MY_DERIVED )then write(*,*) "Init_My_Deriv, mynum_deriv2d = ", mynum_deriv2d write(*,*) "Init_My_Deriv, mynum_deriv3d = ", mynum_deriv3d - write(*,*)("DEBUG MyDERIV2D ",i,mynum_deriv2d,wanted_deriv2d(i),i=1,mynum_deriv2d) - endif + write(*,*)("DEBUG MyDERIV2D ",i,mynum_deriv2d,wanted_deriv2d(i),& + i=1,mynum_deriv2d) + end if call WriteArray(wanted_deriv2d,mynum_deriv2d," Required 2D output ") call WriteArray(wanted_deriv3d,mynum_deriv3d," Required 3D output ") - endif -endsubroutine Init_My_Deriv + end if +end subroutine Init_My_Deriv !========================================================================= subroutine My_DerivFunc( e_2d, class )! , density ) @@ -528,8 +559,8 @@ subroutine My_DerivFunc( e_2d, class )! , density ) if ( MasterProc .and. num_warnings < 100 ) then write(*,*) "My_Deriv:WARNING - REQUEST FOR UNDEFINED OUTPUT:", n, class num_warnings = num_warnings + 1 - endif - endselect -endsubroutine My_DerivFunc + end if + end select +end subroutine My_DerivFunc !========================================================================= endmodule My_Derived_ml diff --git a/My_ESX_ml.f90 b/My_ESX_ml.f90 deleted file mode 100644 index d1b6026..0000000 --- a/My_ESX_ml.f90 +++ /dev/null @@ -1,45 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program is distributed in the hope that it will be useful, -!* but WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -!> Dummy implementation of ESX_ml for models that don't use ESX. -module ESX_ml - - implicit none - private - - public :: Init_ESX - public :: Run_ESX - -contains - - subroutine Init_ESX() - end subroutine Init_ESX - - subroutine Run_ESX() - end subroutine Run_ESX - -end module ESX_ml - diff --git a/My_Outputs_ml.f90 b/My_Outputs_ml.f90 index e030f43..a41dd75 100644 --- a/My_Outputs_ml.f90 +++ b/My_Outputs_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,18 +39,18 @@ module My_Outputs_ml use ChemGroups_ml, only: chemgroups use DerivedFields_ml, only: f_2d,f_3d ! D2D/D3D houtly output type use ModelConstants_ml, only: PPBINV, PPTINV, MasterProc, KMAX_MID,& - MY_OUTPUTS, FORECAST, DEBUG_COLSRC,& + MY_OUTPUTS, FORECAST, DEBUG,& USE_AOD, USE_POLLEN, DEBUG_POLLEN, & SELECT_LEVELS_HOURLY!, FREQ_HOURLY use PhysicalConstants_ml, only: ATWAIR use OwnDataTypes_ml, only: Asc2D use Par_ml, only: GIMAX,GJMAX,IRUNBEG,JRUNBEG,me -use Pollen_const_ml, only: ug2grains,pollen_check +use Pollen_const_ml, only: pollen_check use SmallUtils_ml, only: find_index use TimeDate_ml, only: date use Units_ml, only: Init_Units,& to_molec_cm3,to_molec_cm2,to_mgSIA,to_ugSIA,& - to_ug_ADV,to_ug_C,to_ug_N,to_ug_S + to_ug_ADV,to_ug_C,to_ug_N,to_ug_S,to_number_m3 implicit none @@ -92,9 +92,9 @@ module My_Outputs_ml !These variables must have been set in My_Derived for them to be used. character(len=24), public, parameter, dimension(NXTRA_SITE_D2D) :: & - SITE_XTRA_D2D=[character(len=24):: & + SITE_XTRA_D2D=[character(len=24):: & "HMIX","PSURF","ws_10m","rh2m",& - "Emis_mgm2_BioNatC5H8","Emis_mgm2_BioNatAPINENE",& + "Emis_mgm2_BioNatC5H8","Emis_mgm2_BioNatBIOTERP",& "Emis_mgm2_BioNatNO","Emis_mgm2_nox",& 'WDEP_PREC',&!'Idirect','Idiffuse','SNratio','SMI_deep',& 'met2d_uref','met2d_u10','met2d_rh2m', & @@ -238,40 +238,40 @@ subroutine set_output_defs "set_output_defs: Unknown group 'ASH'/'NUC'") if(ash>0)then name="none" - do i=1,size(chemgroups(ash)%ptr) - if(species(chemgroups(ash)%ptr(i))%name(1:9)==name)cycle - name=species(chemgroups(ash)%ptr(i))%name(1:9) - nhourly_out=nhourly_out+2+1 ! - nmax6_hourly=nmax6_hourly+1 ! - if(MasterProc.and.DEBUG_COLSRC)& + do i=1,size(chemgroups(ash)%specs) + if(species(chemgroups(ash)%specs(i))%name(1:9)==name)cycle + name=species(chemgroups(ash)%specs(i))%name(1:9) + nhourly_out=nhourly_out+2+1 ! + nmax6_hourly=nmax6_hourly+1 ! + if(MasterProc.and.DEBUG%COLSRC)& write(*,*)'EMERGENCY: Volcanic Ash, Vent=',name enddo endif if(nuc_conc>0)then name="none" - do i=1,size(chemgroups(nuc_conc)%ptr) - name=species(chemgroups(nuc_conc)%ptr(i))%name + do i=1,size(chemgroups(nuc_conc)%specs) + name=species(chemgroups(nuc_conc)%specs(i))%name nhourly_out=nhourly_out+1 - if(MasterProc.and.DEBUG_COLSRC)& + if(MasterProc.and.DEBUG%COLSRC)& write(*,*)'EMERGENCY: Nuclear accident/explosion, NPP/NUC=',name enddo endif if (.false.) then if(nuc_ddep>0)then name="none" - do i=1,size(chemgroups(nuc_ddep)%ptr) - name="DDEP_"//species(chemgroups(nuc_ddep)%ptr(i))%name + do i=1,size(chemgroups(nuc_ddep)%specs) + name="DDEP_"//species(chemgroups(nuc_ddep)%specs(i))%name nhourly_out=nhourly_out+1 - if(MasterProc.and.DEBUG_COLSRC)& + if(MasterProc.and.DEBUG%COLSRC)& write(*,*)'EMERGENCY: Nuclear accident/explosion, NPP/NUC=',name enddo endif if(nuc_wdep>0)then name="none" - do i=1,size(chemgroups(nuc_wdep)%ptr) - name="WDEP_"//species(chemgroups(nuc_wdep)%ptr(i))%name + do i=1,size(chemgroups(nuc_wdep)%specs) + name="WDEP_"//species(chemgroups(nuc_wdep)%specs(i))%name nhourly_out=nhourly_out+1 - if(MasterProc.and.DEBUG_COLSRC)& + if(MasterProc.and.DEBUG%COLSRC)& write(*,*)'EMERGENCY: Nuclear accident/explosion, NPP/NUC=',name enddo endif @@ -281,16 +281,18 @@ subroutine set_output_defs nlevels_hourly = 1 case("MACC_ENS","CAMS50_ENS","FORECAST") nhourly_out=0 - nlevels_hourly=9 + nlevels_hourly=0 !- moved to Hourly/Derived +!- nlevels_hourly=9 !- nhourly_out=nhourly_out+15 !- if(any(species_adv(:)%name=="RN222"))nhourly_out=nhourly_out+1 !- if(USE_AOD )nhourly_out=nhourly_out+1 if(USE_POLLEN )then -!- call pollen_check(gpoll) -!- nhourly_out=nhourly_out+size(chemgroups(gpoll)%ptr) + nlevels_hourly=1 + call pollen_check(gpoll) +!- nhourly_out=nhourly_out+size(chemgroups(gpoll)%specs) if(DEBUG_POLLEN)& - nhourly_out=nhourly_out+size(chemgroups(gpoll)%ptr)*2 + nhourly_out=nhourly_out+size(chemgroups(gpoll)%specs)*3-1 endif !- moved to Hourly/Derived !-case("MACC_EVA","CAMS50_EVA","CAMS50_IRA") @@ -306,7 +308,7 @@ subroutine set_output_defs case("3DPROFILES") nhourly_out=2 nlevels_hourly = 2 ! nb zero is one of levels in this system - SELECT_LEVELS_HOURLY = .true. + SELECT_LEVELS_HOURLY = .true. case("IMPACT2C") nhourly_out=4 ! Dave's starting set nlevels_hourly = 2 ! nb zero is one of levels, so we have 3m and 45m @@ -357,9 +359,9 @@ subroutine set_output_defs Asc2D("z" ,"Z_MID" ,00,NLEVELS_HOURLY,"km",1e-3,-9999.9)/) if(ash>0)then name="none" - do i=1,size(chemgroups(ash)%ptr) - if(species(chemgroups(ash)%ptr(i))%name(1:9)==name)cycle - name=species(chemgroups(ash)%ptr(i))%name(1:9) + do i=1,size(chemgroups(ash)%specs) + if(species(chemgroups(ash)%specs(i))%name(1:9)==name)cycle + name=species(chemgroups(ash)%specs(i))%name(1:9) igrp=find_index(name,chemgroups(:)%name) call CheckStop(igrp<1,"set_output_defs: Unknown group '"//name//"'") j=j+3;hr_out(j-2:j)=(/& @@ -373,21 +375,21 @@ subroutine set_output_defs endif if(nuc_conc>0)then name="none" - do i=1,size(chemgroups(nuc_conc)%ptr) - name=species(chemgroups(nuc_conc)%ptr(i))%name + do i=1,size(chemgroups(nuc_conc)%specs) + name=species(chemgroups(nuc_conc)%specs(i))%name !igrp=find_index(name,chemgroups(:)%name) ! position of NPP/NUC -group !call CheckStop(igrp<1,"set_output_defs: Unknown conc group '"//name//"'") j=j+1; - idx= chemgroups(nuc_conc)%ptr(i) - NSPEC_SHL ! offset between xn_adv and species + idx= chemgroups(nuc_conc)%specs(i) - NSPEC_SHL ! offset between xn_adv and species hr_out(j)= Asc2D(trim(name),"BCVugXX",idx,1,"uBq h/m3",& - PPBINV/ATWAIR*species(chemgroups(nuc_conc)%ptr(i))%molwt,-999.9) + PPBINV/ATWAIR*species(chemgroups(nuc_conc)%specs(i))%molwt,-999.9) enddo endif if (.false.) then if(nuc_wdep>0)then name="none" - do i=1,size(chemgroups(nuc_wdep)%ptr) - name=species(chemgroups(nuc_wdep)%ptr(i))%name + do i=1,size(chemgroups(nuc_wdep)%specs) + name=species(chemgroups(nuc_wdep)%specs(i))%name igrp=find_index(name,chemgroups(:)%name) ! position of NPP/NUC -group call CheckStop(igrp<1,"set_output_defs: Unknown wdep group '"//name//"'") j=j+1; @@ -402,8 +404,8 @@ subroutine set_output_defs endif if(nuc_ddep>0)then name="none" - do i=1,size(chemgroups(nuc_ddep)%ptr) - name=species(chemgroups(nuc_ddep)%ptr(i))%name + do i=1,size(chemgroups(nuc_ddep)%specs) + name=species(chemgroups(nuc_ddep)%specs(i))%name igrp=find_index(name,chemgroups(:)%name) ! position of NPP/NUC -group call CheckStop(igrp<1,"set_output_defs: Unknown ddep group '"//name//"'") j=j+1; @@ -427,11 +429,11 @@ subroutine set_output_defs 1,"ug/m2",1e0/3600.,-999.9) ! 1kg/s --> 1kg/h enddo case("MACC_ENS","CAMS50_ENS","FORECAST") - levels_hourly = [0,1,2,3,4,6,9,10,12] - pm25 =find_index("PMFINE" ,chemgroups(:)%name) !NB There is no "PM25" group - pm10 =find_index("PM10" ,chemgroups(:)%name) - nmvoc=find_index("NMVOC" ,chemgroups(:)%name) - rn222=find_index("RN222" ,species_adv(:)%name) +!- levels_hourly = [0,1,2,3,4,6,9,10,12] +!- pm25 =find_index("PMFINE" ,chemgroups(:)%name) !NB There is no "PM25" group +!- pm10 =find_index("PM10" ,chemgroups(:)%name) +!- nmvoc=find_index("NMVOC" ,chemgroups(:)%name) +!- rn222=find_index("RN222" ,species_adv(:)%name) !** name type ispec !** nk unit unit_conv max !- moved to Hourly/Derived @@ -484,19 +486,24 @@ subroutine set_output_defs !- 1," ",1.0 ,-999.9) !- endif if(USE_POLLEN)then + j=0 + levels_hourly = 0 !- moved to Hourly/Derived -!- do i=1,size(chemgroups(gpoll)%ptr) -!- idx=chemgroups(gpoll)%ptr(i)-NSPEC_SHL ! offset between xn_adv and species +!- do i=1,size(chemgroups(gpoll)%specs) +!- idx=chemgroups(gpoll)%specs(i)-NSPEC_SHL ! offset between xn_adv and species !- j=j+1;hr_out(j) = & !- Asc2D(trim(species_adv(idx)%name),"ADVugXX",idx, & -!- 1,"grains/m3",to_ug_ADV(idx)*ug2grains,-999.9) +!- 1,"grains/m3",to_number_m3,-999.9) !- enddo if(DEBUG_POLLEN)then - do i=1,size(chemgroups(gpoll)%ptr) - idx=chemgroups(gpoll)%ptr(i)-NSPEC_SHL ! offset between xn_adv and species + do i=1,size(chemgroups(gpoll)%specs) + idx=chemgroups(gpoll)%specs(i)-NSPEC_SHL ! offset between xn_adv and species + if(i<3)then + j=j+1;hr_out(j) = & + Asc2D(trim(species_adv(idx)%name)//"_heatsum","heatsum" ,i,& + 1,"degree day" ,1.0,-999.9) + endif j=j+2;hr_out(j-1:j) = (/& - ! Asc2D(trim(species_adv(idx)%name)//"_heatsum","heatsum" ,i,& - ! 1,"degree day" ,1.0,-999.9),& Asc2D(trim(species_adv(idx)%name)//"_emiss" ,"pollen_emiss",i,& 1,"grains/m2/h",1.0,-999.9),& Asc2D(trim(species_adv(idx)%name)//"_left" ,"pollen_left" ,i,& @@ -507,7 +514,7 @@ subroutine set_output_defs case("MACC_EVA","CAMS50_EVA","CAMS50_IRA") call CheckStop("set_output_defs: Use hourly Derived instead of "//trim(MY_OUTPUTS)) levels_hourly = [0] -!** name type ofmt ispec +!** name type ofmt ispec !** ix1 ix2 iy1 iy2 nk sellev? unit conv max hr_out(:) = (/& Asc2D("O3" ,"D2D_inst",find_index("SURF_ug_O3" ,f_2d(:)%name),& @@ -542,7 +549,7 @@ subroutine set_output_defs nlevels_hourly,"ppbv", PPBINV,600.0*2.0) & ,Asc2D("no_3dppb" ,"Out3D",& NO ,nlevels_hourly,"ppbv",PPBINV ,600.0*1.91) & - ,Asc2D("no2_3dppb" ,"Out3D",& + ,Asc2D("no2_3dppb" ,"Out3D",& NO2 ,nlevels_hourly,"ppbv",PPBINV ,600.0*1.91) & ,Asc2D("ho2_3dppt" ,"Out3D",& !NOTE ppt HO2 ,nlevels_hourly,"pptv",PPBINV ,600.0*1.91) & @@ -635,7 +642,7 @@ subroutine set_output_defs case("average_vs_instantaneous") ! Example of different hourly output types - hourly average and hourly instantaneous value ! variables of type "ADVppbv" will be outputted instantaneous and - ! variables of type "D2D_mean" will be hourly averages. + ! variables of type "D2D_mean" will be hourly averages. hr_out(:) = (/ & Asc2D("SURF_ppb_O3_inst","ADVppbv", IXADV_O3,1,"ppbv",PPBINV,600.0) ,& Asc2D("SURF_ppb_O3_mean","D2D_mean",find_index("SURF_ppb_O3",f_2d(:)%name), & diff --git a/My_Pollen_ml.f90 b/My_Pollen_ml.f90 index 23c47a1..7f72263 100644 --- a/My_Pollen_ml.f90 +++ b/My_Pollen_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -34,28 +34,20 @@ ! Pollen particles are assumed of 22 um diameter and 800 kg/m3 density. !-----------------------------------------------------------------------! module Pollen_const_ml -use PhysicalConstants_ml, only: PI use ModelConstants_ml, only: USE_POLLEN,DEBUG=>DEBUG_POLLEN -use ChemSpecs, only: species_adv +use ChemSpecs, only: NSPEC_ADV use CheckStop_ml, only: CheckStop implicit none public -real, parameter :: & - D_POLL = 22e-6, & ! Pollen grain diameter [m] - POLL_DENS= 800e3 ! Pollen density [g/m3] - -real, parameter :: & - grain_wt = POLL_DENS*PI*D_POLL**3/6.0, & ! 1 grain weight [g] - ug2grains= 1e-6/grain_wt ! # grains in 1 ug - real, parameter :: & N_TOT(3)=1.0 ! avoid div0 contains -subroutine pollen_check(igrp) +subroutine pollen_check(igrp,uconv_adv) integer, intent(out), optional :: igrp + real, dimension(NSPEC_ADV), intent(inout), optional :: uconv_adv logical,save :: first_call=.true. if(present(igrp))igrp=-1 if(.not.first_call)return diff --git a/Nest_ml.f90 b/Nest_ml.f90 index 3f0796b..a09db9e 100644 --- a/Nest_ml.f90 +++ b/Nest_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -73,14 +73,12 @@ module Nest_ml use ChemSpecs, only: NSPEC_ADV, NSPEC_SHL, species_adv use GridValues_ml, only: A_mid,B_mid, glon,glat, i_fdom,j_fdom, RestrictDomain use Io_ml, only: open_file,IO_TMP,IO_NML,PrintLog -use InterpolationRoutines_ml, only : grid2grid_coeff +use InterpolationRoutines_ml, only : grid2grid_coeff,point2grid_coeff use MetFields_ml, only: roa -use ModelConstants_ml, only: Pref,PT,KMAX_MID, MasterProc, & +use ModelConstants_ml, only: Pref,PT,KMAX_MID, MasterProc,NPROC, & IOU_INST, RUNDOMAIN, FORECAST,USE_POLLEN,& DEBUG_NEST,DEBUG_ICBC=>DEBUG_NEST_ICBC -use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER, MPI_LOGICAL, & - MPI_LOR,MPI_MIN, MPI_MAX, MPI_SUM, & - MPI_COMM_CALC, MPI_COMM_WORLD,IERROR +use MPI_Groups_ml use netcdf, only: nf90_open,nf90_close,nf90_inq_dimid,& nf90_inquire_dimension,nf90_inq_varid,& nf90_inquire_variable,nf90_get_var,nf90_get_att,& @@ -88,7 +86,7 @@ module Nest_ml use netcdf_ml, only: Out_netCDF,& CDFtype=>Real4,ReadTimeCDF,max_filename_length use OwnDataTypes_ml, only: Deriv,TXTLEN_SHORT -use Par_ml, only: me, li0,li1,lj0,lj1,limax,ljmax +use Par_ml, only: me,li0,li1,lj0,lj1,limax,ljmax,GIMAX,GJMAX,gi0,gj0,gi1,gj1 use Pollen_const_ml, only: pollen_check use TimeDate_ml, only: date,current_date,nmdays use TimeDate_ExtraUtil_ml, only: date2nctime,nctime2date,nctime2string,& @@ -105,7 +103,7 @@ module Nest_ml type(date), public :: outdate(FORECAST_NDUMP_MAX)=date(-1,-1,-1,-1,-1) !coordinates of subdomain to write, relative to FULL domain (only used in write mode) -integer, public :: out_DOMAIN(4) ! =[istart,iend,jstart,jend] +integer, public, save :: out_DOMAIN(4) ! =[istart,iend,jstart,jend] !/-- subroutines @@ -126,11 +124,11 @@ module Nest_ml integer, private, save :: NHOURSAVE,NHOURREAD ! write/read frequency !if(NHOURREADnull() ! Time dependent BC: spcname,varname,wanted,found,ixadv +logical, allocatable, save :: mask_restrict(:,:) +logical, save :: MASK_SET=.false. + contains !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine Config_Nest() @@ -182,6 +186,7 @@ subroutine Config_Nest() NAMELIST /Nest_config/ MODE_READ,MODE_SAVE,NHOURREAD,NHOURSAVE, & template_read_3D,template_read_BC,template_write,& native_grid_3D,native_grid_BC,omit_zero_write,out_DOMAIN,& + MET_inner,RUNDOMAIN_inner,& WRITE_SPC,WRITE_GRP,FORECAST_NDUMP,outdate if(.not.first_call)return @@ -192,46 +197,46 @@ subroutine Config_Nest() ! write/read frequency: Hours between consecutive saves(wrtxn)/reads(readxn) NHOURSAVE=3 ! Between wrtxn calls. Should be fraction of 24 NHOURREAD=1 ! Between readxn calls. Should be fraction of 24 -! Default domain for write modes +! Default domain for write modes if(.not.FORECAST)then out_DOMAIN=RUNDOMAIN+[1,-1,1,-1] else out_DOMAIN=RUNDOMAIN - endif + end if rewind(IO_NML) read(IO_NML,NML=Nest_config,iostat=ios) - call CheckStop(ios,"NML=Nest_config") + call CheckStop(ios,"NML=Nest_config") if(mydebug)then write(*,*) "NAMELIST IS " write(*,NML=Nest_config) - endif -! FORECAST overrides write/read modes + end if +! FORECAST overrides write/read modes if(FORECAST)then MODE_READ='FORECAST' elseif(MODE_READ=='')then MODE_READ='NONE' else MODE_READ=to_upper(MODE_READ) - endif + end if if(FORECAST)then MODE_SAVE='FORECAST' elseif(MODE_SAVE=='')then MODE_SAVE='NONE' else MODE_SAVE=to_upper(MODE_SAVE) - endif + end if ! write/read supported modes if(MasterProc)then call CheckStop(.not.any(MODE_READ==READ_MODES),& "Config_Nest: Unsupported MODE_READ='"//trim(MODE_READ)) call CheckStop(.not.any(MODE_SAVE==SAVE_MODES),& "Config_Nest: Unsupported MODE_SAVE='"//trim(MODE_SAVE)) - endif + end if ! write/read frequency should be fraction of 24 if(MasterProc)then call CheckStop(mod(24,NHOURSAVE),"Config_Nest: NHOURSAVE should be fraction of 24") call CheckStop(mod(24,NHOURREAD),"Config_Nest: NHOURREAD should be fraction of 24") - endif + end if ! Update filenames according to date following templates defined on Nest_config call init_icbc(cdate=current_date) ! Ensure sub-domain is not larger than run-domain @@ -243,9 +248,9 @@ subroutine Config_Nest() if(MasterProc)& write (*,"(1X,A,10(1X,A,:,','))")'Forecast nest/dump at:',& (date2string("YYYY-MM-DD hh:mm:ss",outdate(i)),i=1,FORECAST_NDUMP) - endif + end if first_call=.false. -endsubroutine Config_Nest +end subroutine Config_Nest !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine readxn(indate) type(date), intent(in) :: indate ! Gives year..seconds @@ -284,7 +289,7 @@ subroutine readxn(indate) case default !if(MasterProc) print *,'call to READXN',indate%hour,indate%seconds if(mod(indate%hour,NHOURREAD)/=0.or.indate%seconds/=0)return - endselect + end select ! never comes to this point if MODE=100, 11 or 12 if(DEBUG_NEST.and.MasterProc) write(*,*) 'Nest: kt', kt, first_call @@ -294,7 +299,7 @@ subroutine readxn(indate) filename_read_3D=date2string(template_read_3D,ndate,& mode='YMDH',debug=mydebug) filename_read_BC=date2file (template_read_BC,ndate,BC_DAYS,"days",& - mode='YMDH',debug=mydebug) + mode='YMDH',debug=mydebug) inquire(file=filename_read_3D,exist=fexist_3D) inquire(file=filename_read_BC,exist=fexist_BC) else @@ -304,7 +309,7 @@ subroutine readxn(indate) mode='YMDH',debug=mydebug) fexist_3D=.true. ! assume 3D file exists fexist_BC=.true. ! assume BC file exists - endif + end if if(first_call)then first_call=.false. @@ -313,7 +318,7 @@ subroutine readxn(indate) call reset_3D(ndays_indate) else if(MasterProc)write(*,*)'No Nest IC file found: ',trim(filename_read_3D) - endif + end if ! the first hour only these values are used, no real interpolation between two records if(fexist_BC)then @@ -321,19 +326,19 @@ subroutine readxn(indate) trim(filename_read_BC), ndays_indate call read_newdata_LATERAL(ndays_indate) if(mydebug) write(*,"(a,5i4)")'Nest: iw, ie, js, jn, kt ',iw,ie,js,jn,kt - endif - endif + end if + end if if(.not.fexist_BC)then if(MasterProc)write(*,*)'No Nest BC file found: ',trim(filename_read_BC) return - endif + end if if(ndays_indate-rtime_saved(2)>halfsecond.or.MODE_READ=='MONTH')then ! look for a new data set if(MasterProc) write(*,*)'Nest: READING NEW BC DATA from ',& trim(filename_read_BC) call read_newdata_LATERAL(ndays_indate) - endif + end if ! make weights for time interpolation if(MODE_READ=='MONTH')then ! don't interpolate for now @@ -345,12 +350,12 @@ subroutine readxn(indate) elseif(ndays_indate-rtime_saved(1)>halfsecond)then W2=(ndays_indate-rtime_saved(1))/(rtime_saved(2)-rtime_saved(1)) W1=1.0-W2 ! interpolate - endif - endif + end if + end if if(DEBUG_NEST.and.MasterProc) then write(*,*) 'Nesting BC 2D: time weights : ',W1,W2 write(*,*) 'Nesting BC 2D: time stamps : ',rtime_saved(1),rtime_saved(2) - endif + end if do bc=1,size(adv_bc) if(.not.(adv_bc(bc)%wanted.and.adv_bc(bc)%found))cycle @@ -367,21 +372,21 @@ subroutine readxn(indate) xn_adv(n,i,j,k)=W1*xn_adv_bndn(n,i,k,1)+W2*xn_adv_bndn(n,i,k,2) forall (k=kt:kt, i=1:limax, j=1:ljmax, k>=1) & xn_adv(n,i,j,k)=W1*xn_adv_bndt(n,i,j,1)+W2*xn_adv_bndt(n,i,j,2) - enddo + end do call CheckStop(EXTERNAL_BIC_NAME=="RCA",& "WORK NEEDED: RCA BICs commented out in Nest_ml - not consistent with all chem schemes") -endsubroutine readxn +end subroutine readxn !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine wrtxn(indate,WriteNow) type(date), intent(in) :: indate logical, intent(in) :: WriteNow !Do not check indate value - real,allocatable, dimension(:,:,:) :: data ! Data arrays + real :: data(LIMAX,LJMAX,KMAX_MID) ! Data array logical, parameter :: APPEND=.false. type(Deriv) :: def1 ! definition of fields - integer :: n,iotyp,ndim,kmax,i,ncfileID + integer :: n,i,j,k,iotyp,ndim,kmax,ncfileID real :: scale logical :: fexist, wanted, wanted_out, overwrite logical, save :: first_call=.true. @@ -397,8 +402,8 @@ subroutine wrtxn(indate,WriteNow) filename_write=date2string(template_write,indate,mode='YMDH',debug=mydebug) inquire(file=fileName_write,exist=overwrite) call CheckStop(overwrite.and.MODE_SAVE/='FORECAST',& - "Nest: Refuse to overwrite. Remove this file: "//trim(fileName_write)) - endif + "Nest: Refuse to overwrite. Remove this file: "//trim(fileName_write)) + end if select case(MODE_SAVE) case('END') @@ -411,7 +416,7 @@ subroutine wrtxn(indate,WriteNow) date2string(" Forecast nest/dump at YYYY-MM-DD hh:mm:ss",indate) case default if(mod(indate%hour,NHOURSAVE)/=0.or.indate%seconds/=0)return - endselect + end select iotyp=IOU_INST ndim=3 !3-dimensional @@ -424,18 +429,18 @@ subroutine wrtxn(indate,WriteNow) def1%iotype='' ! not used def1%name='' ! written def1%unit='mix_ratio' ! written - + ! Update filenames according to date following templates defined on Nest_config nml ! e.g. set template_write="EMEP_BC_MMYYYY.nc" on namelist for different names each month filename_write=date2string(template_write,indate,mode='YMDH',debug=mydebug) if(MasterProc)then - inquire(file=fileName_write,exist=fexist) + inquire(file=fileName_write,exist=fexist) write(*,*)'Nest:write data ',trim(fileName_write) - endif + end if CALL MPI_BCAST(fexist,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) overwrite=fexist.and.first_call.and..not.APPEND -! Limit output, e.g. for NMC statistics (3DVar) +! Limit output, e.g. for NMC statistics (3DVar and restriction to inner grid BC) if(first_call)then first_call=.false. call init_icbc(cdate=indate) @@ -445,15 +450,15 @@ subroutine wrtxn(indate,WriteNow) if(WRITE_GRP(n)=="")cycle i=find_index(WRITE_GRP(n),chemgroups(:)%name) if(i>0)then - where(chemgroups(i)%ptr>NSPEC_SHL) & - adv_ic(chemgroups(i)%ptr-NSPEC_SHL)%wanted=.true. + where(chemgroups(i)%specs>NSPEC_SHL) & + adv_ic(chemgroups(i)%specs-NSPEC_SHL)%wanted=.true. elseif(MasterProc)then write(*,"(A,':',/2(2X,A,1X,'''',A,'''',1X,A,'.'))")& "Warning (wrtxn)", & "Wanted group",trim(WRITE_GRP(n)),"was not found", & "Can not be written to file:",trim(filename_write),"" - endif - enddo + end if + end do do n=1,size(WRITE_SPC) if(WRITE_SPC(n)=="")cycle i=find_index(WRITE_SPC(n),species_adv(:)%name) @@ -464,21 +469,21 @@ subroutine wrtxn(indate,WriteNow) "Warning (wrtxn)", & "Wanted specie",trim(WRITE_SPC(n)),"was not found", & "Can not be written to file:",trim(filename_write),"" - endif - enddo + end if + end do elseif(FORECAST.and.USE_POLLEN)then ! POLLEN group members are written to pollen restart/dump file call pollen_check(igrp=i) if(i>0)then - where(chemgroups(i)%ptr>NSPEC_SHL) & - adv_ic(chemgroups(i)%ptr-NSPEC_SHL)%wanted=.false. + where(chemgroups(i)%specs>NSPEC_SHL) & + adv_ic(chemgroups(i)%specs-NSPEC_SHL)%wanted=.false. if((DEBUG_NEST.or.DEBUG_ICBC).and.MasterProc)& write(*,"(A,':',/2(2X,A,1X,'''',A,'''',1X,A,'.'))")& "Warning (wrtxn)", & "Group","POLLEN","is written to pollen restart/dump file", & "Will not be written to file:",trim(filename_write),"" - endif - endif + end if + end if do n=1,NSPEC_ADV if(.not.adv_ic(n)%wanted)then if((DEBUG_NEST.or.DEBUG_ICBC).and.MasterProc)& @@ -497,11 +502,17 @@ subroutine wrtxn(indate,WriteNow) "Nest(wrtxn) DEBUG_ICBC",& "Variable",trim(species_adv(n)%name),"was found constant=0.0",& "Will not be written to file:",trim(filename_write),"" - endif - enddo - endif + end if + end do + + if(MET_inner /= "NOTSET")then + ! find region that is really needed, i.e. boundaries of inner grid + !find lon and lat of inner grid restricted to BC + call init_mask_restrict(MET_inner,RUNDOMAIN_inner) + endif + + end if - allocate(data(LIMAX,LJMAX,KMAX_MID)) !do first one loop to define the fields, without writing them (for performance purposes) ncfileID=-1 ! must be <0 as initial value if(.not.fexist.or.overwrite)then @@ -513,20 +524,34 @@ subroutine wrtxn(indate,WriteNow) out_DOMAIN=out_DOMAIN,create_var_only=.true.,overwrite=overwrite,& fileName_given=trim(fileName_write),ncFileID_given=ncFileID) overwrite=.false. - enddo - endif + end do + end if do n=1,NSPEC_ADV if(.not.adv_ic(n)%wanted)cycle def1%name=species_adv(n)%name ! written - data=xn_adv(n,:,:,:) + if(MASK_SET)then + do k=1,KMAX_MID + do j=1,LJMAX + do i=1,LIMAX + if(mask_restrict(i,j))then + data(i,j,k)=xn_adv(n,i,j,k) + else + data(i,j,k)=0.0 + endif + end do + end do + end do + else + data=xn_adv(n,:,:,:) + endif call Out_netCDF(iotyp,def1,ndim,kmax,data,scale,CDFtype=CDFtype,& - out_DOMAIN=out_DOMAIN,create_var_only=.false.,& - fileName_given=trim(fileName_write),ncFileID_given=ncFileID) - enddo + out_DOMAIN=out_DOMAIN,create_var_only=.false.,& + fileName_given=trim(fileName_write),ncFileID_given=ncFileID) + end do if(MasterProc)call check(nf90_close(ncFileID)) - deallocate(data) -endsubroutine wrtxn + +end subroutine wrtxn !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine init_icbc(idate,cdate,ndays,nsecs) @@ -555,7 +580,7 @@ subroutine init_icbc(idate,cdate,ndays,nsecs) present(nsecs)]),1,"init_icbc: wrong date option") ! Update filenames according to date following templates defined on Nest_config nml - if(present(idate)) dat=idate + if(present(idate)) dat=idate if(present(cdate)) dat=[cdate%year,cdate%month,cdate%day,cdate%hour] if(present(ndays)) call nctime2date(dat,ndays) if(present(nsecs)) call nctime2date(dat,nsecs) @@ -566,7 +591,7 @@ subroutine init_icbc(idate,cdate,ndays,nsecs) filename_read_3D=date2string(template_read_3D,dat,& mode='YMDH',debug=mydebug) filename_read_BC=date2file (template_read_BC,dat,BC_DAYS,"days",& - mode='YMDH',debug=mydebug) + mode='YMDH',debug=mydebug) filename_write =date2string(template_write ,dat,& mode='YMDH',debug=mydebug) @@ -581,32 +606,32 @@ subroutine init_icbc(idate,cdate,ndays,nsecs) adv_bc(:)%found=find_icbc(filename_read_bc,adv_bc%varname(:)) else adv_bc=>adv_ic - endif - + end if + if(MasterProc)then do n = 1,size(adv_ic%varname) if(.not.adv_ic(n)%found)then call PrintLog("WARNING: IC variable '"//trim(adv_ic(n)%varname)//"' not found") - elseif(DEBUG_NEST.or.DEBUG_ICBC)then + elseif(DEBUG_NEST.or.DEBUG_ICBC)then write(*,*) "init_icbc filled adv_ic "//trim(adv_ic(n)%varname) - endif - enddo + end if + end do do n = 1,size(adv_bc%varname) if(.not.adv_bc(n)%found)then call PrintLog("WARNING: BC variable '"//trim(adv_bc(n)%varname)//"' not found") - elseif(DEBUG_NEST.or.DEBUG_ICBC)then + elseif(DEBUG_NEST.or.DEBUG_ICBC)then write(*,*) "init_icbc filled adv_bc "//trim(adv_bc(n)%varname) - endif - enddo - endif - + end if + end do + end if + if((DEBUG_NEST.or.DEBUG_ICBC).and.MasterProc)then write(*,"(a)") "Nest: DEBUG_ICBC Variables:",& trim(filename_read_3D),trim(filename_read_BC) write(*,"((1X,A,I3,'->',"//ICBC_FMT//"))") & ('Nest: ADV_IC',n,adv_ic(n),n=1,size(adv_ic)),& ('Nest: ADV_BC',n,adv_bc(n),n=1,size(adv_bc)) - endif + end if contains function find_icbc(filename_read,varname) result(found) !----------------------------------------------------------------------------! @@ -629,13 +654,13 @@ function find_icbc(filename_read,varname) result(found) if(varname(n)=="") cycle status=nf90_inq_varid(ncFileID,trim(varname(n)),varID) found(n)=(status==nf90_noerr) - enddo + end do call check(nf90_close(ncFileID)) - endif - endif + end if + end if CALL MPI_BCAST(found,size(found),MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) -endfunction find_icbc -endsubroutine init_icbc +end function find_icbc +end subroutine init_icbc !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& @@ -667,7 +692,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& return else print *,'init_Nest: reading ',trim(filename_read) - endif + end if projection='Unknown' status = nf90_get_att(ncFileID,nf90_global,"projection",projection) @@ -678,7 +703,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& projection='lon lat' write(*,*)'Nest: projection not found for ',& trim(filename_read)//', assuming '//trim(projection) - endif + end if !get dimensions id/name/len: include more dimension names, if necessary GIMAX_ext=get_dimLen([character(len=12)::"i","lon","longitude"],name=iDName) GJMAX_ext=get_dimLen([character(len=12)::"j","lat","latitude" ],name=jDName) @@ -702,7 +727,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& trim(iDName)//" as i-dimension on "//trim(projection)//" projection") call CheckStop("j",jDName,"Nest: unsuported "//& trim(jDName)//" as j-dimension on "//trim(projection)//" projection") - endselect + end select N_ext=0 status = nf90_inq_dimid(ncFileID,"time",timeDimID) @@ -713,12 +738,12 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& status = nf90_inq_dimid(ncFileID,"Months",dimID=timeDimID) if(status==nf90_noerr)then call check(nf90_inquire_dimension(ncFileID,timedimID,len=N_ext)) - call CheckStop(N_ext,12,'Nest BC: did not find 12 monthes') + call CheckStop(N_ext,12,'Nest BC: did not find 12 months') else write(*,*)'Nest: time dimension not found. Assuming only one record ' N_ext=1 - endif - endif + end if + end if write(*,*)'Nest: dimensions external grid',GIMAX_ext,GJMAX_ext,KMAX_ext,N_ext if(.not.allocated(ndays_ext))then @@ -727,9 +752,9 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& if(Masterproc)write(*,*)'Nest: Sizes times ',N_ext deallocate(ndays_ext) allocate(ndays_ext(N_ext)) - endif + end if - endif + end if CALL MPI_BCAST(GIMAX_ext,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(GJMAX_ext,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(KMAX_ext ,4*1,MPI_BYTE,0,MPI_COMM_CALC,IERROR) @@ -759,33 +784,33 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& call check(nf90_inq_varid(ncFileID,"lat",varID),"dim:lat") call check(nf90_get_var(ncFileID,varID,lat_ext),"get:lat") - endif + end if if(time_exists)then call ReadTimeCDF(filename_read,ndays_ext,N_ext) else !cannot read time on file. assumes it is correct ndays_ext(1)=ndays_indate - endif + end if if(MODE_READ=='MONTH')then !asuming 12 monthes for BC, and 12 or 1 values for IC ndays_ext(1)=0 do n=2,N_ext ndays_ext(n)=ndays_ext(n-1)+nmdays(n-1) - enddo + end do elseif(ndays_ext(1)-ndays_indate>halfsecond)then write(*,*)'WARNING: Nest did not find BIC for date ',& nctime2string('YYYY-MM-DD hh:mm:ss',ndays_indate) write(*,*)'Nest first date found ',& nctime2string('YYYY-MM-DD hh:mm:ss',ndays_ext(1)) - endif + end if if(N_ext>1)then NHOURS_Stride_BC = nint((ndays_ext(2)-ndays_ext(1))*24) else !use manually set stride: NHOURS_Stride_BC = NHOURS_Stride_BC_default - endif + end if write(*,*)'Nest: new BC record every ',NHOURS_Stride_BC,' hours' ! Read pressure for vertical levels @@ -801,7 +826,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& k_ext=1+k-KMAX_ext ! for 1+k-KMAX_ext .. k levels else k_ext=1 ! for 1 .. KMAX_ext levels - endif + end if if(k/=KMAX_ext)& write(*,"(A,4(1X,A,I0))")'Nest BC warning:',& 'kdim #lev=',KMAX_ext,'and hyam/hybm #lev=',k,& @@ -812,8 +837,8 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& if(word(1:3)=='hPa')then write(*,*)'Changing hyam from hPa to Pa' hyam=100*hyam - endif - endif + end if + end if call check(nf90_inq_varid(ncFileID,"hybm",varID)) call check(nf90_get_var(ncFileID,varID,hybm,start=(/k_ext/),count=(/KMAX_ext/))) else @@ -829,7 +854,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& k_ext=1+(k-1)-KMAX_ext ! for 1+k-KMAX_ext .. k levels else k_ext=1 ! for 1 .. KMAX_ext levels - endif + end if if(k/=KMAX_ext+1.and.MasterProc)& write(*,"(A,4(1X,A,I0))")'Nest BC warning:',& 'kdim #lev=',KMAX_ext,'and hyam/hybm #lev=',k,& @@ -840,14 +865,14 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& if(word(1:3)=='hPa')then write(*,*)'Changing hyai from hPa to Pa' hyam=100*hyam - endif - endif + end if + end if call check(nf90_inq_varid(ncFileID,"hybi",varID)) call check(nf90_get_var(ncFileID,varID,hybm,start=(/k_ext/),count=(/KMAX_ext+1/))) do k=1,KMAX_ext hyam(k)=0.5*(hyam(k)+hyam(k+1)) hybm(k)=0.5*(hybm(k)+hybm(k+1)) - enddo + end do else inquire(file=filename_eta,exist=fexist) @@ -857,7 +882,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& call check(nf90_get_var(ncFileID, varID, hybm,count=(/ KMAX_ext /) ))!NB: here assume = sigma do k=1,KMAX_ext hyam(k)=PT*(1.0-hybm(k)) - enddo + end do elseif(fexist) then !read eta levels from ad-hoc text file write(*,*)'Nest: Reading vertical level from ',trim(filename_eta) @@ -865,7 +890,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& do n=1,10000 read(IO_TMP,*)word if(trim(word)=='vct')exit - enddo + end do read(IO_TMP,*)(hyam(k),k=1,KMAX_ext+1)!NB: here = A_bnd, not mid read(IO_TMP,*)(hybm(k),k=1,KMAX_ext+1)!NB: here = B_bnd, not mid close(IO_TMP) @@ -873,7 +898,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& do k=1,KMAX_ext hyam(k)=0.5*(hyam(k)+hyam(k+1)) hybm(k)=0.5*(hybm(k)+hybm(k+1)) - enddo + end do else status = nf90_inq_varid(ncFileID,"lev",varID) if(status == nf90_noerr) then @@ -884,13 +909,13 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& hybm=0.0 else call CheckStop('Vertical coordinate Unknown/Not yet implemented') - endif - endif - endif - endif + end if + end if + end if + end if call check(nf90_close(ncFileID)) - endif !end MasterProc + end if !end MasterProc CALL MPI_BCAST(lon_ext,8*GIMAX_ext*GJMAX_ext,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(lat_ext,8*GIMAX_ext*GJMAX_ext,MPI_BYTE,0,MPI_COMM_CALC,IERROR) @@ -901,14 +926,17 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& ! note that i,j are local and but IIij,JJij refer to the full nest-file if(native_grid)then ! nest-file is on the model/run grid forall(i=1:limax,j=1:ljmax) - IIij(:,i,j)=i_fdom(i) - JJij(:,i,j)=j_fdom(j) + IIij(:,i,j)=i_fdom(i)-RUNDOMAIN(1)+1 + JJij(:,i,j)=j_fdom(j)-RUNDOMAIN(3)+1 Weight(:,i,j)=[1.0,0.0,0.0,0.0] endforall + i=IIij(1,limax,ljmax);j=JJij(1,limax,ljmax) + call CheckStop((i>GIMAX_ext).or.(j>GJMAX_ext),& + 'Nest: domain mismatch for native_grid') else ! find the four closest points call grid2grid_coeff(glon,glat,IIij,JJij,Weight,lon_ext,lat_ext,& GIMAX_ext,GJMAX_ext,LIMAX,LJMAX,limax,ljmax,mydebug,1,1) - endif + end if deallocate(lon_ext,lat_ext) !find vertical interpolation coefficients @@ -919,7 +947,7 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& do k_ext=1,KMAX_EXT P_ext(k_ext)=hyam(k_ext)+hybm(k_ext)*Pref if(mydebug) write(*,fmt="(A,I3,F10.2)")'Nest: P_ext',k_ext,P_ext(k_ext) - enddo + end do reversed_k_BC=(P_ext(1)>P_ext(2)) ! .true. --> assumes k_ext=KMAX_EXT is top and k_ext=1 is surface ! .false. --> assumes k_ext=1 is top and k_ext=KMAX_EXT is surface @@ -933,21 +961,21 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& do k_ext=1,KMAX_EXT if(P_ext(k_ext)P_emep)exit if(k_ext/=k1_ext(k))k2_ext(k)=k_ext - enddo + end do weight_k1(k)=(P_emep-P_ext(k2_ext(k)))/(P_ext(k1_ext(k))-P_ext(k2_ext(k))) weight_k2(k)=1.0-weight_k1(k) if(mydebug)& write(*,fmt="(A,I3,2(A,I2,A,F5.2))")'Nest: level',k,& ' is the sum of level ',k1_ext(k),' weight ',weight_k1(k),& ' and level ',k2_ext(k),' weight ',weight_k2(k) - enddo + end do else do k=1,KMAX_MID @@ -958,22 +986,22 @@ subroutine init_nest(ndays_indate,filename_read,native_grid,IIij,JJij,Weight,& do k_ext=KMAX_EXT,1,-1 if(P_ext(k_ext)P_emep)exit if(k_ext/=k1_ext(k))k2_ext(k)=k_ext - enddo + end do weight_k1(k)=(P_emep-P_ext(k2_ext(k)))/(P_ext(k1_ext(k))-P_ext(k2_ext(k))) weight_k2(k)=1.0-weight_k1(k) if(mydebug) & write(*,fmt="(A,I3,2(A,I2,A,F5.2))")'Nest: level',k,& ' is the sum of level ', k1_ext(k),' weight ',weight_k1(k),& ' and level ', k2_ext(k),' weight ',weight_k2(k) - enddo - endif + end do + end if deallocate(P_ext,hyam,hybm) if(mydebug) & @@ -993,13 +1021,244 @@ function get_dimLen(dimName,id,name) result(len) call check(nf90_inquire_dimension(ncFileID,dID,len=len),& "get_dimLen: "//trim(dimName(d))) exit - endif - enddo + end if + end do call CheckStop(status,nf90_noerr,'Nest: '//& trim(dimName(1))//'-dimension not found: '//& trim(filename_read)//'. Include new name in init_nest') -endfunction get_dimLen -endsubroutine init_nest +end function get_dimLen +end subroutine init_nest + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! +subroutine init_mask_restrict(filename_read,rundomain_ext) + + !find lon and lat of boundaries of grid and build mask_restrict + integer,intent(in) ::rundomain_ext(4) + character(len=*),intent(in) :: filename_read + integer ::GIMAX_ext,GJMAX_ext + integer :: ncFileID,varid,status + integer :: i,j,n + real, allocatable, dimension(:,:) ::lon_ext,lat_ext + real, allocatable, dimension(:) :: temp_ll + character(len=80) ::projection,iDName,jDName + real, allocatable, dimension(:,:) ::Weight_rstrct,glon_rundom,glat_rundom + integer, allocatable, dimension(:,:) ::IIij_rstrct,JJij_rstrct + real, allocatable, dimension(:) ::lon_rstrct,lat_rstrct + integer :: N_rstrct_BC,n4,N_rstrct_BC_per_proc + + allocate(mask_restrict(limax,ljmax)) + + !Read dimensions (global) + if(me==0)then + status = nf90_open(trim(filename_read),nf90_nowrite,ncFileID) + if(status/=nf90_noerr) then + print *,'init_mask_restrict: not found',trim(filename_read) + else + MASK_SET = .true. + print *,'init_mask_restrict: reading ',trim(filename_read) + + projection='Unknown' + status = nf90_get_att(ncFileID,nf90_global,"projection",projection) + if(status==nf90_noerr) then + if(projection=='lon_lat')projection='lon lat' + write(*,*)'Nest: projection: '//trim(projection) + else + projection='lon lat' + write(*,*)'Nest: projection not found for ',& + trim(filename_read)//', assuming '//trim(projection) + end if + !get dimensions id/name/len: include more dimension names, if necessary + GIMAX_ext=get_dimLen([character(len=12)::"i","lon","longitude"],name=iDName) + GJMAX_ext=get_dimLen([character(len=12)::"j","lat","latitude" ],name=jDName) + + select case(projection) + case('Stereographic') + call CheckStop("i",iDName,"Nest: unsuported "//& + trim(iDName)//" as i-dimension on "//trim(projection)//" projection") + call CheckStop("j",jDName,"Nest: unsuported "//& + trim(jDName)//" as j-dimension on "//trim(projection)//" projection") + case('lon lat') + call CheckStop("lon",iDName(1:3),"Nest: unsuported "//& + trim(iDName)//" as i-dimension on "//trim(projection)//" projection") + call CheckStop("lat",jDName(1:3),"Nest: unsuported "//& + trim(jDName)//" as j-dimension on "//trim(projection)//" projection") + case default + !call CheckStop("Nest: unsuported projection "//trim(projection)) + !write(*,*)'GENERAL PROJECTION ',trim(projection) + call CheckStop("i",iDName,"Nest: unsuported "//& + trim(iDName)//" as i-dimension on "//trim(projection)//" projection") + call CheckStop("j",jDName,"Nest: unsuported "//& + trim(jDName)//" as j-dimension on "//trim(projection)//" projection") + end select + + write(*,*)'Nest: dimensions inner grid',GIMAX_ext,GJMAX_ext + + end if + end if + + CALL MPI_BCAST(MASK_SET,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) + if (.not.MASK_SET)then + deallocate(mask_restrict) + return + endif + + if(me==0)then + allocate(lon_ext(GIMAX_ext,GJMAX_ext),lat_ext(GIMAX_ext,GJMAX_ext)) + !Read lon lat of the external grid (global) + if(trim(projection)==trim('lon lat')) then + call check(nf90_inq_varid(ncFileID,iDName,varID),& + "Read lon-variable: "//trim(iDName)) + allocate(temp_ll(GIMAX_ext)) + call check(nf90_get_var(ncFileID,varID,temp_ll)) + lon_ext=SPREAD(temp_ll,2,GJMAX_ext) + deallocate(temp_ll) + call check(nf90_inq_varid(ncFileID,jDName,varID),& + "Read lat-variable: "//trim(jDName)) + allocate(temp_ll(GJMAX_ext)) + call check(nf90_get_var(ncFileID,varID,temp_ll)) + lat_ext=SPREAD(temp_ll,1,GIMAX_ext) + deallocate(temp_ll) + else + call check(nf90_inq_varid(ncFileID,"lon",varID),"dim:lon") + call check(nf90_get_var(ncFileID,varID,lon_ext),"get:lon") + + call check(nf90_inq_varid(ncFileID,"lat",varID),"dim:lat") + call check(nf90_get_var(ncFileID,varID,lat_ext),"get:lat") + end if + + call check(nf90_close(ncFileID)) + + !N_rstrct_BC = number of points on boundaries in the inner grid + N_rstrct_BC=2*(rundomain_ext(2)-rundomain_ext(1)+1)+2*(rundomain_ext(4)-rundomain_ext(3)-1) + allocate(lon_rstrct(N_rstrct_BC)) + allocate(lat_rstrct(N_rstrct_BC)) + + !take out only boundary cells + N_rstrct_BC=0 + j=rundomain_ext(3) + do i=rundomain_ext(1),rundomain_ext(2) + N_rstrct_BC = N_rstrct_BC + 1 + lon_rstrct(N_rstrct_BC)=lon_ext(i,j) + lat_rstrct(N_rstrct_BC)=lat_ext(i,j) + enddo + j=rundomain_ext(4) + do i=rundomain_ext(1),rundomain_ext(2) + N_rstrct_BC = N_rstrct_BC + 1 + lon_rstrct(N_rstrct_BC)=lon_ext(i,j) + lat_rstrct(N_rstrct_BC)=lat_ext(i,j) + enddo + i=rundomain_ext(1) + do j=rundomain_ext(3)+1,rundomain_ext(4)-1 + N_rstrct_BC = N_rstrct_BC + 1 + lon_rstrct(N_rstrct_BC)=lon_ext(i,j) + lat_rstrct(N_rstrct_BC)=lat_ext(i,j) + enddo + i=rundomain_ext(2) + do j=rundomain_ext(3)+1,rundomain_ext(4)-1 + N_rstrct_BC = N_rstrct_BC + 1 + lon_rstrct(N_rstrct_BC)=lon_ext(i,j) + lat_rstrct(N_rstrct_BC)=lat_ext(i,j) + enddo + if(N_rstrct_BC/=2*(rundomain_ext(2)-rundomain_ext(1)+1)+2*(rundomain_ext(4)-rundomain_ext(3)-1))then + write(*,*)'accounting error' + stop + endif + deallocate(lon_ext,lat_ext) + else + N_rstrct_BC=2*(rundomain_ext(2)-rundomain_ext(1)+1)+2*(rundomain_ext(4)-rundomain_ext(3)-1) + allocate(lon_rstrct(N_rstrct_BC)) + allocate(lat_rstrct(N_rstrct_BC)) + endif + + CALL MPI_BCAST(lon_rstrct,N_rstrct_BC*8,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(lat_rstrct,N_rstrct_BC*8,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + + + allocate(IIij_rstrct(4,N_rstrct_BC)) + allocate(JJij_rstrct(4,N_rstrct_BC)) + allocate(Weight_rstrct(4,N_rstrct_BC)) + + !find nearest neighbors of model grid for each lon_rstrct_BC lat_rstrct_BC + allocate(glon_rundom(RUNDOMAIN(1):RUNDOMAIN(2),RUNDOMAIN(3):RUNDOMAIN(4))) + allocate(glat_rundom(RUNDOMAIN(1):RUNDOMAIN(2),RUNDOMAIN(3):RUNDOMAIN(4))) + glon_rundom=0.0 + glat_rundom=0.0 + do j=1,ljmax + do i=1,limax + glon_rundom(gi0+i-1,gj0+j-1)=glon(i,j) + glat_rundom(gi0+i-1,gj0+j-1)=glat(i,j) + enddo + enddo + CALL MPI_ALLREDUCE(MPI_IN_PLACE, glon_rundom, GIMAX*GJMAX, & + MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, glat_rundom, GIMAX*GJMAX, & + MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) + + + !divide the work among processors + N_rstrct_BC_per_proc=(N_rstrct_BC+NPROC-1)/NPROC + + ! find the four closest points +! call grid2grid_coeff( & +! lon_rstrct,lat_rstrct, & +! IIij_rstrct,JJij_rstrct,Weight_rstrct, & ! Returns coordinates of 4 nearest pts and weights +! glon_rundom,glat_rundom,GIMAX,GJMAX,N_rstrct_BC,1,N_rstrct_BC,1,& +! .false., 1, 1) !1,1 is just a crude coord, while checking + IIij_rstrct=0 + JJij_rstrct=0 + Weight_rstrct=0.0 + do n=me*N_rstrct_BC_per_proc+1,min((me+1)*N_rstrct_BC_per_proc,N_rstrct_BC) + call point2grid_coeff(lon_rstrct(n),lat_rstrct(n),& + IIij_rstrct(1,n),JJij_rstrct(1,n),Weight_rstrct(1,n),& + glon_rundom,glat_rundom,GIMAX,GJMAX,.false.) + enddo + deallocate(glon_rundom,glat_rundom,lon_rstrct,lat_rstrct) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, IIij_rstrct, 4*N_rstrct_BC, & + MPI_INTEGER, MPI_SUM, MPI_COMM_CALC, IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, JJij_rstrct, 4*N_rstrct_BC, & + MPI_INTEGER, MPI_SUM, MPI_COMM_CALC, IERROR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, Weight_rstrct, 4*N_rstrct_BC, & + MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_CALC, IERROR) + + mask_restrict = .false. !default: do not include + do n=1, N_rstrct_BC + do n4=1, 4 + i=IIij_rstrct(n4,n) + j=JJij_rstrct(n4,n) + if(i>=gi0 .and. i<=gi1 .and. j>=gj0 .and. j<=gj1)then + if(abs(Weight_rstrct(n4,n))> 1.0E-6)then !contribute little, probably noise + mask_restrict(i-gi0+1,j-gj0+1)= .true. + endif + endif + enddo + enddo + deallocate(IIij_rstrct,JJij_rstrct,Weight_rstrct) + + + if(mydebug) & + write(*,*)'Nest: finished determination of interpolation parameters' +contains + function get_dimLen(dimName,id,name) result(len) + character(len=*), dimension(:), intent(in) :: dimName + integer, optional, intent(out):: id + character(len=*), optional, intent(out):: name + integer :: d, dID, len + + do d=1,size(dimName) + status = nf90_inq_dimid(ncFileID,dimName(d),dID) + if(status==nf90_noerr)then + if(present(id)) id=dID + if(present(name))name=trim(dimName(d)) + call check(nf90_inquire_dimension(ncFileID,dID,len=len),& + "get_dimLen: "//trim(dimName(d))) + exit + end if + end do + call CheckStop(status,nf90_noerr,'Nest: '//& + trim(dimName(1))//'-dimension not found: '//& + trim(filename_read)//'. Include new name in init_nest_restrict') + end function get_dimLen +end subroutine init_mask_restrict !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine read_newdata_LATERAL(ndays_indate) @@ -1044,11 +1303,11 @@ subroutine read_newdata_LATERAL(ndays_indate) IIij,JJij,Weight,k1_ext,k2_ext,weight_k1,weight_k2,& N_ext_BC,KMAX_ext_BC,GIMAX_ext,GJMAX_ext) if(MODE_READ=='MONTH'.and.N_ext_BC/=12.and.MasterProc)then - write(*,*)'Nest: WARNING: Expected 12 monthes in BC file, found ',N_ext_BC - call CheckStop('Nest BC: wrong number of monthes') - endif + write(*,*)'Nest: WARNING: Expected 12 months in BC file, found ',N_ext_BC + call CheckStop('Nest BC: wrong number of months') + end if - ! Define & allocate West/East/South/Nort Boundaries + ! Define & allocate West/East/South/North Boundaries iw=li0-1;ie=li1+1 ! i West/East boundaries js=lj0-1;jn=lj1+1 ! j South/North boundaries kt=0;if(TOP_BC)kt=1 ! k Top boundary @@ -1057,8 +1316,8 @@ subroutine read_newdata_LATERAL(ndays_indate) write(*,*)'Nest-kt test: Also including the top layer in BC' else write(*,*)'Nest-kt test: Not resetting the top layer' - endif - endif + end if + end if if(iw>=1 .and..not.allocated(xn_adv_bndw)) & allocate(xn_adv_bndw(NSPEC_ADV,LJMAX,KMAX_MID,2)) ! West @@ -1079,11 +1338,11 @@ subroutine read_newdata_LATERAL(ndays_indate) 'T:k',kt,allocated(xn_adv_bndt) if(MasterProc)flush(6) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) - endif + end if rtime_saved(2)=-99.0!just to put a value if(mydebug)write(*,*)'Nest: end initializations 2D' - endif + end if rtime_saved(1)=rtime_saved(2) ! put old values in 1 allocate(data(GIMAX_ext,GJMAX_ext,KMAX_ext_BC), stat=status) @@ -1100,14 +1359,14 @@ subroutine read_newdata_LATERAL(ndays_indate) call CheckStop(N_ext_BC,12,'Nest BC: did not find 12 monthes') else N_ext_BC=1 - endif - endif + end if + end if if(size(ndays_ext)0)units="vmr" if(index(adv_bc(bc)%varname,"mmr")>0)units="mmr" - endif + end if if(status==nf90_noerr) then if(DEBUG_NEST.or.DEBUG_ICBC) write(*,*)& 'Nest: variable '//trim(adv_bc(bc)%varname)//' has unit '//trim(units) @@ -1186,9 +1445,9 @@ subroutine read_newdata_LATERAL(ndays_indate) if(DEBUG_NEST.or.DEBUG_ICBC) write(*,*)& 'Nest: variable '//trim(adv_bc(bc)%varname//' has no unit attribute') unitscale=adv_bc(bc)%frac - endif + end if if(unitscale/=1.0) data=data*unitscale - endif + end if CALL MPI_BCAST(data,8*GIMAX_ext*GJMAX_ext*KMAX_ext_BC,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(divbyroa,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) @@ -1240,14 +1499,14 @@ subroutine read_newdata_LATERAL(ndays_indate) xn_adv_bndt(n,i,j,2)=xn_adv_bndt(n,i,j,2) & +WeightData(i,j,k1_ext(kt))*weight_k1(kt)& +WeightData(i,j,k2_ext(kt))*weight_k2(kt) - endif - enddo DO_BC + end if + end do DO_BC if(first_call)then ! copy 2 into 1 so that both are well defined rtime_saved(1)=rtime_saved(2)!put time in 1 call store_old_bc() ! store the old values in 1 - endif + end if deallocate(data) if(MasterProc) call check(nf90_close(ncFileID)) @@ -1260,15 +1519,15 @@ PURE function WeightData(i,j,k) result(wsum) wsum=dot_product(Weight(:,i,j),[& data(IIij(1,i,j),JJij(1,i,j),k),data(IIij(2,i,j),JJij(2,i,j),k),& data(IIij(3,i,j),JJij(3,i,j),k),data(IIij(4,i,j),JJij(4,i,j),k)]) - endfunction WeightData + end function WeightData subroutine store_old_bc !store the old values in 1 if(allocated(xn_adv_bndw)) xn_adv_bndw(:,:,:,1)=xn_adv_bndw(:,:,:,2) if(allocated(xn_adv_bnde)) xn_adv_bnde(:,:,:,1)=xn_adv_bnde(:,:,:,2) if(allocated(xn_adv_bnds)) xn_adv_bnds(:,:,:,1)=xn_adv_bnds(:,:,:,2) if(allocated(xn_adv_bndn)) xn_adv_bndn(:,:,:,1)=xn_adv_bndn(:,:,:,2) if(allocated(xn_adv_bndt)) xn_adv_bndt(:,:,:,1)=xn_adv_bndt(:,:,:,2) - endsubroutine store_old_bc -endsubroutine read_newdata_LATERAL + end subroutine store_old_bc +end subroutine read_newdata_LATERAL !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! subroutine reset_3D(ndays_indate) @@ -1299,7 +1558,7 @@ subroutine reset_3D(ndays_indate) logical :: divbyroa if(mydebug) write(*,*) 'Nest: initializations 3D', first_call - + if(first_call)then if(mydebug) write(*,*)'Nest: initializations 3D' allocate(IIij(4,LIMAX,LJMAX),JJij(4,LIMAX,LJMAX)) @@ -1316,9 +1575,9 @@ subroutine reset_3D(ndays_indate) if(MODE_READ=='MONTH'.and.(N_ext/=12.and.N_ext/=1.and.MasterProc))then write(*,*)'Nest: WARNING: Expected 12 or 1 monthes in IC file, found ',N_ext call CheckStop('Nest: IC: wrong number of months') - endif + end if if(mydebug) write(*,*)'Nest: end initializations 3D' - endif + end if allocate(data(GIMAX_ext,GJMAX_ext,KMAX_ext), stat=status) if(MasterProc)then call check(nf90_open(trim(fileName_read_3D),nf90_nowrite,ncFileID)) @@ -1328,21 +1587,21 @@ subroutine reset_3D(ndays_indate) else call nctime2date(ndate,ndays_indate,'Using record MM') n=ndate(2) - endif + end if else do n=1,N_ext if(ndays_ext(n)>=ndays_indate) goto 876 - enddo + end do n=N_ext write(*,*)'Nest: WARNING: did not find correct date' 876 continue call nctime2date(ndate,ndays_ext(n),'Using date YYYY-MM-DD hh:mm:ss') - endif + end if itime=n - endif + end if if(mydebug)write(*,*)'Nest: overwrite 3D' - + DO_SPEC: do n= 1, NSPEC_ADV if(.not.(adv_ic(n)%wanted.and.adv_ic(n)%found)) cycle DO_SPEC if(MasterProc)then @@ -1359,7 +1618,7 @@ subroutine reset_3D(ndays_indate) if(units=="1")then if(index(adv_ic(n)%varname,"vmr")>0)units="vmr" if(index(adv_ic(n)%varname,"mmr")>0)units="mmr" - endif + end if if(status==nf90_noerr) then if(DEBUG_NEST) write(*,*)& 'Nest: variable '//trim(adv_ic(n)%varname)//' has unit '//trim(units) @@ -1370,9 +1629,9 @@ subroutine reset_3D(ndays_indate) if(DEBUG_NEST) write(*,*)& 'Nest: variable '//trim(adv_ic(n)%varname//' has no unit attribute') unitscale=adv_ic(n)%frac - endif + end if if(unitscale/=1.0) data=data*unitscale - endif + end if CALL MPI_BCAST(data,8*GIMAX_ext*GJMAX_ext*KMAX_ext,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(divbyroa,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) @@ -1386,9 +1645,9 @@ subroutine reset_3D(ndays_indate) forall (k=1:KMAX_MID, j=1:ljmax, i=1:limax) & xn_adv(n,i,j,k)=WeightData(i,j,k1_ext(k))*weight_k1(k)& +WeightData(i,j,k2_ext(k))*weight_k2(k) - endif + end if - enddo DO_SPEC + end do DO_SPEC deallocate(data) if(MasterProc) call check(nf90_close(ncFileID)) @@ -1399,8 +1658,8 @@ PURE function WeightData(i,j,k) result(wsum) wsum=dot_product(Weight(:,i,j),[& data(IIij(1,i,j),JJij(1,i,j),k),data(IIij(2,i,j),JJij(2,i,j),k),& data(IIij(3,i,j),JJij(3,i,j),k),data(IIij(4,i,j),JJij(4,i,j),k)]) - endfunction WeightData -endsubroutine reset_3D + end function WeightData +end subroutine reset_3D endmodule Nest_ml !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! diff --git a/NetCDF_ml.f90 b/NetCDF_ml.f90 index e0459ae..2a1ab51 100644 --- a/NetCDF_ml.f90 +++ b/NetCDF_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -59,7 +59,13 @@ module NetCDF_ml ,lb2ij,lb2ijm,ij2lb& ,ref_latitude_EMEP,xp_EMEP_old,yp_EMEP_old& ,i_local,j_local,i_fdom,j_fdom& - ,Eta_bnd,Eta_mid,A_bnd,B_bnd,A_mid,B_mid + ,Eta_bnd,Eta_mid,A_bnd,B_bnd,A_mid,B_mid& + ,lon0_lambert,&!reference longitude, also called phi, at which y=0 if lat=lat0_lambert + lat0_lambert,&!reference latitude, at which x=0 + lat_stand1_lambert,&!standard latitude at which mapping factor=1 + lat_stand2_lambert,&!second standard latitude + x1_lambert,& !x value at i=1 + y1_lambert !y value at j=1 use InterpolationRoutines_ml, only : grid2grid_coeff use ModelConstants_ml, only: KMAX_MID,KMAX_BND, runlabel1, runlabel2 & ,MasterProc, FORECAST, NETCDF_DEFLATE_LEVEL & @@ -140,12 +146,12 @@ subroutine Out_CDF_sondes(fileName,SpecName,NSpec,Values,NLevels,g_ps,debug) real,intent(in) :: Values(Nlevels,NSpec,*),g_ps(*) logical, intent(in), optional :: debug logical :: debug_1D - integer :: ncFileID,status + integer :: ncFileID integer :: varID,dimID character(len=8) :: lastmodified_date character(len=10) :: lastmodified_hour - integer :: i,j,k,n,iSpec,nrecords,nstations - real :: rdays,x + integer :: i,iSpec,nrecords,nstations + real :: rdays real,save,allocatable :: buff(:,:) @@ -186,23 +192,23 @@ subroutine Out_CDF_sondes(fileName,SpecName,NSpec,Values,NLevels,g_ps,debug) else do i=1,nstations buff(i,1:NLevels)=Values(1:NLevels,iSpec,i)!NB: indices are switched (transposed of matrix) - enddo + end do call check(nf90_put_var(ncFileID,varID,buff,& start=[1,1,nrecords],count=[nstations,NLevels,1]),& "put:"//trim(SpecName(iSpec))) ! call check(nf90_put_var(ncFileID,varID,buff,start=[1,1,nrecords],count=[1,1,1])) - endif + end if if(NLevels>1)then call check(nf90_inq_varid(ncFileID,'PS',varID),"inq:PS") call check(nf90_put_var(ncFileID,varID,g_ps(1:nstations),& start=[1,nrecords],count=[nstations,1]),"put:PS") - endif - enddo + end if + end do call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_date",lastmodified_date)) call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour)) call check(nf90_close(ncFileID)) - endif !Masterproc -endsubroutine Out_CDF_sondes + end if !Masterproc +end subroutine Out_CDF_sondes subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& NStations,NMetaData,MetaData,KMAXcdf,CDFtype,debug) @@ -214,12 +220,12 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& integer, intent(in), optional :: CDFtype logical, intent(in), optional :: debug logical :: debug_1D - integer :: OUTtype,ncFileID,status,levDimID,ilevDimID,timeDimID - integer :: varID,StationDimID,StationVarID,StringDimID + integer :: OUTtype,ncFileID,levDimID,ilevDimID,timeDimID + integer :: varID,StationDimID,StringDimID character (len=*), parameter :: vert_coord='atmosphere_hybrid_sigma_pressure_coordinate' character(len=8) :: lastmodified_date character(len=10) :: lastmodified_hour - integer :: i,j,k,n,iSpec,iSta + integer :: i,k,n,iSpec,iSta real :: kcoord(KMAXcdf+1) real :: Acdf(KMAXcdf),Bcdf(KMAXcdf),Aicdf(KMAXcdf+1),Bicdf(KMAXcdf+1) integer,parameter :: MAX_String_length=36 @@ -283,7 +289,7 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& call check(nf90_put_att(ncFileID,varID,"long_name","hybrid B coefficient at layer interfaces")) else if(debug_1D)write(*,*)'not defining vertical levels ',KMAXcdf - endif + end if call check(nf90_def_var(ncFileID,"time",nf90_double,timeDimID,varID)) call check(nf90_put_att(ncFileID,varID,"long_name", "time (instantaneous)")) @@ -314,8 +320,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& "MetaData="//trim(MetaData(0,n))) case default call CheckStop("NetCDF_ml: unknown metadata-type "//trim(MetaData(0,n))) - endselect - enddo + end select + end do OUTtype=Real4 !default value if(present(CDFtype))OUTtype=CDFtype @@ -327,7 +333,7 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& case(Real8);OUTtype=nf90_double case default; call CheckStop("NetCDF_ml:undefined datatype") - endselect + end select do iSpec=1,NSpec !define the variables @@ -338,7 +344,7 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& else call check(nf90_def_var(ncFileID,SpecDef(iSpec,0),OUTtype,& [StationDimID,timeDimID],varID)) - endif + end if !species attributes: do n=1,NSpec_Att if(SpecDef(iSpec,n)=="")cycle @@ -358,7 +364,7 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& call check(nf90_put_att(ncFileID,varID,trim(auxL(1)),NF90_FILL_FLOAT)) case(NF90_DOUBLE) ! _FillValue=9.9692099683868690e+36 call check(nf90_put_att(ncFileID,varID,trim(auxL(1)),NF90_FILL_DOUBLE)) - endselect + end select case default auxC(1)=NF90_FILL_CHAR auxI(1)=NF90_FILL_INT @@ -378,10 +384,10 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& "SpecDef="//trim(SpecDef(iSpec,n))) case default call CheckStop("NetCDF_ml: unknown metadata-type "//trim(SpecDef(iSpec,n))) - endselect - endselect - enddo - enddo + end select + end select + end do + end do if(debug_1D)write(*,*)'Defining station meta-data' do n=1,NMetaData @@ -408,8 +414,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& "def:"//trim(auxL(1))//"@_FillValue") case default call CheckStop("NetCDF_ml: unknown metadata-type "//trim(MetaData(1,n))) - endselect - enddo + end select + end do call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_date",lastmodified_date)) call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour)) @@ -422,8 +428,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& call wordsplit(trim(MetaData(1,n)),3,auxL,k,ierr,strict_separator=':') call CheckStop(3,k,& "NetCDF_ml: too short metadata definition "//trim(MetaData(1,n))) - metaName=auxL(1) - metaType=auxL(2) + metaName=trim(auxL(1)) + metaType=trim(auxL(2)) auxC(:)=NF90_FILL_CHAR auxI(:)=NF90_FILL_INT auxR(:)=NF90_FILL_DOUBLE @@ -441,8 +447,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& case("c","C","s","S");auxC(iSta)=trim(auxL(3)) ! string/char attribute case("i","I","n","N");read(auxL(3),*)auxI(iSta) ! integer attribute case("f","F","d","D");read(auxL(3),*)auxR(iSta) ! float/double attribute - endselect - enddo + end select + end do call check(nf90_inq_varid(ncFileID,metaName,varID),"inq:"//trim(metaName)) select case(metaType) case("c","C","s","S") ! string/char attribute @@ -453,8 +459,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& call check(nf90_put_var(ncFileID,varID,auxR),"put:"//trim(metaType)) case default call CheckStop("NetCDF_ml: wrong metadata-type definition "//trim(metaType)) - endselect - enddo + end select + end do if(KMAXcdf>1)then call check(nf90_inq_varid(ncFileID,"P0",varID),"inq:P0") @@ -469,8 +475,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& if(k==KMAXcdf)then Aicdf(k+1)=A_bnd(KMAX_BND-k) Bicdf(k+1)=B_bnd(KMAX_BND-k) - endif - enddo + end if + end do call check(nf90_inq_varid(ncFileID,"hyam",varID),"inq:hyam") call check(nf90_put_var(ncFileID,varID,Acdf(1:KMAXcdf)/1e2),"put:hyam") @@ -483,26 +489,26 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& do i=1,KMAXcdf kcoord(i)=Acdf(i)/Pref+Bcdf(i) - enddo + end do call check(nf90_inq_varid(ncFileID,"lev",varID),"inq:lev") call check(nf90_put_var(ncFileID,varID,kcoord(1:KMAXcdf)) ,"put:lev") do i=1,KMAXcdf+1 kcoord(i)=Aicdf(i)/Pref+Bicdf(i) - enddo + end do call check(nf90_inq_varid(ncFileID,"ilev",varID),"inq:ilev") call check(nf90_put_var(ncFileID,varID,kcoord(1:KMAXcdf+1)),"put:ilev") - endif + end if call check(nf90_close(ncFileID)) - endif !Masterproc -endsubroutine Create_CDF_sondes + end if !Masterproc +end subroutine Create_CDF_sondes subroutine Init_new_netCDF(fileName,iotyp) integer, intent(in) :: iotyp character(len=*), intent(in) :: fileName integer :: GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,KMAXcdf -integer :: ih,i1,i2,j1,j2 +integer :: i1,i2,j1,j2 call CloseNetCDF !must be called by all procs, to syncronize outCDFtag @@ -557,7 +563,7 @@ subroutine Init_new_netCDF(fileName,iotyp) period_type = 'instant' case default period_type = 'unknown' -endselect +end select if(MasterProc.and.DEBUG_NETCDF)& write(*,*) "Creating ", trim(fileName),' ',trim(period_type) @@ -569,12 +575,12 @@ subroutine Init_new_netCDF(fileName,iotyp) KMAXcdf,KLEVcdf=LEVELS_HOURLY) else call CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,KMAXcdf) -endif +end if if(MasterProc.and.DEBUG_NETCDF)& write(*,*) "Finished Init_new_netCDF", trim(fileName),' ',trim(period_type) -!endif -endsubroutine Init_new_netCDF +!end if +end subroutine Init_new_netCDF subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& KMAXcdf,KLEVcdf,KLEVcdf_from_top,RequiredProjection) @@ -616,13 +622,13 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& write(*,*)'sizes (IMAX,JMAX,IBEG,JBEG,KMAX) ',& GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,KMAXcdf return - endif + end if if(present(RequiredProjection))then UsedProjection=trim(RequiredProjection) else UsedProjection=trim(projection) - endif + end if if(MasterProc)write(*,*)'creating ',trim(fileName) if(MasterProc.and.DEBUG_NETCDF)write(*,*)'UsedProjection ',trim(UsedProjection) @@ -636,7 +642,7 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& if(MasterProc.and.DEBUG_NETCDF)write(*,*)'nf90_created' else call check(nf90_create(fileName,nf90_clobber,ncFileID),"create:"//trim(fileName)) - endif + end if ! Define the dimensions select case(UsedProjection) @@ -674,6 +680,16 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& jVarID =define_var("j_RotS",nf90_float,[jDimID]) latVarID =define_var("lat" ,nf90_float,[iDimID,jDimID]) longVarID =define_var("lon" ,nf90_float,[iDimID,jDimID]) + case('lambert') + ! define coordinate dimensions + call check(nf90_def_dim(ncFileID,"i",GIMAXcdf,iDimID)) + call check(nf90_def_dim(ncFileID,"j",GJMAXcdf,jDimID)) + + ! define coordinate variables + iVarID =define_var("i_lambert",nf90_float,[iDimID]) + jVarID =define_var("j_lambert",nf90_float,[jDimID]) + latVarID =define_var("lat" ,nf90_float,[iDimID,jDimID]) + longVarID =define_var("lon" ,nf90_float,[iDimID,jDimID]) case default !general projection ! define coordinate dimensions call check(nf90_def_dim(ncFileID,"i",GIMAXcdf,iDimID),"dim:i") @@ -684,7 +700,7 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& jVarID =define_var("j" ,nf90_float,[jDimID]) latVarID =define_var("lat" ,nf90_float,[iDimID,jDimID]) longVarID =define_var("lon" ,nf90_float,[iDimID,jDimID]) - endselect + end select if(MasterProc.and.DEBUG_NETCDF)write(*,*)'lon lat dims defined' call check(nf90_def_dim(ncFileID, "lev",KMAXcdf , levDimID)) @@ -736,9 +752,11 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& case('Rotated_Spherical') varID=define_var("Rotated_Spherical",nf90_int ,[0]) varID=define_var("rotated_pole" ,nf90_char,[0]) ! for NCL + case('lambert') + varID=define_var("projection_lambert",nf90_int ,[0]) case default varID=define_var("Default_projection_name",nf90_int,[0]) - endselect + end select ! Leave define mode call check(nf90_enddef(ncFileID), "define_done"//trim(fileName) ) @@ -749,11 +767,11 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& xcoord(1)=(IBEGcdf-xp)*GRIDWIDTH_M/1000. do i=2,GIMAXcdf xcoord(i)=xcoord(i-1)+GRIDWIDTH_M/1000. - enddo + end do ycoord(1)=(JBEGcdf-yp)*GRIDWIDTH_M/1000. do j=2,GJMAXcdf ycoord(j)=ycoord(j-1)+GRIDWIDTH_M/1000. - enddo + end do call check(nf90_put_var(ncFileID,iVarID,xcoord(1:GIMAXcdf))) call check(nf90_put_var(ncFileID,jVarID,ycoord(1:GJMAXcdf))) @@ -768,28 +786,37 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& do i=1,GIMAXcdf xcoord(i)=(i+IBEGcdf-1-xp)*GRIDWIDTH_M/GRIDWIDTH_M_EMEP + xp_EMEP_official !print *, i,xcoord(i) - enddo + end do do j=1,GJMAXcdf ycoord(j)=(j+JBEGcdf-1-yp)*GRIDWIDTH_M/GRIDWIDTH_M_EMEP + yp_EMEP_official !print *, j,ycoord(j) - enddo + end do else xcoord(1:GIMAXcdf)=NF90_FILL_FLOAT ycoord(1:GJMAXcdf)=NF90_FILL_FLOAT - endif + end if call check(nf90_put_var(ncFileID,iEMEPVarID,xcoord(1:GIMAXcdf))) call check(nf90_put_var(ncFileID,jEMEPVarID,ycoord(1:GJMAXcdf))) case('Rotated_Spherical') do i=1,GIMAXcdf xcoord(i)= (i+IBEGcdf-2)*dx_rot+x1_rot - enddo + end do do j=1,GJMAXcdf ycoord(j)= (j+JBEGcdf-2)*dx_rot+y1_rot - enddo + end do call check(nf90_put_var(ncFileID,iVarID,xcoord(1:GIMAXcdf))) call check(nf90_put_var(ncFileID,jVarID,ycoord(1:GJMAXcdf))) + case('lambert') + do i=1,GIMAXcdf + xcoord(i)= (i+IBEGcdf-2)*GRIDWIDTH_M+x1_lambert + end do + do j=1,GJMAXcdf + ycoord(j)= (j+JBEGcdf-2)*GRIDWIDTH_M+y1_lambert + end do + call check(nf90_put_var(ncFileID,iVarID,xcoord(1:GIMAXcdf))) + call check(nf90_put_var(ncFileID,jVarID,ycoord(1:GJMAXcdf))) case('lon lat') do i=1,GIMAXcdf xcoord(i)= glon(1,1)+(i_local(i+IBEGcdf-1)-1)*(glon(2,1)-glon(1,1)) @@ -797,11 +824,11 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& if(i>1)then !must first check that i>1 before testing xcoord(i-1) (to avoid debug errors) if(xcoord(i)GIMAXcdf)icount=GIMAXcdf-istart+1 @@ -889,20 +916,20 @@ subroutine CreatenetCDFfile(fileName,GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,& call check(nf90_put_var(ncFileID, latVarID, & Buff2D(i1:i1+icount-1,j1:j1+jcount-1,2), & start=[istart,jstart],count=[icount,jcount])) - endif - enddo + end if + end do if(DEBUG_NETCDF) write(*,*) "NetCDF: lon lat written" else CALL MPI_SEND(Buff2D,2*8*MAXLIMAX*MAXLJMAX,MPI_BYTE,0,& me,MPI_COMM_CALC,IERROR) - endif - endif + end if + end if if(MasterProc)then call check(nf90_close(ncFileID)) if(DEBUG_NETCDF)write(*,*)'NetCDF: file created, end of CreatenetCDFfile ',ncFileID - endif + end if contains function define_var(vname,xtype,dimIDs) result(varID) character(len=*), intent(in) :: vname @@ -942,6 +969,18 @@ function define_var(vname,xtype,dimIDs) result(varID) call check(nf90_put_att(ncFileID,varID,"long_name","Rotated latitude")) call check(nf90_put_att(ncFileID,varID,"units","degrees")) call check(nf90_put_att(ncFileID,varID,"axis","Y")) + case("i_lambert") + call check(nf90_def_var(ncFileID,"i",xtype,dimIDs,varID),"def:"//trim(vname)) + call check(nf90_put_att(ncFileID,varID,"standard_name","projection_x_coordinate")) + call check(nf90_put_att(ncFileID,varID,"long_name","x-coordinate in Cartesian system")) + call check(nf90_put_att(ncFileID,varID,"units","m")) + call check(nf90_put_att(ncFileID,varID,"axis","X")) + case("j_lambert") + call check(nf90_def_var(ncFileID,"j",xtype,dimIDs,varID),"def:"//trim(vname)) + call check(nf90_put_att(ncFileID,varID,"standard_name","projection_y_coordinate")) + call check(nf90_put_att(ncFileID,varID,"long_name","y-coordinate in Cartesian system")) + call check(nf90_put_att(ncFileID,varID,"units","m")) + call check(nf90_put_att(ncFileID,varID,"axis","Y")) case("lat") call check(nf90_def_var(ncFileID,"lat",xtype,dimIDs,varID),"def:"//trim(vname)) call check(nf90_put_att(ncFileID,varID,"long_name","latitude")) @@ -982,6 +1021,12 @@ function define_var(vname,xtype,dimIDs) result(varID) case("P0") call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) call check(nf90_put_att(ncFileID,varID,"units","hPa")) + case("x_dist") + call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) + call check(nf90_put_att(ncFileID,varID,"long_name","displacement in x direction")) + case("y_dist") + call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) + call check(nf90_put_att(ncFileID,varID,"long_name","displacement in y direction")) case("time") call check(nf90_def_var(ncFileID,vname,xtype,dimIDs,varID),"def:"//trim(vname)) select case(period_type) @@ -989,7 +1034,7 @@ function define_var(vname,xtype,dimIDs) result(varID) call check(nf90_put_att(ncFileID,varID,"long_name","time at end of period")) case default call check(nf90_put_att(ncFileID,varID,"long_name","time at middle of period")) - endselect + end select call check(nf90_put_att(ncFileID,varID,"units","days since 1900-1-1 0:0:0")) case('Polar_Stereographic') call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) @@ -1007,13 +1052,20 @@ function define_var(vname,xtype,dimIDs) result(varID) call check(nf90_put_att(ncFileID,varID,"grid_mapping_name","rotated_latitude_longitude")) call check(nf90_put_att(ncFileID,varID,"grid_north_pole_latitude",grid_north_pole_latitude)) call check(nf90_put_att(ncFileID,varID,"grid_north_pole_longitude", grid_north_pole_longitude)) + case('projection_lambert') + call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) + call check(nf90_put_att(ncFileID,varID,"grid_mapping_name","lambert_conformal_conic")) + call check(nf90_put_att(ncFileID,varID,"standard_parallel",(/lat_stand1_lambert,lat_stand2_lambert/))) + call check(nf90_put_att(ncFileID,varID,"longitude_of_central_meridian",lon0_lambert)) + call check(nf90_put_att(ncFileID,varID,"latitude_of_projection_origin",lat0_lambert)) + call check(nf90_put_att(ncFileID,varID,"earth_radius",earth_radius))!NB: reset to the same as in metdata case(Default_projection_name) call check(nf90_def_var(ncFileID,vname,xtype,varID),"def:"//trim(vname)) call check(nf90_put_att(ncFileID,varID,"grid_mapping_name",trim(UsedProjection))) case default - call CheckStop("CreatenetCDFfile: unknown metadata varaible "//trim(vname)) - endselect -endfunction define_var + call CheckStop("CreatenetCDFfile: unknown metadata variable "//trim(vname)) + end select +end function define_var subroutine write_klev(kmax,klev,from_top) integer, intent(in) :: kmax,klev(kmax) logical, intent(in) :: from_top @@ -1033,8 +1085,8 @@ subroutine write_klev(kmax,klev,from_top) Ai(k)=A_bnd(klev(k)) Bi(k)=B_bnd(klev(k)) if(DEBUG_NETCDF) write(*,*) "TESTHH netcdf KLEVcdf ",k,klev(k),Am(k) - endif - enddo + end if + end do Ai(kmax+1)=A_bnd(klev(kmax)+1) ! top boundary Bi(kmax+1)=B_bnd(klev(kmax)+1) else ! from surface to model top (REVERSE order) @@ -1050,11 +1102,11 @@ subroutine write_klev(kmax,klev,from_top) Ai(k)=A_bnd(KMAX_BND-klev(k)+1) Bi(k)=B_bnd(KMAX_BND-klev(k)+1) if(DEBUG_NETCDF) write(*,*) "TESTHH netcdf KLEVcdf ",k,klev(k),Am(k) - endif - enddo + end if + end do Ai(kmax+1)=A_bnd(KMAX_BND-klev(kmax)) ! top boundary Bi(kmax+1)=B_bnd(KMAX_BND-klev(kmax)) - endif + end if call check(nf90_inq_varid(ncFileID,"P0" ,varID) ,"inq:P0") call check(nf90_put_var(ncFileID,varID,Pref/100.0),"put:P0") call check(nf90_inq_varid(ncFileID,"hyam",varID) ,"inq:hyam") @@ -1069,10 +1121,10 @@ subroutine write_klev(kmax,klev,from_top) call check(nf90_put_var(ncFileID,varID,Am/Pref+Bm),"put:lev") call check(nf90_inq_varid(ncFileID,"ilev",varID) ,"inq:ilev") call check(nf90_put_var(ncFileID,varID,Ai/Pref+Bi),"put:ilev") -endsubroutine write_klev -endsubroutine CreatenetCDFfile +end subroutine write_klev +end subroutine CreatenetCDFfile !_______________________________________________________________________ -subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& +subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,dimSizes,dimNames,out_DOMAIN,ik,& fileName_given,overwrite,create_var_only,chunksizes,ncfileID_given) !The use of fileName_given is probably slower than the implicit filename used by defining iotyp. @@ -1081,11 +1133,13 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& type(Deriv), intent(in) :: def1 ! definition of fields integer, intent(in) :: iotyp real, intent(in) :: scale - real, dimension(LIMAX,LJMAX,KMAX), intent(in) :: dat ! Data arrays + real, dimension(*), intent(in) :: dat ! Data arrays ! Optional arguments: integer, optional, intent(in) :: & + dimSizes(ndim),& out_DOMAIN(4),ik,& ! Output subdomain. Only level ik is written if defined CDFtype != OUTtype. (Integer*1, Integer*2,Integer*4, real*8 or real*4) + character(len=*),intent(in), optional :: dimNames(ndim) character (len=*),optional, intent(in) :: & fileName_given ! filename to which the data must be written !NB if the file fileName_given exist (also from earlier runs) it will be appended @@ -1103,7 +1157,7 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& character(len=08) :: lastmodified_date character(len=10) :: lastmodified_hour,lastmodified_hour0,created_hour integer :: varID,nrecords,ncFileID=closedID,ndate(4) - integer :: info,d,alloc_err,ijk,status,i,j,k,i1,i2,j1,j2 + integer :: d,alloc_err,ijk,status,i,j,k,i1,i2,j1,j2 real :: buff(MAXLIMAX*MAXLJMAX*KMAX_MID) real(kind=8), allocatable,dimension(:,:,:) :: R8data3D real(kind=4), allocatable,dimension(:,:,:) :: R4data3D @@ -1116,7 +1170,7 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& real(kind=8) :: rdays,rdays_time(1) logical :: overwrite_local,createfile=.false. integer, parameter :: IOU_GIVEN=-IOU_INST - integer ::domain(4) + integer ::domain(4),startvec(10),countvec(10),Nextradim,n,iextradim,iiextradim,nijk domain=RUNDOMAIN!default domain (in fulldoamin coordinates) !fullrun, Monthly, Daily and hourly domains may be predefined @@ -1129,7 +1183,7 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& domain = day_DOMAIN case(IOU_HOUR:IOU_HOUR_EXTRA) domain = hour_DOMAIN - endselect + end select if(present(out_DOMAIN)) domain = out_DOMAIN !convert into rundomain coordinates i1=domain(1)-IRUNBEG+1 @@ -1144,7 +1198,7 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& if(MasterProc) write(*,*)'WARNING: requested boundaries inconsistent ' if(MasterProc) write(*,*) i1,i2,j1,j2,kmax return - endif + end if !make variable name write(varname,fmt='(A)')trim(def1%name) @@ -1183,15 +1237,15 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& status=nf90_noerr if(DEBUG_NETCDF) & write(*,*)'Out_NetCDF: assuming file already open ',trim(fileName_given) - endif + end if else status=nf90_open(trim(fileName_given),nf90_write,ncFileID) - endif + end if if(DEBUG_NETCDF) write(*,*)'Out_NetCDF: fileName_given ' ,& trim(fileName_given),overwrite_local,status==nf90_noerr,ncfileID,& trim(nf90_strerror(status)) createfile=overwrite_local.or.(status/=nf90_noerr) - endif + end if CALL MPI_BCAST(createfile ,1,MPI_LOGICAL,0,MPI_COMM_CALC,IERROR) IBEGcdf=IRUNBEG+i1-1 @@ -1200,7 +1254,8 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& GJMAXcdf=j2-j1+1 if(createfile) then ! the file does not exist yet or is overwritten - if(MasterProc)write(6,*) 'creating file: ',trim(fileName_given) + + if(MasterProc)write(6,fmt='(A,12I6)') 'creating file: '//trim(fileName_given)//" with sizes ",GIMAXcdf,GJMAXcdf,KMAX period_type = 'unknown' call CreatenetCDFfile(trim(fileName_given),GIMAXcdf,GJMAXcdf,IBEGcdf,JBEGcdf,KMAX) if(present(ncFileID_given))then @@ -1210,32 +1265,39 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& call check(nf90_open(trim(fileName_given),nf90_share+nf90_write,ncFileID)) else ncFileID=closedID - endif + end if else ncFileID=closedID - endif - elseif(MasterProc)then + end if + elseif(MasterProc)then !test if the defined dimensions are compatible - if(DEBUG_NETCDF)& - write(6,*) 'check dims file: ',trim(fileName_given) + if(DEBUG_NETCDF)then + write(6,*) 'checking dims file: ',trim(fileName_given),ncFileID + ! find main properties + call check(nf90_Inquire(ncFileID,n,i,j)) + print *, trim(fileName),ncfileid,' properties: ' + print *, 'Nb of dimensions: ',n + print *, 'Nb of variables: ',i + endif select case(projection) case('lon lat') - call check(nf90_inq_dimid(ncFileID,"lon",idimID),"dim:lon") - call check(nf90_inq_dimid(ncFileID,"lat",jdimID),"dim:lat") + call check(nf90_inq_dimid(ncFileID,"lon",idimID),"dim:lon") + call check(nf90_inq_dimid(ncFileID,"lat",jdimID),"dim:lat") case default call check(nf90_inq_dimid(ncFileID,"i" ,idimID),"dim:i") call check(nf90_inq_dimid(ncFileID,"j" ,jdimID),"dim:j") - endselect + end select + if(USE_EtaCOORDINATES)then call check(nf90_inq_dimid(ncFileID,"lev",kdimID),"dim:lev") else call check(nf90_inq_dimid(ncFileID,"k" ,kdimID),"dim:k") - endif + end if ! only i,j coords can be handled for PS so far. - ! Posisble x,y would give wrong dimID. + ! Possible x,y would give wrong dimID. ! Check if all dims are found: call CheckStop(any([idimID,jdimID,kdimID]<0),& - "ReadField_CDF: no dimID found for"//trim(fileName_given)) + "Out_NetCDF: no dimID found for"//trim(fileName_given)) call check(nf90_inquire_dimension(ncFileID,idimID,len=GIMAX_old),"len:i") call check(nf90_inquire_dimension(ncFileID,jdimID,len=GJMAX_old),"len:j") @@ -1252,20 +1314,20 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& !call CreatenetCDFfile(trim(fileName_given),GIMAXcdf,GJMAXcdf,& ! IBEGcdf,JBEGcdf,KMAX) !ncFileID=closedID - endif - endif + end if + end if iotyp_new=IOU_GIVEN ncFileID_new=ncFileID - endif + end if if(DEBUG_NETCDF.and.MasterProc)then if(iotyp_new==IOU_GIVEN)then write(*,*)' Out_NetCDF: cases new file ', trim(fileName_given), iotyp else write(*,*)' Out_NetCDF: cases old file ', trim(fileName), iotyp - endif - endif + end if + end if select case(iotyp_new) case(IOU_GIVEN) @@ -1276,14 +1338,16 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& ncFileID = ncFileID_iou(iotyp_new) case default return - endselect + end select if(present(ncFileID_given))ncFileID_given=ncFileID!use rather stored ncFileID_XXX if(DEBUG_NETCDF.and.MasterProc) & write(*,*)'Out_NetCDF, filename ', trim(fileName), iotyp,ncFileID - call CheckStop(ndim,[2,3], "NetCDF_ml: ndim must be 2 or 3") + if(.not. present(dimSizes))then + call CheckStop(ndim,[2,3], "NetCDF_ml: ndim must be 2 or 3") + endif OUTtype=Real4 !default value if(present(CDFtype))OUTtype=CDFtype @@ -1301,8 +1365,8 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& ncFileID_new = ncFileID ! not really needed case(IOU_INST:IOU_HOUR_EXTRA) ncFileID_iou(iotyp_new)=ncFileID - endselect - endif + end select + end if !test first if the variable is already defined: status=nf90_inq_varid(ncFileID,varname,VarID) @@ -1312,13 +1376,14 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& else if(DEBUG_NETCDF) write(*,*) 'Out_NetCDF: creating variable: ',varname if(create_var_only_local) & - call check(nf90_set_fill(ncFileID,NF90_NOFILL,ijk),"nofill:"//trim(varname)) - if(present(chunksizes))& - call CheckStop(chunksizes(1)/=(i2-i1+1).or.chunksizes(2)/=(j2-j1+1),& - "NetCDF_ml: chunksizes has wrong dimensions") - call createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksizes=chunksizes) - endif - endif!MasterProc + call check(nf90_set_fill(ncFileID,NF90_NOFILL,ijk),"nofill:"//trim(varname)) + if(.not.present(dimSizes).and.present(chunksizes))& + call CheckStop(chunksizes(1)/=(i2-i1+1).or.chunksizes(2)/=(j2-j1+1),& + "NetCDF_ml: chunksizes has wrong dimensions") + call createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksizes=chunksizes,& + dimSizes=dimSizes,dimNames=dimNames) + end if + end if!MasterProc if(create_var_only_local)then ! Don't write the data @@ -1329,231 +1394,288 @@ subroutine Out_netCDF(iotyp,def1,ndim,kmax,dat,scale,CDFtype,out_DOMAIN,ik,& ncFileID_given=ncFileID else call check(nf90_close(ncFileID),"close:"//trim(fileName)) - endif - endif + end if + end if if(DEBUG_NETCDF.and.MasterProc)write(*,*)'variable ONLY created. Finished' - return - endif ! create var only - - !buffer the wanted part of data - ijk=0 - do k=1,kmax - do j = 1,tljmax(me) - do i = 1,tlimax(me) - ijk=ijk+1 - buff(ijk)=dat(i,j,k)*scale - enddo - enddo - enddo - - !send all data to me=0 - outCDFtag=outCDFtag+1 - - if(MasterProc)then - ! allocate a large array (only on one processor) - select case(OUTtype) - case(Int1,Int2,Int4) - allocate(Idata3D (GIMAX,GJMAX,kmax),stat=alloc_err) - case(Real4) - allocate(R4data3D(GIMAX,GJMAX,kmax),stat=alloc_err) - case(Real8) - allocate(R8data3D(GIMAX,GJMAX,kmax),stat=alloc_err) - case default - WRITE(*,*)'WARNING NetCDF:Data type not supported' - alloc_err=-1 ! trip error stop - endselect - call CheckStop(alloc_err, "alloc failed in NetCDF_ml") - - !write own data in global array - select case(OUTtype) - case(Int1,Int2,Int4) - ijk=0 - do k=1,kmax - do j = tgj0(me),tgj0(me)+tljmax(me)-1 - do i = tgi0(me),tgi0(me)+tlimax(me)-1 - ijk=ijk+1 - Idata3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - case(Real4) - ijk=0 - do k=1,kmax - do j = tgj0(me),tgj0(me)+tljmax(me)-1 - do i = tgi0(me),tgi0(me)+tlimax(me)-1 - ijk=ijk+1 - R4data3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - case(Real8) - ijk=0 - do k=1,kmax - do j = tgj0(me),tgj0(me)+tljmax(me)-1 - do i = tgi0(me),tgi0(me)+tlimax(me)-1 - ijk=ijk+1 - R8data3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - endselect - - do d = 1, NPROC-1 - CALL MPI_RECV(buff, 8*tlimax(d)*tljmax(d)*kmax, MPI_BYTE, d, & - outCDFtag, MPI_COMM_CALC, MPISTATUS, IERROR) - - ! copy data to global buffer - select case(OUTtype) - case(Int1,Int2,Int4) - ijk=0 - do k=1,kmax - do j = tgj0(d),tgj0(d)+tljmax(d)-1 - do i = tgi0(d),tgi0(d)+tlimax(d)-1 - ijk=ijk+1 - Idata3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - case(Real4) - ijk=0 - do k=1,kmax - do j = tgj0(d),tgj0(d)+tljmax(d)-1 - do i = tgi0(d),tgi0(d)+tlimax(d)-1 - ijk=ijk+1 - R4data3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - case(Real8) - ijk=0 - do k=1,kmax - do j = tgj0(d),tgj0(d)+tljmax(d)-1 - do i = tgi0(d),tgi0(d)+tlimax(d)-1 - ijk=ijk+1 - R8data3D(i,j,k)=buff(ijk) - enddo - enddo - enddo - endselect - enddo - else - CALL MPI_SEND( buff, 8*tlimax(me)*tljmax(me)*kmax, MPI_BYTE, 0, & - outCDFtag, MPI_COMM_CALC, IERROR) + CALL MPI_BARRIER(MPI_COMM_CALC, IERROR)!wait until the file creation is finished + return + end if ! create var only + + Nextradim=1 + if(present(dimSizes))then + do n=1,ndim-3 + Nextradim=Nextradim*dimSizes(n) + enddo endif - !return - - if(MasterProc)then - ndate(1:4) = [current_date%year,current_date%month,& - current_date%day ,current_date%hour] - - ! get variable id - call check(nf90_inq_varid(ncFileID,varname,VarID)) - ! find the number of records already written - call check(nf90_get_att(ncFileID,VarID,"numberofrecords",nrecords)) - if(DEBUG_NETCDF) print *,'number of dataset saved: ',nrecords - - ! test if new record is needed - if(present(ik).and.nrecords>0)then - ! The new record may already exist - call date2nctime(current_date,rdays,iotyp) - call check(nf90_inq_varid(ncFileID,"time",timeVarID)) - call check(nf90_get_var(ncFileID,timeVarID,rdays_time,start=(/nrecords/))) - ! check if this is a newer time - if((abs(rdays-rdays_time(1))>0.00001))then!0.00001 is about 1 second - nrecords=nrecords+1 !start a new record - endif - else - ! increase nrecords, to define position of new data - nrecords=nrecords+1 - endif - if(DEBUG_NETCDF) print *,'writing on dataset: ',nrecords - - ! append new values - select case(OUTtype) - case(Int1,Int2,Int4) ! type Integer - if(ndim==3)then - if(present(ik))then - ! print *, 'write: ',i1,i2, j1,j2,ik - call check(nf90_put_var(ncFileID,VarID,Idata3D(i1:i2,j1:j2,1),& - start=(/1,1,ik,nrecords/))) - else - call check(nf90_put_var(ncFileID,VarID,Idata3D(i1:i2,j1:j2,1:kmax),& - start=(/1,1,1,nrecords/))) - endif - else - call check(nf90_put_var(ncFileID, VarID,Idata3D(i1:i2,j1:j2,1),& - start=(/1,1,nrecords/))) - endif - deallocate(Idata3D,stat=alloc_err) - call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") - - case(Real4) ! type Real4 - if(ndim==3)then - if(present(ik))then - ! print *, 'write: ',i1,i2, j1,j2,ik - call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1),& - start=(/1,1,ik,nrecords/))) - else - call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1:kmax),& - start=(/1,1,1,nrecords/))) + do iextradim = 1,Nextradim + startvec(1:ndim+1)=1 + countvec(1:ndim+1)=1 + iiextradim = iextradim-1 + do n=1,ndim-3 + startvec(n)=mod(iiextradim,dimSizes(n))+1 + iiextradim=iiextradim/dimSizes(n) + enddo + if(ndim-2>0)countvec(ndim-2)=i2-i1+1 + if(ndim-1>0)countvec(ndim-1)=j2-j1+1 + countvec(ndim)=kmax + !buffer the wanted part of data + ijk=0 + nijk=iextradim-Nextradim + do k=1,kmax + do j = 1,tljmax(me) + do i = 1,tlimax(me) + ijk=ijk+1 + nijk=nijk+Nextradim +! if(i==5.and.j==5.and.k==kmax.and.mod(iextradim-1,11)==0.and.dat(nijk)>1.E-12)write(*,*)trim(varname),me,iextradim,dat(nijk) + buff(ijk)=dat(nijk)*scale + !if(isnan(buff(ijk)))then + ! write(*,*)'ERROR ',me,i,j,k,iextradim,ijk + ! stop + !endif + !if(buff(ijk)>1.1)then + ! write(*,*)'too large ERROR ',trim(varname),me,i,j,k,iextradim,ijk,buff(ijk) + ! stop + !endif + end do + end do + end do + + !send all data to me=0 + outCDFtag=outCDFtag+1 + + if(MasterProc)then + if(iextradim==1)then + ! allocate a large array (only on one processor) + select case(OUTtype) + case(Int1,Int2,Int4) + allocate(Idata3D (GIMAX,GJMAX,kmax),stat=alloc_err) + case(Real4) + allocate(R4data3D(GIMAX,GJMAX,kmax),stat=alloc_err) + case(Real8) + allocate(R8data3D(GIMAX,GJMAX,kmax),stat=alloc_err) + case default + WRITE(*,*)'WARNING NetCDF:Data type not supported' + alloc_err=-1 ! trip error stop + end select + call CheckStop(alloc_err, "alloc failed in NetCDF_ml") endif - else - call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1),& - start=(/1,1,nrecords/))) - endif - deallocate(R4data3D, stat=alloc_err) - call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") - - case(Real8) ! type Real8 - if(ndim==3)then - if(present(ik))then - ! print *, 'write: ',i1,i2, j1,j2,ik - call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1),& - start=(/1,1,ik,nrecords/))) + !write own data in global array + select case(OUTtype) + case(Int1,Int2,Int4) + ijk=0 + do k=1,kmax + do j = tgj0(me),tgj0(me)+tljmax(me)-1 + do i = tgi0(me),tgi0(me)+tlimax(me)-1 + ijk=ijk+1 + Idata3D(i,j,k)=buff(ijk) + end do + end do + end do + case(Real4) + ijk=0 + do k=1,kmax + do j = tgj0(me),tgj0(me)+tljmax(me)-1 + do i = tgi0(me),tgi0(me)+tlimax(me)-1 + ijk=ijk+1 + R4data3D(i,j,k)=buff(ijk) + end do + end do + end do + case(Real8) + ijk=0 + do k=1,kmax + do j = tgj0(me),tgj0(me)+tljmax(me)-1 + do i = tgi0(me),tgi0(me)+tlimax(me)-1 + ijk=ijk+1 + R8data3D(i,j,k)=buff(ijk) + end do + end do + end do + end select + + do d = 1, NPROC-1 + CALL MPI_RECV(buff, 8*tlimax(d)*tljmax(d)*kmax, MPI_BYTE, d, & + outCDFtag, MPI_COMM_CALC, MPISTATUS, IERROR) + + ! copy data to global buffer + select case(OUTtype) + case(Int1,Int2,Int4) + ijk=0 + do k=1,kmax + do j = tgj0(d),tgj0(d)+tljmax(d)-1 + do i = tgi0(d),tgi0(d)+tlimax(d)-1 + ijk=ijk+1 + Idata3D(i,j,k)=buff(ijk) + end do + end do + end do + case(Real4) + ijk=0 + do k=1,kmax + do j = tgj0(d),tgj0(d)+tljmax(d)-1 + do i = tgi0(d),tgi0(d)+tlimax(d)-1 + ijk=ijk+1 + R4data3D(i,j,k)=buff(ijk) + end do + end do + end do + case(Real8) + ijk=0 + do k=1,kmax + do j = tgj0(d),tgj0(d)+tljmax(d)-1 + do i = tgi0(d),tgi0(d)+tlimax(d)-1 + ijk=ijk+1 + R8data3D(i,j,k)=buff(ijk) + end do + end do + end do + end select + end do + else + CALL MPI_SEND( buff, 8*tlimax(me)*tljmax(me)*kmax, MPI_BYTE, 0, & + outCDFtag, MPI_COMM_CALC, IERROR) + end if + !return + + if(MasterProc)then + if(iextradim==1)then + ndate(1:4) = [current_date%year,current_date%month,& + current_date%day ,current_date%hour] + + ! get variable id + call check(nf90_inq_varid(ncFileID,varname,VarID)) + ! find the number of records already written + call check(nf90_get_att(ncFileID,VarID,"numberofrecords",nrecords)) + if(DEBUG_NETCDF) print *,'number of dataset saved: ',nrecords + + ! test if new record is needed + if(present(ik).and.nrecords>0 .and. iextradim==1)then + ! The new record may already exist + call date2nctime(current_date,rdays,iotyp) + call check(nf90_inq_varid(ncFileID,"time",timeVarID)) + call check(nf90_get_var(ncFileID,timeVarID,rdays_time,start=(/nrecords/))) + ! check if this is a newer time + if((abs(rdays-rdays_time(1))>0.00001))then!0.00001 is about 1 second + nrecords=nrecords+1 !start a new record + end if else - call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1:kmax),& - start=(/1,1,1,nrecords/))) + ! increase nrecords, to define position of new data + nrecords=nrecords+1 + end if + if(DEBUG_NETCDF) print *,'writing on dataset: ',nrecords endif - else - call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1),& - start=(/1,1,nrecords/))) - endif - deallocate(R8data3D, stat=alloc_err) - call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") - - endselect !type - - call check(nf90_get_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour0 )) - call check(nf90_get_att(ncFileID,nf90_global,"created_hour",created_hour)) - call Date_And_Time(date=lastmodified_date,time=lastmodified_hour) - - ! write or change attributes NB: strings must be of same length as originally - call check(nf90_put_att(ncFileID,VarID,"numberofrecords",nrecords)) - - ! update dates - call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_date",lastmodified_date)) - call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour)) - call check(nf90_put_att(ncFileID,VarID, "current_date_last",ndate)) + startvec(ndim+1)=nrecords + + ! append new values + select case(OUTtype) + case(Int1,Int2,Int4) ! type Integer + if(ndim==3)then + if(present(ik))then + ! print *, 'write: ',i1,i2, j1,j2,ik + call check(nf90_put_var(ncFileID,VarID,Idata3D(i1:i2,j1:j2,1),& + start=(/1,1,ik,nrecords/))) + else + call check(nf90_put_var(ncFileID,VarID,Idata3D(i1:i2,j1:j2,1:kmax),& + start=(/1,1,1,nrecords/))) + end if + else if(ndim==2)then + call check(nf90_put_var(ncFileID, VarID,Idata3D(i1:i2,j1:j2,1),& + start=(/1,1,nrecords/))) + else + call check(nf90_put_var(ncFileID, VarID,Idata3D(i1:i2,j1:j2,1:kmax),& + start=startvec(1:ndim+1),count=countvec(1:ndim+1))) + end if + + case(Real4) ! type Real4 + if(ndim==3)then + if(present(ik))then + ! print *, 'write: ',i1,i2, j1,j2,ik + call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1),& + start=(/1,1,ik,nrecords/))) + else + call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1:kmax),& + start=(/1,1,1,nrecords/))) + end if + else if(ndim==2)then + call check(nf90_put_var(ncFileID,VarID,R4data3D(i1:i2,j1:j2,1),& + start=(/1,1,nrecords/))) + else + !write(*,*)'writing slice ',iextradim,' of ',Nextradim +! if(mod(iextradim-1,12)==0)then +! write(*,*)trim(varname),me,startvec(2),startvec(3),iextradim,R4data3D(GIMAX/2,GJMAX/2,kmax) +! endif + !if(me>=0)write(*,*)iextradim,'outcdf locfrac ',R4data3D(4,37,7),trim(varname),trim(fileName) + call check(nf90_put_var(ncFileID, VarID,R4data3D(i1:i2,j1:j2,1:kmax),& + start=startvec(1:ndim+1),count=countvec(1:ndim+1))) + end if + + case(Real8) ! type Real8 + if(ndim==3)then + if(present(ik))then + ! print *, 'write: ',i1,i2, j1,j2,ik + call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1),& + start=(/1,1,ik,nrecords/))) + else + call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1:kmax),& + start=(/1,1,1,nrecords/))) + end if + else if(ndim==2)then + call check(nf90_put_var(ncFileID,VarID,R8data3D(i1:i2,j1:j2,1),& + start=(/1,1,nrecords/))) + else + call check(nf90_put_var(ncFileID, VarID,R8data3D(i1:i2,j1:j2,1:kmax),& + start=startvec(1:ndim+1),count=countvec(1:ndim+1))) + end if + + end select !type + end if !MasterProc + enddo - ! update time dim - call check(nf90_inq_varid(ncFileID,"time",VarID)) - call date2nctime(current_date,rdays,iotyp) - call check(nf90_put_var(ncFileID,VarID,rdays,start=(/nrecords/))) + if(MasterProc)then + select case(OUTtype) + case(Int1,Int2,Int4) ! type Integer + deallocate(Idata3D,stat=alloc_err) + call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") + case(Real4) ! type Real4 + deallocate(R4data3D, stat=alloc_err) + call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") + case(Real8) ! type Real8 + deallocate(R8data3D, stat=alloc_err) + call CheckStop(alloc_err, "dealloc failed in NetCDF_ml") + end select !type + + call check(nf90_get_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour0 )) + call check(nf90_get_att(ncFileID,nf90_global,"created_hour",created_hour)) + call Date_And_Time(date=lastmodified_date,time=lastmodified_hour) + + ! write or change attributes NB: strings must be of same length as originally + call check(nf90_put_att(ncFileID,VarID,"numberofrecords",nrecords)) + + ! update dates + call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_date",lastmodified_date)) + call check(nf90_put_att(ncFileID,nf90_global,"lastmodified_hour",lastmodified_hour)) + call check(nf90_put_att(ncFileID,VarID, "current_date_last",ndate)) + + ! update time dim + call check(nf90_inq_varid(ncFileID,"time",VarID)) + call date2nctime(current_date,rdays,iotyp) + call check(nf90_put_var(ncFileID,VarID,rdays,start=(/nrecords/))) + + !close file if present(fileName_given) + if(iotyp_new==IOU_GIVEN)then + if(present(ncFileID_given))then + if(DEBUG_NETCDF)write(*,*)'keep open ',trim(fileName),ncFileID + ncFileID_given=ncFileID + else + call check(nf90_close(ncFileID)) + end if + end if + end if !MasterProc - !close file if present(fileName_given) - if(iotyp_new==IOU_GIVEN)then - if(present(ncFileID_given))then - if(DEBUG_NETCDF)write(*,*)'keep open ',trim(fileName),ncFileID - ncFileID_given=ncFileID - else - call check(nf90_close(ncFileID)) - endif - endif - endif !MasterProc if(DEBUG_NETCDF.and.MasterProc) write(*,*)'Out_NetCDF: FINISHED ' -endsubroutine Out_netCDF +end subroutine Out_netCDF !_______________________________________________________________________ -subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksizes) +subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksizes,dimSizes,dimNames) ! create new netCDF variable implicit none @@ -1562,12 +1684,14 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize character(len=*),intent(in) :: varname integer, intent(in) :: ndim,ncFileID,OUTtype integer,dimension(:),intent(in) :: ndate - integer,dimension(ndim),intent(in), optional :: chunksizes - - integer :: iDimID,jDimID,kDimID,timeDimID - integer :: varID,nrecords,status + integer,dimension(ndim),intent(in), optional :: chunksizes,dimSizes + character(len=*),intent(in), optional :: dimNames(ndim) + integer :: iDimID,jDimID,kDimID,timeDimID,nDimID(10) + integer ::n, i + integer :: varID,dimVarID,nrecords,status real :: scale integer :: OUTtypeCDF !NetCDF code for type + real,allocatable, dimension(:) :: tmp select case(OUTtype) case(Int1 );OUTtypeCDF=nf90_byte @@ -1577,7 +1701,7 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize case(Real8);OUTtypeCDF=nf90_double case default call CheckStop(MasterProc,"NetCDF_ml: undefined datatype") - endselect + end select !define mode call check(nf90_redef(ncFileID),"file redef:"//trim(varname)) @@ -1590,7 +1714,7 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize case default call check(nf90_inq_dimid(ncFileID,"i" ,idimID),"dim:i") call check(nf90_inq_dimid(ncFileID,"j" ,jdimID),"dim:j") - endselect + end select status=nf90_inq_dimid(ncFileID,"k",kdimID) if(status/=nf90_noerr)& @@ -1599,25 +1723,60 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize call check(nf90_inq_dimid(ncFileID,"time",timeDimID),"dim:time") !define new variable: nf90_def_var(ncid,name,xtype,dimids,varid) - select case(ndim) - case(3) - call check(nf90_def_var(ncFileID,varname,OUTtypeCDF,& - [iDimID,jDimID,kDimID,timeDimID],varID),"def3d:"//trim(varname)) - case(2) - call check(nf90_def_var(ncFileID,varname,OUTtypeCDF,& - [iDimID,jDimID,timeDimID] ,varID),"def2d:"//trim(varname)) - case default - print *, 'createnewvariable: unexpected ndim ',ndim - call CheckStop(MasterProc,"NetCDF_ml: unexpected ndim") - endselect + if(.not.present(dimSizes))then + select case(ndim) + case(3) + call check(nf90_def_var(ncFileID,varname,OUTtypeCDF,& + [iDimID,jDimID,kDimID,timeDimID],varID),"def3d:"//trim(varname)) + case(2) + call check(nf90_def_var(ncFileID,varname,OUTtypeCDF,& + [iDimID,jDimID,timeDimID] ,varID),"def2d:"//trim(varname)) + case default + print *, 'createnewvariable: unexpected ndim ',ndim + call CheckStop(MasterProc,"NetCDF_ml: unexpected ndim") + end select + else + !define dimensions if needed + do n=1,ndim + status = nf90_inq_dimid(ncFileID,dimNames(n),ndimID(n)) + if(status/=nf90_noerr)then + !define new dimension + !write(*,*)'defining new dimension: '//trim(dimNames(n))//' for '//trim(varname) + call check(nf90_def_dim(ncFileID,trim(dimNames(n)),dimSizes(n),ndimID(n)),"dim:"//trim(dimNames(n))) + call check(nf90_def_var(ncFileID,trim(dimNames(n)),nf90_float,ndimID(n),dimvarID),"defvar:"//trim(dimNames(n))) + + !call check(nf90_enddef(ncFileID)) + allocate(tmp(dimSizes(n))) + do i=1,dimSizes(n) + if(trim(dimNames(n))=='x_dist'.or.trim(dimNames(n))=='y_dist')then + tmp(i)=i-(dimSizes(n)+1)/2 + else if(trim(dimNames(n))=='klevel')then + tmp(i)=KMAX_MID+i-dimSizes(n) + else + write(*,*)'ERROR: Dimension Name not recognized: '//trim(dimNames(n)) + endif + enddo + call check(nf90_put_var(ncFileID,dimVarID,tmp)) + deallocate(tmp) + !call check(nf90_redef(ncFileID),"file redef:"//trim(varname)) + write(*,*)'defining new dimension: '//trim(dimNames(n)),', size ',dimSizes(n) + endif + enddo + + ndimID(ndim+1)=timeDimID + call check(nf90_def_var(ncFileID,varname,OUTtypeCDF,& + ndimID(1:ndim+1),varID),"defnd:"//trim(varname)) + endif !define variable as to be compressed if(NETCDF_DEFLATE_LEVEL >= 0) then call check(nf90_def_var_deflate(ncFileid,varID,shuffle=0,deflate=1,& deflate_level=NETCDF_DEFLATE_LEVEL),"compress:"//trim(varname)) - if(present(chunksizes)) & ! set chunk-size for 2d slices of 3d output + if(present(chunksizes))then ! set chunk-size for 2d slices of 3d output + ! write(*,*)' chunksizes ',trim(varname),chunksizes call check(nf90_def_var_chunking(ncFileID,varID,NF90_CHUNKED,& chunksizes(:)),"chunk:"//trim(varname)) - endif + endif + end if ! FillValue=0. scale=1. !define attributes of new variable @@ -1629,9 +1788,11 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize case('lon lat') case('Rotated_Spherical') call check(nf90_put_att(ncFileID, varID, "grid_mapping", "Rotated_Spherical")) + case('lambert') + call check(nf90_put_att(ncFileID, varID, "grid_mapping", "projection_lambert")) case default call check(nf90_put_att(ncFileID, varID, "grid_mapping",Default_projection_name )) - endselect + end select nrecords=0 call check(nf90_put_att(ncFileID, varID, "numberofrecords", nrecords)) @@ -1653,13 +1814,13 @@ subroutine createnewvariable(ncFileID,varname,ndim,ndate,def1,OUTtype,chunksize call check(nf90_put_att(ncFileID,varID,"_FillValue",nf90_fill_float )) case(Real8) call check(nf90_put_att(ncFileID,varID,"_FillValue",nf90_fill_double)) - endselect + end select call check(nf90_put_att(ncFileID,varID,"current_date_first",ndate)) call check(nf90_put_att(ncFileID,varID,"current_date_last" ,ndate)) call check(nf90_enddef(ncFileID)) -endsubroutine createnewvariable +end subroutine createnewvariable !_______________________________________________________________________ subroutine CloseNetCDF @@ -1675,10 +1836,10 @@ subroutine CloseNetCDF if(ncFileID/=closedID)then call check(nf90_close(ncFileID)) ncFileID_iou(i)=closedID - endif - enddo - endif -endsubroutine CloseNetCDF + end if + end do + end if +end subroutine CloseNetCDF subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch,needed) ! open and reads CDF file @@ -1718,8 +1879,8 @@ subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch, write(*,*)trim(fileName),' not found (but not needed)' nfetch=0 return - endif - endif + end if + end if !get global attributes !example: @@ -1737,7 +1898,7 @@ subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch, nfetch=0 call CheckStop(fileneeded, "NetCDF_ml : variable needed but not found") return - endif + end if !get dimensions call check(nf90_Inquire_Variable(ncFileID,VarID,name,xtype,ndims,dimids,nAtts)) @@ -1747,24 +1908,24 @@ subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch, call check(nf90_inquire_dimension(ncFileID,dimids(i),len=dims(i))) totsize=totsize*dims(i) ! write(*,*)'size variable ',i,dims(i) - enddo + end do if(MasterProc.and.DEBUG_NETCDF)write(*,*)'dimensions ',(dims(i),i=1,ndims) if(dims(1)>varGIMAX.or.dims(2)>varGJMAX)then write(*,*)'buffer too small',dims(1),varGIMAX,dims(2),varGJMAX Call StopAll('GetCDF buffer too small') - endif + end if if(ndims>3.and.dims(3)>varKMAX)then if(me==0)write(*,*)'Warning: not reading all levels ',dims(3),varKMAX,trim(varname) ! Call StopAll('GetCDF not reading all levels') - endif + end if if(nstart+nfetch-1>dims(ndims))then write(*,*)'WARNING: did not find all data' nfetch=dims(ndims)-nstart+1 if(nfetch<=0)Call StopAll('GetCDF nfetch<0') - endif + end if startvec=1 startvec(ndims)=nstart @@ -1788,7 +1949,7 @@ subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch, do i=1,totsize Rvar(i)=Ivalues(i)*scalefactors(1)+scalefactors(2) - enddo + end do deallocate(Ivalues) case(NF90_FLOAT,NF90_DOUBLE) @@ -1798,13 +1959,13 @@ subroutine GetCDF(varname,fileName,Rvar,varGIMAX,varGJMAX,varKMAX,nstart,nfetch, case default write(*,*)'datatype not yet supported'!Char Call StopAll('GetCDF datatype not yet supported') - endselect + end select call check(nf90_close(ncFileID)) -endsubroutine GetCDF +end subroutine GetCDF subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& - i_start,j_start,imax_in,jmax_in,reverse_k,needed,found) + unit,validity,i_start,j_start,imax_in,jmax_in,reverse_k,needed,found) ! open and reads CDF file ! The grid MUST be in the same projection and resolution as the model grid ! the field are read directly into the subdomains @@ -1822,6 +1983,7 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& integer, intent(in) :: nstart,nfetch,k_start,k_end ! real, intent(out) :: Rvar(LIMAX,LJMAX,k_end-k_start+1,nfetch) real, intent(out) :: Rvar(*) + character(len=*), optional, intent(out) ::unit,validity integer, optional, intent(in) :: i_start,j_start,imax_in,jmax_in logical, optional, intent(in) :: reverse_k,needed logical, optional, intent(out):: found @@ -1830,7 +1992,7 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& integer :: status,ndims,alloc_err integer :: totsize,xtype,dimids(NF90_MAX_VAR_DIMS),nAtts,imax,jmax integer :: dims(NF90_MAX_VAR_DIMS),startvec(NF90_MAX_VAR_DIMS) - integer :: ncFileID,VarID,i,j,k,n,it,i1,j1,i0,j0,ijkn,ij,ijk,ijknR,jkn + integer :: ncFileID,VarID,i,j,k,n,it,i1,j1,i0,j0,ijkn,ijknR,jkn character(len=100)::name real :: scale,offset integer, allocatable:: Ivalues(:) @@ -1864,8 +2026,8 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& if(status/=nf90_noerr)then if(MasterProc) write(*,*)trim(fileName),' not found (but not needed)' return - endif - endif + end if + end if !test if the variable is defined and get varID: status=nf90_inq_varid(ncFileID,varname,VarID) @@ -1878,7 +2040,7 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& call CheckStop(fileneeded, "NetCDF_ml : variable needed but not found") call check(nf90_close(ncFileID)) return - endif + end if !get dimensions call check(nf90_Inquire_Variable(ncFileID,VarID,name,xtype,ndims,dimids,nAtts),& @@ -1886,7 +2048,7 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& dims=0 do i=1,ndims call check(nf90_inquire_dimension(ncFileID,dimids(i),len=dims(i)),"len:dimN") - enddo + end do if(DEBUG_NETCDF)write(*,*)'dimensions ',(dims(i),i=1,ndims) if(any(dims(1:2)/=[IIFULLDOM,JJFULLDOM]))then @@ -1895,18 +2057,18 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& ' has different dimensions than model grid: ',& dims(1:2),' instead of ',IIFULLDOM,JJFULLDOM call CheckStop(.not.present(i_start),'GetCDF_modelgrid: incompatible grid.& - & This routine does not interpolate. Give i_start, j_start') - endif + & This routine does not interpolate. Give i_start, j_start '//trim(fileName)) + end if if(ndims>3.and.dims(3)>k_end)then if(me==0)write(*,*)'Warning: not reading all levels ',dims(3),k_end,trim(varname) ! Call StopAll('GetCDF not reading all levels') - endif + end if if(nstart+nfetch-1>dims(ndims))then write(*,*)'WARNING: did not find all data' call CheckStop(dims(ndims)-nstart+1<=0,'GetCDF_modelgrid nfetch<0') - endif + end if startvec(:)=1 startvec(1)=max(1,i_fdom(1)+i0) @@ -1918,12 +2080,12 @@ subroutine GetCDF_modelgrid(varname,fileName,Rvar,k_start,k_end,nstart,nfetch,& dims(1)=imax else dims(1)=dims(1)-startvec(1)+1 - endif + end if if(startvec(2)+jmax-1null(), ww(:)=>null() integer, allocatable :: IIij(:,:,:),JJij(:,:,:) - real :: FillValue=0,Pcounted + real :: FillValue=0 real :: sumWeights integer, dimension(4) :: ijn - integer :: ii, jj,i_ext,j_ext,ic + integer :: ii, jj,i_ext,j_ext real::an_ext,xp_ext,yp_ext,fi_ext,ref_lat_ext,xp_ext_div,yp_ext_div,Grid_resolution_div,an_ext_div real ::buffer1(LIMAX, LJMAX),buffer2(LIMAX, LJMAX) real, allocatable ::fraction_in(:,:) integer, allocatable ::CC(:,:),Ncc(:) - real ::total,UnDef_local - integer ::N_out,Ng,Nmax,kstart_loc,kend_loc,lon_shift_Mask,startlat_Mask - logical :: Reverse_lat_direction_Mask + real :: UnDef_local + integer :: Nmax,kstart_loc,kend_loc,lon_shift_Mask,startlat_Mask + logical :: Reverse_lat_direction_Mask,ilast_corrected character(len=*),parameter :: field_not_found='field_not_found' + real :: latlon_weight + + real ::Rlonmin,Rlonmax,dRlon,dRloni,frac,frac_j,ir,jr + real ::Rlatmin,Rlatmax,dRlat,dRlati + integer, allocatable ::ifirst(:),ilast(:),jfirst(:),jlast(:) + real, allocatable :: fracfirstlon(:),fraclastlon(:),fracfirstlat(:),fraclastlat(:) !_______________________________________________________________________________ ! @@ -2259,7 +2447,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & debug = .false. if(present(debug_flag))then - debug = debug_flag .and. MasterProc + debug = debug_flag .and. me==0 if ( debug ) write(*,*) 'ReadCDF start: ',trim(filename),':', trim(varname) end if if(present(needed)) fileneeded=needed @@ -2283,14 +2471,14 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(present(validity))validity=field_not_found if(present(unit))unit=' ' return - endif - endif - endif + end if + end if + end if interpol_used='zero_order'!default if(present(interpol))then interpol_used=interpol - endif + end if call CheckStop(interpol_used/='zero_order'.and.& interpol_used/='conservative'.and.& interpol_used/='mass_conservative',& @@ -2320,25 +2508,25 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(present(validity))validity=field_not_found if(present(unit))unit=' ' return - endif - endif + end if + end if if(present(unit))then !find unit unit=' ' status = nf90_get_att(ncFileID, VarID, "units", unit ) if(status /= nf90_noerr)then unit='unknown' !default - endif - endif + end if + end if if(present(validity))then ! status = nf90_get_att(ncFileID, VarID, "validity", validity) if(status /= nf90_noerr)then status = nf90_get_att(ncFileID, VarID, "period_of_validity",validity) if(status /= nf90_noerr)then validity='instantaneous' !default - endif - endif - endif + end if + end if + end if fractions=.false. if(present(fractions_out))fractions=.true. @@ -2352,16 +2540,22 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & kend_loc=kend data3D=.true. - endif + end if !Check first that variable has data covering the relevant part of the grid: !Find chunk of data required (local) - maxlon=max(maxval(gl_stagg),maxval(glon)) - minlon=min(minval(gl_stagg),minval(glon)) - maxlat=max(maxval(gb_stagg),maxval(glat)) - minlat=min(minval(gb_stagg),minval(glat)) - + if(projection=="lon lat")then + maxlon=maxval(glon)+0.5*(glon(2,1)-glon(1,1)) + minlon=minval(glon)-0.5*(glon(2,1)-glon(1,1)) + maxlat=maxval(glat)+0.5*(glat(1,2)-glat(1,1)) + minlat=minval(glat)-0.5*(glat(1,2)-glat(1,1)) + else + maxlon=max(maxval(gl_stagg),maxval(glon)) + minlon=min(minval(gl_stagg),minval(glon)) + maxlat=max(maxval(gb_stagg),maxval(glat)) + minlat=min(minval(gb_stagg),minval(glat)) + endif !Read the extension of the data in the file (if available) status = nf90_get_att(ncFileID, VarID, "minlat", minlat_var ) if(status == nf90_noerr)then @@ -2380,7 +2574,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if ( debug ) write(*,*) 'data out of maxlat range ',maxlat if(.not. present(ncFileID_given))call check(nf90_close(ncFileID)) return - endif + end if status = nf90_get_att(ncFileID, VarID, "maxlat", maxlat_var ) if(status == nf90_noerr)then if ( debug ) write(*,*) 'maxlat attribute found: ',maxlat_var @@ -2390,8 +2584,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if ( debug ) write(*,*) 'data out of minlat range ',minlat if(.not. present(ncFileID_given))call check(nf90_close(ncFileID)) return - endif - endif + end if + end if status = nf90_get_att(ncFileID, VarID, "minlon", minlon_var ) if(status == nf90_noerr)then if ( debug ) write(*,*) 'minlon attribute found: ',minlon_var @@ -2401,8 +2595,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if ( debug ) write(*,*) 'data out of minlon range ',minlon if(.not. present(ncFileID_given))call check(nf90_close(ncFileID)) return - endif - endif + end if + end if status = nf90_get_att(ncFileID, VarID, "maxlon", maxlon_var ) if(status == nf90_noerr)then if ( debug ) write(*,*) 'maxlon attribute found: ',maxlon_var @@ -2412,12 +2606,12 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if ( debug ) write(*,*) 'data out of maxlon range ',maxlon if(.not. present(ncFileID_given))call check(nf90_close(ncFileID)) return - endif - endif + end if + end if else !dont expect to find maxlat,minlon or maxlat, therfore don't check if ( debug ) write(*,*) 'minlat attribute not found for ',trim(varname) - endif + end if !get dimensions id call check(nf90_Inquire_Variable(ncFileID,VarID,name,& @@ -2445,10 +2639,10 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & case(NF90_FLOAT );FillValue=NF90_FILL_FLOAT ! case(NF90_REAL );FillValue=NF90_FILL_REAL ! same as FLOAT case(NF90_DOUBLE);FillValue=NF90_FILL_DOUBLE - endselect + end select if( debug ) write(*,*) 'FillValue not found, using ',FillValue - endif - endif + end if + end if !get dimensions startvec=1 @@ -2457,7 +2651,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & call check(nf90_inquire_dimension(ncid=ncFileID, dimID=dimids(i), & len=dims(i)),"GetDims") if ( debug ) write(*,*) 'ReadCDF size variable ',i,dims(i) - enddo + end do if( present(known_projection) ) then data_projection = trim(known_projection) @@ -2480,7 +2674,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & allocate(Rlon(dims(1)*dims(2)), stat=alloc_err) allocate(Rlat(dims(1)*dims(2)), stat=alloc_err) if ( debug ) write(*,*) 'data allocElse ',trim(data_projection), alloc_err, trim(fileName) - endif + end if used_lat_name = 'lat'!default used_lon_name = 'lon'!default @@ -2494,9 +2688,9 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(status /= nf90_noerr) then status=nf90_inq_varid(ncid = ncFileID, name = 'longitude', varID = lonVarID) call CheckStop(status /= nf90_noerr,'did not find longitude variable') - endif - endif - call check(nf90_Inquire_Variable(ncid = ncFileID, varID = lonVarID,xtype=xtype_lon)) + end if + end if + call check(nf90_Inquire_Variable(ncid = ncFileID, varID = lonVarID,xtype=xtype_lon)) status=nf90_inq_varid(ncid = ncFileID, name=trim(used_lat_name), varID = latVarID) if(status /= nf90_noerr) then @@ -2504,8 +2698,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(status /= nf90_noerr) then status=nf90_inq_varid(ncid = ncFileID, name = 'latitude', varID = latVarID) call CheckStop(status /= nf90_noerr,'did not find latitude variable') - endif - endif + end if + end if call check(nf90_Inquire_Variable(ncid = ncFileID, varID = latVarID,xtype=xtype_lat)) if(trim(data_projection)=="lon lat")then @@ -2514,7 +2708,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & else call check(nf90_get_var(ncFileID, lonVarID, Rlon,start=(/1,1/),count=(/dims(1),dims(2)/))) call check(nf90_get_var(ncFileID, latVarID, Rlat,start=(/1,1/),count=(/dims(1),dims(2)/))) - endif + end if if(xtype_lon==NF90_INT.or.xtype_lon==NF90_SHORT.or.xtype_lon==NF90_BYTE)then !scale data if it is packed scalefactors(1) = 1.0 !default @@ -2524,7 +2718,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & status = nf90_get_att(ncFileID, lonVarID, "add_offset", offset ) if(status == nf90_noerr) scalefactors(2) = offset Rlon=Rlon*scalefactors(1)+scalefactors(2) - endif + end if if(xtype_lat==NF90_INT.or.xtype_lat==NF90_SHORT.or.xtype_lat==NF90_BYTE)then !scale data if it is packed scalefactors(1) = 1.0 !default @@ -2534,14 +2728,14 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & status = nf90_get_att(ncFileID, latVarID, "add_offset", offset ) if(status == nf90_noerr) scalefactors(2) = offset Rlat=Rlat*scalefactors(1)+scalefactors(2) - endif + end if if(present(stagg))then !use staggered grid if(stagg=='stagg_u')then if(trim(data_projection)=="lon lat")then do i=1,dims(1)-1 Rlon(i)=(Rlon(i)+Rlon(i+1))*0.5 - enddo + end do Rlon(dims(1))=Rlon(dims(1))+(Rlon(dims(1))-Rlon(dims(1)-1))*0.5 else !not tested @@ -2550,17 +2744,17 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & ij=i+(j-1)*dims(1) Rlon(ij)=(Rlon(ij)+Rlon(ij+1))*0.5 Rlat(ij)=(Rlat(ij)+Rlat(ij+1))*0.5 - enddo + end do ij=dims(1)+(j-1)*dims(1) Rlon(ij)=Rlon(ij)+(Rlon(ij)-Rlon(ij-1))*0.5 Rlat(ij)=Rlat(ij)+(Rlat(ij)-Rlat(ij-1))*0.5 - enddo - endif + end do + end if elseif(stagg=='stagg_v')then if(trim(data_projection)=="lon lat")then do j=1,dims(2)-1 Rlat(j)=(Rlat(j)+Rlat(j+1))*0.5 - enddo + end do Rlat(dims(2))=Rlat(dims(2))+(Rlat(dims(2))-Rlat(dims(2)-1))*0.5 else !not tested @@ -2569,22 +2763,23 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & ij=i+(j-1)*dims(1) Rlon(ij)=(Rlon(ij)+Rlon(ij+dims(1)))*0.5 Rlat(ij)=(Rlat(ij)+Rlat(ij+dims(1)))*0.5 - enddo - enddo + end do + end do do i=1,dims(1) ij=i+(dims(2)-1)*dims(1) Rlon(ij)=Rlon(ij)+(Rlon(ij)-Rlon(ij-dims(1)))*0.5 Rlat(ij)=Rlat(ij)+(Rlat(ij)-Rlat(ij-dims(1)))*0.5 - enddo - endif + end do + end if else call StopAll("ReadField_CDF: stagg not recognized") - endif - endif + end if + end if !Should define longitude in the range [-180, 180] do ij=1,size(Rlon) if(Rlon(ij)>180)Rlon(ij)=Rlon(ij)-360.0 - enddo + if(Rlon(ij)<-180)Rlon(ij)=Rlon(ij)+360.0 + end do if ( debug ) write(*,*) 'ReadCDF lon bounds',minval(Rlon),maxval(Rlon) if ( debug ) write(*,*) 'ReadCDF lat bounds',minval(Rlat),maxval(Rlat) @@ -2598,7 +2793,12 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & N=1 if(present(NMask_Code))N=NMask_Code if(N>0)then!otherwise no need to do anything! - call check(nf90_open(path = trim(Mask_fileName), mode = nf90_nowrite, ncid = ncFileID_Mask)) + status=nf90_open(path = trim(Mask_fileName), mode = nf90_nowrite, ncid = ncFileID_Mask) + if(status /= nf90_noerr) then + write(*,*)'MASK file does not exist: ',trim(Mask_fileName),nf90_strerror(status) + write(*,*)'Check the call for monthly emis in Emissions_ml.f90' + call StopAll("ReadField_CDF : Mask file needed but not found") + endif !verify that x, y dimensions have same size call check(nf90_inq_varid(ncid = ncFileID_Mask, name = trim(Mask_varname), varID = VarID_Mask),"Var_Mask") call check(nf90_Inquire_Variable(ncFileID_Mask,VarID_Mask,name,xtype_Mask,ndims_Mask,dimids_Mask,nAtts),"GetDimsId_Mask") @@ -2609,14 +2809,14 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & write(*,*)'Sizes '//trim(fileName),dims(1),dims(2) write(*,*)'Sizes '//trim(Mask_fileName),isize,jsize call StopAll("ReadField_CDF: Incompatible file sizes") - endif + end if if(ndims_Mask/=2)then call StopAll("ReadField_CDF: only 2 dimensional mask implemented") - endif + end if else if (debug)write(*,*) 'ReadCDF MASK: no need to reduce anything for ', trim(varname) - endif - endif + end if + end if !_______________________________________________________________________________ ! @@ -2637,64 +2837,73 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(data3D)then call check(nf90_inquire_dimension(ncid = ncFileID, dimID = dimids(3), name=name )) - call CheckStop(trim(name)/='k'.and.trim(name)/='N'.and.trim(name)/='lev'.and.trim(name)/='height',"vertical coordinate (k, lev, N or height) not found") - endif + call CheckStop(name/='k'.and.name/='N'.and.name/='lev'.and.name/='height',& + "vertical coordinate (k, lev, N or height) not found") + end if !NB: we assume regular grid !inverse of resolution - dloni=1.0/(Rlon(2)-Rlon(1)) - dlati=1.0/(Rlat(2)-Rlat(1)) + dRloni=1.0/(Rlon(2)-Rlon(1)) + dRlati=1.0/(Rlat(2)-Rlat(1)) Grid_resolution = EARTH_RADIUS*abs(Rlat(2)-Rlat(1))*PI/180.0 + Grid_resolution_lon = EARTH_RADIUS*abs(Rlon(2)-Rlon(1))*PI/180.0!NB: varies with latitude !the method chosen depends on the relative resolutions if(.not.present(interpol).and.Grid_resolution/GRIDWIDTH_M>4)then interpol_used='zero_order'!usually good enough, and keeps gradients - endif + end if if ( debug ) write(*,*) 'interpol_used: ',interpol_used if(debug) then write(*,*) "SET Grid resolution:" // trim(fileName), Grid_resolution write(*,"(a,6f8.2,2x,4f8.2)") 'ReadCDF LL values ',& - Rlon(2),Rlon(1),dloni, Rlat(2),Rlat(1), dlati, & + Rlon(2),Rlon(1),dRloni, Rlat(2),Rlat(1), dRlati, & maxlon, minlon, maxlat, minlat end if if(mod(nint(100.*(Rlon(dims(1))+(Rlon(2)-Rlon(1))-Rlon(1))),36000)/=0)then + if(MasterProc.and.debug)write(*,*)'Grid does not cover 360 degrees ', Rlon(1),Rlon(dims(1)) !the grid does not cover 360 degrees - if(MasterProc.and.debug)write(*,*)'Grid does not cover 360 degrees ', Rlon(1),Rlon(dims(1)) - imin=1!cover everything available - imax=dims(1)!cover everything available - else if(dloni>0)then - !floor((minlon-Rlon(1))*dloni)<=number of gridcells between minlon and Rlon(1) - !mod(floor((minlon-Rlon(1))*dloni)+dims(1),dims(1))+1 = get a number in [1,dims(1)] - imin=mod( floor((minlon-Rlon(1))*dloni)+dims(1),dims(1))+1!NB lon -90 = +270 - imax=mod(ceiling((maxlon-Rlon(1))*dloni)+dims(1),dims(1))+1!NB lon -90 = +270 + if(Rlon(1)>Rlon(dims(1)))then + if(MasterProc.and.debug)write(*,*)'Longitudes not monotonic ', Rlon(1),Rlon(dims(1)) + imin=1!cover everything available + imax=dims(1)!cover everything available + else + imin=max(1,floor((minlon-Rlon(1))*dRloni-0.001))+1 + imax=min(dims(1),ceiling((maxlon-Rlon(1))*dRloni+1.001)) + endif + else if(dRloni>0)then + !floor((minlon-Rlon(1))*dRloni)<=number of gridcells between minlon and Rlon(1) + !mod(floor((minlon-Rlon(1))*dRloni)+dims(1),dims(1))+1 = get a number in [1,dims(1)] + imin=mod( floor((minlon-Rlon(1))*dRloni)+dims(1),dims(1))+1!NB lon -90 = +270 + imax=mod(ceiling((maxlon-Rlon(1))*dRloni)+dims(1),dims(1))+1!NB lon -90 = +270 if(imax==1)imax=dims(1)!covered entire circle if(minlon-Rlon(1)<0.0)then imin=1!cover entire circle imax=dims(1)!cover entire circle - endif + end if else - call CheckStop("Not tested: negativ dloni") - imin=mod(floor((maxlon-Rlon(1))*dloni)+dims(1),dims(1))+1!NB lon -90 = +270 - imax=mod(ceiling((minlon-Rlon(1))*dloni)+dims(1),dims(1))+1!NB lon -90 = +270 + call CheckStop("Not tested: negativ dRloni") + imin=mod(floor((maxlon-Rlon(1))*dRloni)+dims(1),dims(1))+1!NB lon -90 = +270 + imax=mod(ceiling((minlon-Rlon(1))*dRloni)+dims(1),dims(1))+1!NB lon -90 = +270 if(imax==1)imax=dims(1)!covered entire circle - endif + end if - if(dlati>0)then - jmin=max(1,min(dims(2),floor((minlat-Rlat(1))*dlati))) - jmax=max(1,min(dims(2),ceiling((maxlat-Rlat(1))*dlati)+1)) + if(dRlati>0)then + jmin=max(1,min(dims(2),floor((minlat-Rlat(1))*dRlati))) + jmax=max(1,min(dims(2),ceiling((maxlat-Rlat(1))*dRlati)+1)) else!if starting to count from north pole - jmin=max(1,min(dims(2),floor((maxlat-Rlat(1))*dlati)))!maxlat is closest to Rlat(1) - jmax=max(1,min(dims(2),ceiling((minlat-Rlat(1))*dlati)+1)) - endif + jmin=max(1,min(dims(2),floor((maxlat-Rlat(1))*dRlati)))!maxlat is closest to Rlat(1) + jmax=max(1,min(dims(2),ceiling((minlat-Rlat(1))*dRlati)+1)) + end if - if(maxlat>85.0.or.minlat<-85.0)then + if(maxlat>85.0.or.minlat<-85.0 .and. & + ((.not.(projection=='lon lat')) .or. (.not.data_projection=='lon lat')))then !close to poles imin=1 imax=dims(1) - endif + end if !latitude is sometime counted from north pole, sometimes from southpole: jjmin=jmin @@ -2706,7 +2915,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & !take everything...could be memory expensive imin=1 imax=dims(1) - endif + end if if ( debug ) write(*,"(a,4f8.2,6i8)") 'ReadCDF minmax values ',& minlon,maxlon,minlat,maxlat,imin,imax,jmin,jmax @@ -2727,16 +2936,16 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & ! call CheckStop(size(Rvar)3)startvec(ndims)=nstart - endif + end if totsize=1 do i=1,ndims totsize=totsize*dims(i) - enddo + end do allocate(Rvalues(totsize), stat=alloc_err) if ( debug ) then @@ -2760,19 +2969,20 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & status=nf90_get_var(ncFileID_Mask, dimids_Mask(2), lat_mask) if(status==nf90_noerr.and.(lat_mask(2)-lat_mask(1))*(Rlat(2)-Rlat(1))<0)then Reverse_lat_direction_Mask=.true. - if ( debug ) write(*,*) 'ReadCDF mask: reverting latitude direction' + if(debug) write(*,*)'ReadCDF mask: reverting latitude direction' else - if (debug) write(*,*) 'ReadCDF mask: not reverting latitude direction',(lat_mask(2)-lat_mask(1))*(Rlat(2)-Rlat(1)),status==nf90_noerr - endif + if(debug) write(*,*)'ReadCDF mask: not reverting latitude direction',& + (lat_mask(2)-lat_mask(1))*(Rlat(2)-Rlat(1)),status==nf90_noerr + end if lon_shift_Mask=0 status=nf90_get_var(ncFileID_Mask, dimids_Mask(1), lon_mask) if(status==nf90_noerr)then - lon_shift_Mask=nint((Rlon(1)-lon_mask(1))*dloni) + lon_shift_Mask=nint((Rlon(1)-lon_mask(1))*dRloni) if(lon_shift_Mask/=0)then write(*,*)'ReadCDF mask: should shifting longitude by ',lon_shift_Mask,'=',Rlon(1)-lon_mask(1),'degrees' call StopAll("Longitude shift for Mask not implemented") - endif - endif + end if + end if startlat_Mask=startvec(2) if(Reverse_lat_direction_Mask)startlat_Mask=jsize-startvec(2)-dims(2)+2 call check(nf90_get_var(ncFileID_Mask, VarID_Mask, Mask_values,& @@ -2793,8 +3003,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if( any(Mask_Code(1:N)==Mask_values(ijm)))then Rvalues(i)=Rvalues(i)*factor j=j+1 - endif - enddo + end if + end do if ( debug )write(*,*)'reduced ',j,' values by ',factor else factor=1.0 @@ -2802,12 +3012,12 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if ( debug ) write(*,*)'multiplying values by ',factor,'and Mask ' do i=1,totsize Rvalues(i)=Rvalues(i)*Mask_values(i)*factor - enddo - endif + end do + end if if(.not. present(ncFileID_given))call check(nf90_close(ncFileID_Mask)) deallocate(Mask_values,lon_mask,lat_mask) - endif - endif + end if + end if !test if this is "fractions" type data @@ -2850,19 +3060,19 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & call check(nf90_get_var(ncFileID, VarIDfrac,fraction_in ,start=Nstartvec,count=NCdims),& errmsg="fractions") - if( debug )then - ! write(*,*)'More than 2 countries:' - ! do i=1,dims(1)*dims(2) - ! if(NCC(i)>2)write(*,77)me,i,NCC(i),CC(i,1),fraction_in(i,1),CC(i,NCC(i)),fraction_in(i,NCC(i)) -77 format(3I7,2(I5,F6.3)) - ! enddo - endif +! if( debug )then +! write(*,*)'More than 2 countries:' +! do i=1,dims(1)*dims(2) +! if(NCC(i)>2)write(*,77)me,i,NCC(i),CC(i,1),fraction_in(i,1),CC(i,NCC(i)),fraction_in(i,NCC(i)) +!77 format(3I7,2(I5,F6.3)) +! end do +! end if Ncc_out(1:LIMAX*LJMAX)=0 CC_out(1:LIMAX*LJMAX,1:Nmax)=0 fractions_out(1:LIMAX*LJMAX,1)=0.0 fractions_out(1:LIMAX*LJMAX,2:Nmax)=0.0 - endif + end if if ( DEBUG_NETCDF_RF ) write(*,*) 'ReadCDF types ', & @@ -2885,22 +3095,226 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & end if else ! Real if ( debug )write(*,*)' xtype real ',xtype - endif + end if if(interpol_used=='conservative'.or.interpol_used=='mass_conservative')then + + if(projection=='lon lat')then + !exact integrals assuming uniform emission over emitter gridcells + if(.not.allocated(fracfirstlon))then + allocate(fracfirstlon(dims(1)),fraclastlon(dims(1)),ifirst(dims(1)),ilast(dims(1))) + allocate(fracfirstlat(dims(2)),fraclastlat(dims(2)),jfirst(dims(2)),jlast(dims(2))) + endif + !precompute factors 1-dimensionally + dRlon = Rlon(2)-Rlon(1) + if(dRlon<0)dRlon = dRlon+360.0 + dRloni=1.0/dRlon + dlon=glon(2,1)-glon(1,1) + if(dlon<0)dlon = dlon+360.0 + dloni=1.0/dlon + dRlat = Rlat(2)-Rlat(1) + dRlati=1.0/dRlat + dlat=glat(1,2)-glat(1,1) + dlati=1.0/dlat + + do ig=1,dims(1) + !longitude of edges + Rlonmin = Rlon(ig+imin-1) - 0.5*dRlon + Rlonmax = Rlonmin + dRlon + !find all cells with at least some part in emitter cell ig + call lb2ij(Rlonmin,0.0,ir,jr) + ifirst(ig)=floor(ir+0.5+1.E-6)!first i to be treated + call lb2ij(Rlonmax,0.0,ir,jr) + ilast(ig)=floor(ir+0.5-1.E-6)!last i to be treated + + !end of the world tests + if(ilast(ig)>= ifirst(ig))then + !no problems with monotonicity + else + !Problems: we cross the point where lon+eps=lon-360 + !several cases according to which points are in the subdomain + ilast_corrected=.false. + if(ifirst(ig)>=rundomain(1) .and. ifirst(ig)<=rundomain(2))then + !inside rundomain + if(i_local(ifirst(ig))>=1 .and. i_local(ifirst(ig))<=limax)then + !inside subdomain. ilast(ig) is wrong, set it at the end of subdomain + ilast(ig)=i_fdom(limax) + !we are done with correction + ilast_corrected=.true. + endif + endif + if((.not. ilast_corrected) .and. ilast(ig)>=rundomain(1) .and. ilast(ig)<=rundomain(2))then + !inside rundomain + if(i_local(ilast(ig))>=1 .and. i_local(ilast(ig))<=limax)then + !inside subdomain. ifirst(ig) is wrong, set it at the start of subdomain + ifirst(ig)=i_fdom(1) + endif + endif + if(ilast(ig)< ifirst(ig))then + !none of them are in subdomain. nothing to do + ilast(ig)=ifirst(ig)-1 + cycle + endif + endif + + if((ifirst(ig)>rundomain(2) .or. ilast(ig)limax .or. ilast(ig)<1) )then + !outside subdomain. no need to spend time with this ig + ilast(ig)=ifirst(ig)-1 + cycle + endif + + + !make fraction of overlap. Only first or last i can overlap. 1*dloni means 100% of the incoming data is taken. + !put all incoming longitudes in the range 0-360 +! fracfirstlon(ig) = min(1.0, mod(360.0 + mod(glon(ifirst(ig),1)+360.0,360.0)+ 0.5*dlon - mod(Rlonmin+360.0,360.0),360.0)*dloni) + fracfirstlon(ig) = mod(360.0 + mod(glon(ifirst(ig),1)+360.0,360.0)& + + 0.5*dlon - mod(Rlonmin+360.0,360.0),360.0)*dloni + if(fracfirstlon(ig)<0.0 .or. fracfirstlon(ig)>10.0)then + fracfirstlon(ig)=0.0!numerical noise in glon? + endif + fracfirstlon(ig)=min(1.0,fracfirstlon(ig)) + +! fraclastlon(ig) = min(1.0, mod(360.0 + mod(Rlonmax+360.0,360.0) - (mod(glon(ilast(ig),1)+360.0,360.0) - 0.5*dlon),360.0)*dloni) + fraclastlon(ig) = mod(360.0 + mod(Rlonmax+360.0,360.0) & + - (mod(glon(ilast(ig),1)+360.0,360.0) - 0.5*dlon),360.0)*dloni + if(fraclastlon(ig)<0.0 .or. fraclastlon(ig)>10.0)then + fraclastlon(ig)=0.0!numerical noise + endif + fraclastlon(ig)=min(1.0,fraclastlon(ig)) + + !NB: when reducing on both sides need to ADD reductions not multiply + if(ifirst(ig)==ilast(ig))fraclastlon(ig) = fraclastlon(ig) -(1.0-fracfirstlon(ig))!include reduction from both sides + if(fraclastlon(ig)<0.0 .or. fraclastlon(ig)>10.0)then + fraclastlon(ig)=0.0!numerical noise + endif + + if(fracfirstlon(ig)<0.0)write(*,*)'ERROR A in interpolation',me,ig,fracfirstlon(ig) + if(fraclastlon(ig)<0.0)write(*,*)'ERROR B in interpolation',me,ig,fraclastlon(ig) +!631 format(I4,A,F10.4,A,F10.4,A,I4,A,F10.4,A,I4,A,F10.4,A,F10.4) +! if(me==19 .and. (ig==-3 .or. abs(Rlat(ig))<-89.0 ))write(*,631)ig,' start '//trim(varname),Rlonmin,' end',Rlonmax,' firsti',ifirst(ig),'lon ',glon(ifirst(ig),1),'last i',ilast(ig),'frac ',fracfirstlon(ig),' and ',fraclastlon(ig) + enddo + + !make factors for j + do jg=1,dims(2) + !latitude of edges. NB:Rlat is over fullgrid, while jg is in restricted grid + + Rlatmin = Rlat(jg+jmin-1) - 0.5*abs(dRlat) + Rlatmax = Rlatmin + abs(dRlat) + !find all cells with at least some part in emitter cell jg + call lb2ij(0.0,Rlatmin,ir,jr) + jfirst(jg)=floor(jr+0.5+1.E-6)!first j to be treated + call lb2ij(0.0,Rlatmax,ir,jr) + jlast(jg)=floor(jr+0.5-1.E-6)!last j to be treated + !write(*,*)trim(varname)//' ',me,jg,jfirst(jg),Rlatmin,Rlatmax,jr,dims(2) + if(jfirst(jg)>rundomain(4) .or. jlast(jg)ljmax .or. jlast(jg)<1)then + !no need to spend time with this jg + jlast(jg)=jfirst(jg)-1 + cycle + endif + + fracfirstlat(jg) = min(1.0,(glat(1,jfirst(jg))+ 0.5*dlat - Rlatmin)*dlati) + fraclastlat(jg) = min(1.0,(Rlatmax - (glat(1,jlast(jg)) - 0.5*dlat))*dlati) + fracfirstlat(jg) = max(0.0,fracfirstlat(jg)) + fraclastlat(jg) = max(0.0,fraclastlat(jg)) + if(jfirst(jg)==jlast(jg))fraclastlat(jg) = fraclastlat(jg) -(1.0-fracfirstlat(jg))!include reduction from both sides + + enddo + K2=1 + if(data3D)k2=kend_loc-kstart_loc+1 + ijk=LIMAX*LJMAX*k2 + Rvar(1:ijk)=0.0 + + idiv=0 + do jg=1,dims(2) + do j=jfirst(jg),jlast(jg) + if(j>=1.and.j<=ljmax)then + if(interpol_used=='mass_conservative')then + !scale for gridcell size differences + + frac = abs(dRlati*dRloni*dlat*dlon)!Divide by number of model cell in readin cell + else + !will give average value (emissions in kg/m2 for instance) + frac = 1.0 + endif + frac_j = frac + + if(j==jfirst(jg))frac_j=frac*fracfirstlat(jg) + if(j==jlast(jg))frac_j=frac*fraclastlat(jg)!fracfirstlat not used! + + do ig=1,dims(1) + igjg=ig+(jg-1)*dims(1) + + do i=ifirst(ig),ilast(ig) + if(i>=1.and.i<=limax)then + + frac = frac_j + if(i==ifirst(ig))frac=frac_j*fracfirstlon(ig) + if(i==ilast(ig))frac=frac_j*fraclastlon(ig)!fracfirstlon not used! + + ij=i+(j-1)*LIMAX + k2=1 + if(data3D)k2=kend_loc-kstart_loc+1 + do k=1,k2 + ijk=k+(ij-1)*k2 + igjgk=igjg+(k-1)*dims(1)*dims(2) + + if(fractions)then + call readfrac(Ncc(igjgk),CC,Rvalues(igjgk),fraction_in,fractions_out,Ncc_out,CC_out,& + Rvar(ijk),dims(1)*dims(2),igjgk,ijk,frac,Reduc) + + elseif(OnlyDefinedValues.or.Rvalues(igjgk)/=FillValue)then + Rvar(ijk)=Rvar(ijk)+Rvalues(igjgk)*frac + else + !Not defined: don't include this Rvalue + Rvar(ijk) = UnDef_local + end if + end do + end if + enddo + enddo + endif + enddo + + enddo + + deallocate(fracfirstlon,fraclastlon,ifirst,ilast) + deallocate(fracfirstlat,fraclastlat,jfirst,jlast) + + else + !conserves integral (almost, does not take into account local differences in mapping factor) !takes weighted average over gridcells covered by model gridcell !divide the coarse grid into pieces significantly smaller than the fine grid !Divide each global gridcell into Ndiv x Ndiv pieces Ndiv=nint(5*Grid_resolution/GRIDWIDTH_M) +! if(interpol_used=='conservative')Ndiv=nint(2*Grid_resolution/GRIDWIDTH_M)!Will be smooth anyway Ndiv=max(1,Ndiv) Ndiv2=Ndiv*Ndiv + Ndiv_lon=nint(5*Grid_resolution_lon/GRIDWIDTH_M) + Ndiv_lon=max(1,Ndiv_lon) + Ndiv2=Ndiv_lon*Ndiv ! - if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical')then + if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical'.and.projection/='lambert')then !the method should be revised or used only occasionally if(me==0)write(*,*)'WARNING: interpolation method may be CPU demanding' - endif + end if k2=1 if(data3D)k2=kend_loc-kstart_loc+1 allocate(Ivalues(LIMAX*LJMAX*k2)) @@ -2909,15 +3323,15 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & Ivalues(ij)=0 NValues(ij) = 0 Rvar(ij)=0.0 - enddo + end do do jg=1,dims(2) do jdiv=1,Ndiv - lat=Rlat(startvec(2)-1+jg)-0.5/dlati+(jdiv-0.5)/(dlati*Ndiv) + lat=Rlat(startvec(2)-1+jg)-0.5/dRlati+(jdiv-0.5)/(dRlati*Ndiv) do ig=1,dims(1) igjg=ig+(jg-1)*dims(1) - do idiv=1,Ndiv - lon=Rlon(startvec(1)-1+ig)-0.5/dloni+(idiv-0.5)/(dloni*Ndiv) + do idiv=1,Ndiv_lon + lon=Rlon(startvec(1)-1+ig)-0.5/dRloni+(idiv-0.5)/(dRloni*Ndiv_lon) call lb2ij(lon,lat,i,j) i=i-gi0-IRUNBEG+2 j=j-gj0-JRUNBEG+2 @@ -2931,67 +3345,26 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & Ivalues(ijk)=Ivalues(ijk)+1 Nvalues(ijk)=Nvalues(ijk)+1 igjgk=igjg+(k-1)*dims(1)*dims(2) - + latlon_weight=1.0 + if(fractions)then - do Ng=1,Ncc(igjgk)!number of fields at igjg as read - do N_out=1,Ncc_out(ijk) !number of fields at ij already saved in the model grid - if(CC(igjgk,Ng)==CC_out(ijk,N_out))goto 731 - enddo - !the country is not yet used for this gridcell. Define it now - Ncc_out(ijk)=Ncc_out(ijk)+1 - N_out=Ncc_out(ijk) - CC_out(ijk, N_out)=CC(igjgk,Ng) - fractions_out(ijk,N_out)=0.0 -731 continue - factor=1.0!default reduction factor - !if(present(Reduc).and.CC(igjgk,Ng)>0.and.CC(igjgk,Ng)<=NLAND)factor=Reduc(CC(igjgk,Ng)) - if(present(Reduc).and.CC(igjgk,Ng)>0)then - ic=find_index(CC(igjgk,Ng),Country(:)%icode) - if(ic>NLAND.or.ic<1)then - write(*,*)"ReadField_cdf: COUNTRY CODE NOT RECOGNIZED OR UNDEFINED: ",& - CC(igjgk,Ng) - call StopAll("COUNTRY CODE NOT RECOGNIZED ") - endif - factor=Reduc(ic) - endif - !update fractions - total=Rvar(ijk)+Rvalues(igjgk)*fraction_in(igjgk,Ng)*factor - if(debug.and.fraction_in(igjgk,Ng)>1.001)then - write(*,*)'fractions_in TOO LARGE ',Ng,ig,jg,k,fraction_in(igjgk,Ng) - stop - endif - if(abs(total)>1.0E-30)then - do N=1,Ncc_out(ijk) - !reduce previously defined fractions - fractions_out(ijk,N)=fractions_out(ijk,N)*Rvar(ijk)/total - enddo - !increase fraction of this country (yes, after having reduced it!) - fractions_out(ijk,N_out)=fractions_out(ijk,N_out)+Rvalues(igjgk)*fraction_in(igjgk,Ng)/total*factor - else - !should try to keep proportions right in case cancellation of positive an negative; not finished! - do N=1,Ncc_out(ijk) - !reduce existing fractions - fractions_out(ijk,N)=fractions_out(ijk,N)/Ncc_out(ijk) - enddo - !increase fraction of this country (yes, after having reduced it!) - fractions_out(ijk,N_out)=fractions_out(ijk,N_out)+Rvalues(igjgk)*fraction_in(igjgk,Ng)/Ncc_out(ijk)*factor - endif - Rvar(ijk)=total - enddo + call readfrac(Ncc(igjgk),CC,Rvalues(igjgk),& + fraction_in,fractions_out,Ncc_out,CC_out,& + Rvar(ijk),dims(1)*dims(2),igjgk,ijk,& + latlon_weight,Reduc) elseif(OnlyDefinedValues.or.Rvalues(igjgk)/=FillValue)then Rvar(ijk)=Rvar(ijk)+Rvalues(igjgk) else !Not defined: don't include this Rvalue - Ivalues(ijk)=Ivalues(ijk)-1 - - endif - enddo - - endif - enddo - enddo - enddo - enddo + Ivalues(ijk)=Ivalues(ijk)-1 + end if + end do + + end if + end do + end do + end do + end do k2=1 if(data3D)k2=kend_loc-kstart_loc+1 @@ -3011,11 +3384,12 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & 'ERROR, NetCDF_ml no values found here ! ', & trim(fileName) // ":" // trim(varname), & i,j,k,me,minlon,maxlon,minlat,maxlat,glon(i,j),glat(i,j), & - Ivalues(ijk),Ndiv,Rlon(startvec(1)),Rlon(startvec(1)+dims(1)-1),Rlat(startvec(2)),Rlat(startvec(2)-1+dims(2)) + Ivalues(ijk),Ndiv,Rlon(startvec(1)),Rlon(startvec(1)+dims(1)-1),& + Rlat(startvec(2)),Rlat(startvec(2)-1+dims(2)) call CheckStop("Interpolation error") else - Rvar(ijk)=UnDef - endif + Rvar(ijk)=UnDef_local + end if else if(interpol_used=='mass_conservative')then !used for example for emissions in kg (or kg/s) @@ -3030,16 +3404,17 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & 'DEBUG -- approx!' , trim(varname),& Ivalues(ijk), Nvalues(ijk),Ndiv2, Rvar(ijk) - endif - endif - enddo - enddo - enddo - + end if + end if + end do + end do + end do deallocate(Ivalues) deallocate(Nvalues) + endif - elseif(interpol_used=='zero_order')then + + elseif(interpol_used=='zero_order')then !interpolation 1: !nearest gridcell ijk=0 @@ -3050,22 +3425,23 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & do i=1,limax ij=i+(j-1)*LIMAX ijk=k+(ij-1)*k2 - ig=nint((glon(i,j)-Rlon(startvec(1)))*dloni)+1 + ig=nint((glon(i,j)-Rlon(startvec(1)))*dRloni)+1 if(ig<0.5)ig=ig+dims(1) if(ig>dims(1))ig=ig-dims(1) ig=max(1,min(dims(1),ig)) - jg=max(1,min(dims(2),nint((glat(i,j)-Rlat(startvec(2)))*dlati)+1)) + jg=max(1,min(dims(2),nint((glat(i,j)-Rlat(startvec(2)))*dRlati)+1)) igjgk=ig+(jg-1)*dims(1)+(k-1)*dims(1)*dims(2) if(OnlyDefinedValues.or.(Rvalues(igjgk)/=FillValue.and. .not.isnan(Rvalues(igjgk))))then Rvar(ijk)=Rvalues(igjgk) else - Rvar(ijk)=UnDef - endif - enddo - enddo - enddo - - endif + Rvar(ijk)=UnDef_local + end if + end do + end do + end do + else + write(*,*)'interpolation method not implemented' + end if !_________________________________________________________________________________________________________ !_________________________________________________________________________________________________________ elseif(data_projection=="Stereographic")then @@ -3085,27 +3461,34 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(status /= nf90_noerr)then Grid_resolution=GRIDWIDTH_M_EMEP if ( debug )write(*,*)'Grid_resolution assumed =',Grid_resolution - endif + end if + + !the method chosen depends on the relative resolutions + if(interpol_used=='conservative'.and.Grid_resolution/GRIDWIDTH_M>2)then + interpol_used='zero_order'!usually good enough, and keeps gradients + if ( MasterProc .and. debug) write(*,*) 'Asked for conservative interpolation, but redefined as ',interpol_used + end if + status = nf90_get_att(ncFileID, nf90_global, "xcoordinate_NorthPole", xp_ext ) if(status /= nf90_noerr)then xp_ext=xp_EMEP_old if ( debug )write(*,*)'xcoordinate_NorthPole assumed =',xp_ext - endif + end if status=nf90_get_att(ncFileID, nf90_global, "ycoordinate_NorthPole", yp_ext ) if(status /= nf90_noerr)then yp_ext=yp_EMEP_old if ( debug )write(*,*)'ycoordinate_NorthPole assumed =',yp_ext - endif + end if status=nf90_get_att(ncFileID, nf90_global, "fi", fi_ext ) if(status /= nf90_noerr)then fi_ext=fi_EMEP if ( debug )write(*,*)'fi assumed =',fi_ext - endif + end if status=nf90_get_att(ncFileID, nf90_global, "ref_latitude", ref_lat_ext ) if(status /= nf90_noerr)then ref_lat_ext=ref_latitude_EMEP if ( debug )write(*,*)'ref_latitude assumed =',ref_lat_ext - endif + end if an_ext=EARTH_RADIUS*(1.0+sin(ref_lat_ext*PI/180.0))/Grid_resolution !read entire grid in a first implementation @@ -3114,7 +3497,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & do i=1,ndims totsize=totsize*dims(i) - enddo + end do if ( debug )write(*,*)'totsize ',totsize,ndims allocate(Rvalues(totsize), stat=alloc_err) call check(nf90_get_var(ncFileID, VarID, Rvalues,start=startvec,count=dims),& @@ -3141,7 +3524,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & write(*,*)' Max(RValues) ',maxval(RValues) write(*,*)' Min(RValues) ',minval(RValues) end if - endif + end if if(interpol_used=='conservative'.or.interpol_used=='mass_conservative')then !conserves integral (almost, does not take into account local differences in mapping factor) @@ -3149,7 +3532,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & !divide the external grid into pieces significantly smaller than the fine grid !Divide each global gridcell into Ndiv x Ndiv pieces - Ndiv=nint(2*Grid_resolution/GRIDWIDTH_M) + Ndiv=nint(3*Grid_resolution/GRIDWIDTH_M) Ndiv=max(1,Ndiv) Ndiv2=Ndiv*Ndiv Grid_resolution_div=Grid_resolution/Ndiv @@ -3157,10 +3540,10 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & yp_ext_div=(yp_ext+0.5)*Ndiv-0.5 an_ext_div=an_ext*Ndiv - if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical')then + if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical'.and.projection/='lambert')then !the method should be revised or used only occasionally - if(me==0)write(*,*)'WARNING: interpolation method may be CPU demanding:',projection - endif + if(me==0)write(*,*)'WARNING: interpolation from stereographic to '//trim(projection)//'may be CPU demanding:' + end if k2=1 if(data3D)k2=kend_loc-kstart_loc+1 allocate(Ivalues(LIMAX*LJMAX*k2)) @@ -3172,8 +3555,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & ! Rvar(ij)=UnDef!default value ! else Rvar(ij)=0.0 - ! endif - enddo + ! end if + end do do jg=1,dims(2) do jdiv=1,Ndiv @@ -3184,12 +3567,15 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & i_ext=(ig-1)*Ndiv+idiv call ij2lb(i_ext,j_ext,lon,lat,fi_ext,an_ext_div,xp_ext_div,yp_ext_div) call lb2ij(lon,lat,i,j)!back to model (fulldomain) coordinates +! if(abs(lat-57.0)<0.01 .and. abs(lon-1.3)<0.01)write(*,*)'fullij ',lat,lon,me,i,j +! if(abs(lon-15)<0.02 .and. abs(lat-63)<0.02)write(*,*)jg,ig,lon,lat,i,j,me !convert from fulldomain to local domain !i,j may be any integer, therefore should not use i_local array i=i-gi0-IRUNBEG+2 j=j-gj0-JRUNBEG+2 -83 format(2I4,31F9.2) + +!83 format(2I4,31F9.2) !if ( debug .and.me==0) write(*,83)i,j,lon,lat,fi_ext,an_ext_div,xp_ext_div,yp_ext_div,fi,xp,yp,Rvalues(igjg) if(i>=1.and.i<=limax.and.j>=1.and.j<=ljmax)then @@ -3208,13 +3594,13 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & !Not defined: don't include this Rvalue Ivalues(ijk)=Ivalues(ijk)-1 - endif - enddo - endif - enddo - enddo - enddo - enddo + end if + end do + end if + end do + end do + end do + end do k2=1 if(data3D)k2=kend_loc-kstart_loc+1 do k=1,k2 @@ -3237,7 +3623,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & call CheckStop("Interpolation error") else Rvar(ijk)=UnDef - endif + end if else if(interpol_used=='mass_conservative')then !used for example for emissions in kg (or kg/s) @@ -3252,11 +3638,11 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & 'DEBUG -- approx!' , trim(varname),& Ivalues(ijk), Nvalues(ijk),Ndiv2, Rvar(ijk) - endif - endif - enddo - enddo - enddo + end if + end if + end do + end do + end do deallocate(Ivalues) deallocate(Nvalues) @@ -3272,10 +3658,10 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & an_ext_div=an_ext*Ndiv if(MasterProc.and.debug)write(*,*)'zero_order interpolation ',an_ext_div,xp_ext_div,yp_ext_div,dims(1),dims(2) - if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical')then + if(projection/='Stereographic'.and.projection/='lon lat'.and.projection/='Rotated_Spherical'.and.projection/='lambert')then !the method should be revised or used only occasionally if(me==0)write(*,*)'WARNING: interpolation method may be CPU demanding',projection - endif + end if call lb2ijm(LIMAX,LJMAX,glon,glat,buffer1,buffer2,fi_ext,an_ext_div,xp_ext_div,yp_ext_div) @@ -3303,9 +3689,9 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & Rvar(ijk)=UnDef!default value else Rvar(ijk)=Rvalues(igjgk) - endif - endif - enddo + end if + end if + end do else do k=1,k2 ijk=k+(ij-1)*k2 @@ -3314,14 +3700,14 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & else ! if ( debug ) write(*,*)'WARNING: gridcell out of map. Set to ',FillValue call StopAll("ReadField_CDF: values outside grid required") - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do - endif + end if else ! data_projection /="lon lat" .and. data_projection/="Stereographic" @@ -3339,7 +3725,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & Ndiv2=Ndiv*Ndiv if(Ndiv>1.and.MasterProc)then write(*,*)'dividing each gridcell into ',Ndiv2,' pieces' - endif + end if k2=1 if(data3D)then @@ -3347,30 +3733,30 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & !take all levels kstart_loc=1 kend_loc=dims(3) - endif + end if startvec(3)=kstart_loc k2=kend_loc-kstart_loc+1 dims(3)=kend_loc-kstart_loc+1 if(ndims>3)then startvec(ndims)=nstart dims(ndims)=1 - endif + end if else if(ndims>2)then startvec(ndims)=nstart dims(ndims)=1 - endif - endif + end if + end if allocate(Ivalues(LIMAX*LJMAX*k2)) do ij=1,LIMAX*LJMAX*k2 Ivalues(ij)=0 Rvar(ij)=0.0 - enddo + end do totsize=1 do i=1,ndims totsize=totsize*dims(i) - enddo + end do allocate(Rvalues(totsize), stat=alloc_err) call check(nf90_get_var(ncFileID, VarID, Rvalues,start=startvec,count=dims)& @@ -3394,7 +3780,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & end if else ! Real if ( debug )write(*,*)' xtype real ',xtype - endif + end if !not 100% robust: assumes i increases with longitude, j with latitude. and i almost parallel with longitudes do jg=1,dims(2) @@ -3431,9 +3817,9 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & dlonx=-(Rlon(igjg)-Rlon(igjg+1))/Ndiv dlatx=-(Rlat(igjg)-Rlat(igjg+1))/Ndiv dlony=-(Rlon(igjg)-Rlon(igjg+dims(1)))/Ndiv - endif - endif - endif + end if + end if + end if do idiv=1,Ndiv if(Ndiv>1)then lon=Rlon(igjg)+dlonx*(idiv-0.5-0.5*Ndiv)+dlony*(jdiv-0.5-0.5*Ndiv) @@ -3441,7 +3827,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & else lon=Rlon(igjg) lat=Rlat(igjg) - endif + end if call lb2ij(lon,lat,i,j)!back to model (fulldomain) coordinates i=i-gi0-IRUNBEG+2 j=j-gj0-JRUNBEG+2 @@ -3457,13 +3843,13 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & else !Not defined: don't include this Rvalue Ivalues(ijk)=Ivalues(ijk)-1 - endif - enddo - endif - enddo - enddo - enddo - enddo + end if + end do + end if + end do + end do + end do + end do do k=1,k2 do i=1,limax @@ -3481,7 +3867,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & call CheckStop("Interpolation error") else Rvar(ijk)=UnDef - endif + end if else if(interpol_used=='mass_conservative')then !used for example for emissions in kg (or kg/s) @@ -3491,11 +3877,11 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & ! integral is approximately conserved Rvar(ijk)=Rvar(ijk)/Ivalues(ijk) !if(me==12.and.i==10.and.j==2)write(*,*)'cdfVALUE: ',k,Rvar(ijk),Ivalues(ijk),k2,data3D - endif - endif - enddo - enddo - enddo + end if + end if + end do + end do + end do deallocate(Ivalues) else call CheckStop(interpol_used=='mass_conservative', "ReadField_CDF: only linear interpolation implemented") @@ -3530,34 +3916,34 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & !take all levels kstart_loc=1 kend_loc=dims(3) - endif + end if startvec(3)=kstart_loc k2=kend_loc-kstart_loc+1 dims(3)=kend_loc-kstart_loc+1 if(ndims>3)then startvec(ndims)=nstart dims(ndims)=1 - endif + end if else if(ndims>2)then startvec(ndims)=nstart dims(ndims)=1 - endif - endif + end if + end if totsize=1 do i=1,ndims totsize=totsize*dims(i) - enddo + end do allocate(Rvalues(totsize), stat=alloc_err) if(debug) then write(*,"(2a)") 'ReadCDF VarID ', trim(varname) do i=1, ndims write(*,"(a,6i8)") 'ReadCDF ',i, dims(i),startvec(i) - enddo + end do write(*,*)'total size variable (part read only)',totsize - endif + end if call check(nf90_get_var(ncFileID, VarID, Rvalues,start=startvec,count=dims),& errmsg="RRvalues") @@ -3571,7 +3957,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & status = nf90_get_att(ncFileID, VarID, "add_offset", offset ) if(status == nf90_noerr) scalefactors(2) = offset Rvalues=Rvalues*scalefactors(1)+scalefactors(2) - endif + end if k=1 do i=1,limax @@ -3595,29 +3981,29 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(Rvalues(ijn(iw))/=FillValue) then Rvar(ijk) = Rvar(ijk) + ww(iw)*Rvalues(ijn(iw)+(k-1)*dims(1)*dims(2)) sumWeights = sumWeights+ ww(iw) - endif - enddo !iw + end if + end do !iw if(sumWeights>1.0e-9) then Rvar(ijk) = Rvar(ijk)/sumWeights else Rvar(ijk) = FillValue - endif + end if - enddo !k - enddo !j - enddo !i + end do !k + end do !j + end do !i deallocate(Weight,IIij,JJij) - endif!conservative - endif!general projection + end if!conservative + end if!general projection ! if(interpolate_vertical)then !do the interpolation in the vertical direction only !filename is used only to define the vertical coordinates ! call vertical_interpolate(filename,Rvar,dims(3),debug) -! endif +! end if deallocate(Rvalues) @@ -3625,7 +4011,7 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & deallocate(Rlat) if(fractions)then deallocate(NCC,CC,fraction_in) - endif + end if if(.not. present(ncFileID_given))call check(nf90_close(ncFileID)) @@ -3673,8 +4059,8 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) ! CALL MPI_FINALIZE(IERROR) ! stop - endif - endif + end if + end if return @@ -3697,25 +4083,23 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne logical, optional, intent(in) :: debug_flag integer :: ncFileID,VarID,lonVarID,latVarID,status,ndims,dimids(NF90_MAX_VAR_DIMS),xtype,nAtts - integer :: dims(NF90_MAX_VAR_DIMS),NCdims(NF90_MAX_VAR_DIMS),totsize,i,j,k - integer :: startvec(NF90_MAX_VAR_DIMS),Nstartvec(NF90_MAX_VAR_DIMS) + integer :: dims(NF90_MAX_VAR_DIMS),totsize,i,j,k + integer :: startvec(NF90_MAX_VAR_DIMS) integer ::alloc_err - real :: dloni,dlati,dlon,dlat - integer ::ij,jdiv,idiv,Ndiv,Ndiv2,igjgk,ig,jg,ijk,n,im,jm,ijm,iw - integer ::imin,imax,jmin,jjmin,jmax,igjg,k2 + real :: dloni,dlati + integer ::ij,jdiv,idiv,Ndiv,Ndiv2,igjgk,ig,jg,ijk + integer ::imin,imax,jmin,jmax,igjg,k2 integer, allocatable:: Ivalues(:) ! I counts all data integer, allocatable:: Nvalues(:) !ds counts all values real, allocatable:: Rvalues(:),Rlon(:),Rlat(:) - integer, allocatable:: Mask_values(:) real ::lat,lon,maxlon,minlon,maxlat,minlat logical ::fileneeded, debug,data3D character(len = 50) :: interpol_used, data_projection="",name real :: Grid_resolution - type(Deriv) :: def1 ! definition of fields integer, parameter ::NFL=23,NFLmax=50 !number of flight level (could be read from file) real :: P_FL(0:NFLmax),P_FL0,Psurf_ref(LIMAX, LJMAX),P_EMEP,dp! - real :: FillValue=0,Pcounted + real :: Pcounted logical :: Flight_Levels integer :: k_FL,k_FL2 @@ -3747,13 +4131,13 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne trim(fileName),nf90_strerror(status) Rvar(1:LIMAX*LJMAX*(KMAX_MID-2))=0.0 return - endif - endif + end if + end if interpol_used='mass_conservative'!default for FL if(present(interpol))then interpol_used=interpol - endif + end if call CheckStop(interpol_used/='mass_conservative',& 'interpolation method for FL not recognized') @@ -3772,8 +4156,8 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne call check(nf90_close(ncFileID)) Rvar(1:LIMAX*LJMAX*(KMAX_MID-2))=0.0 return - endif - endif + end if + end if data3D=.true. @@ -3797,7 +4181,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne call check(nf90_inquire_dimension(ncid=ncFileID, dimID=dimids(i), & len=dims(i)),"GetDims") if ( debug ) write(*,*) 'ReadCDF size variable ',i,dims(i) - enddo + end do data_projection = "lon lat" @@ -3825,7 +4209,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne !Hard coded because non-standard anyway. 610 meters layers do k=0,NFLmax P_FL(k)=1000*StandardAtmos_km_2_kPa(k*0.610) - enddo + end do P_FL0=P_FL(0) Flight_Levels=.true. call CheckStop(interpol_used/='mass_conservative',& @@ -3835,7 +4219,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne !montly average is needed, not instantaneous pressure call ReadField_CDF('SurfacePressure.nc','surface_pressure',& Psurf_ref,current_date%month,needed=.true.,interpol='zero_order',debug_flag=debug_flag) - endif + end if !NB: we assume regular grid @@ -3851,7 +4235,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne if(minlon-Rlon(1)<0.0)then imin=1!cover entire circle imax=dims(1)!cover entire circle - endif + end if jmin=max(1,min(dims(2),floor((minlat-Rlat(1))*dlati))) jmax=max(1,min(dims(2),ceiling((maxlat-Rlat(1))*dlati)+1)) @@ -3860,7 +4244,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne !close to poles imin=1 imax=dims(1) - endif + end if if(imax=1.and.i<=limax.and.j>=1.and.j<=ljmax)then - ij=i+(j-1)*LIMAX + ij=i+(j-1)*LIMAX k2=kend-kstart+1 if(Flight_Levels)then !Flight_Levels @@ -3951,7 +4335,7 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne k_FL2=k_FL k_FL=k_FL+1 Pcounted=P_FL(k_FL2) - enddo + end do Ivalues(ijk)=Ivalues(ijk)+1 Nvalues(ijk)=Nvalues(ijk)+1 if(k_FL<=NFL)then @@ -3959,17 +4343,17 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne igjgk=igjg+(k_FL-1)*dims(1)*dims(2) Rvar(ijk)=Rvar(ijk)+Rvalues(igjgk)*dp/(P_FL(k_FL2)-P_FL(k_FL)) Pcounted=P_EMEP - endif - enddo + end if + end do P_FL(0)=P_FL0!may have changed above - endif !Flight levels + end if !Flight levels - endif - enddo - enddo - enddo - enddo + end if + end do + end do + end do + end do k2=kend-kstart+1 do k=1,k2 @@ -3984,25 +4368,28 @@ subroutine ReadField_CDF_FL(fileName,varname,Rvar,nstart,kstart,kend,interpol,ne 'ERROR, NetCDF_ml no values found!', & trim(fileName) // ":" // trim(varname), & i,j,k,me,minlon,maxlon,minlat,maxlat,glon(i,j),glat(i,j), & - Ivalues(ijk),Ndiv,Rlon(startvec(1)),Rlon(startvec(1)+dims(1)-1),Rlat(startvec(2)),Rlat(startvec(2)-1+dims(2)) - call CheckStop("Interpolation error") - + Ivalues(ijk),Ndiv,Rlon(startvec(1)),& + Rlon(startvec(1)+dims(1)-1),Rlat(startvec(2)),& + Rlat(startvec(2)-1+dims(2)) +! call CheckStop("Interpolation error") + !we simply set emission=0 + Rvar(ijk)=0.0 else if(interpol_used=='mass_conservative')then !used for example for emissions in kg (or kg/s) Rvar(ijk)=Rvar(ijk)/Ndiv2! Total sum of values from all cells is constant else call CheckStop("interpol choice not supported") - endif - endif - enddo - enddo - enddo + end if + end if + end do + end do + end do deallocate(Ivalues) deallocate(Nvalues) - endif! projection + end if! projection deallocate(Rvalues) deallocate(Rlon) @@ -4053,7 +4440,7 @@ subroutine ReadTimeCDF(filename,TimesInDays,NTime_Read) character(len=50) :: varname,period,since,name,timeunit,wordarray(wordarraysize),calendar integer :: yyyy,mo,dd,hh,mi,ss,julian,julian_1900,diff_1900,nwords,errcode - logical:: proleptic_gregorian,calendar_360_day + logical:: proleptic_gregorian call check(nf90_open(path=fileName, mode=nf90_nowrite, ncid=ncFileID),& errmsg="ReadTimeCDF, file not found: "//trim(fileName)) @@ -4069,7 +4456,7 @@ subroutine ReadTimeCDF(filename,TimesInDays,NTime_Read) if(NTime_Read<1)then if(DEBUG_NETCDF)write(*,*)'reading all time records' NTime_Read=ntimes - endif + end if call CheckStop(ntimesP_ext(2)) ! .true. --> assumes k_ext=KMAX_EXT is top and k_ext=1 is surface @@ -4302,21 +4689,21 @@ subroutine vertical_interpolate(filename,Rvar,KMAX_ext,Rvar_emep,debug) do k_ext=1,KMAX_EXT if(P_ext(k_ext)P_emep)exit if(k_ext/=k1_ext(k))k2_ext(k)=k_ext - enddo + end do weight_k1(k)=(P_emep-P_ext(k2_ext(k)))/(P_ext(k1_ext(k))-P_ext(k2_ext(k))) - endif + end if if(debug)& write(*,fmt="(A,I4,2(A,I4,A,F5.2))")'vert_inter: level',k,& ' is the sum of level ',k1_ext(k),' weight ',weight_k1(k),& ' and level ',k2_ext(k),' weight ',1-weight_k1(k) - enddo + end do else do k=1,KMAX_MID P_emep=A_mid(k)+B_mid(k)*Pref !Pa @@ -4339,22 +4726,22 @@ subroutine vertical_interpolate(filename,Rvar,KMAX_ext,Rvar_emep,debug) do k_ext=KMAX_EXT,1,-1 if(P_ext(k_ext)P_emep)exit if(k_ext/=k1_ext(k))k2_ext(k)=k_ext - enddo + end do weight_k1(k)=(P_emep-P_ext(k2_ext(k)))/(P_ext(k1_ext(k))-P_ext(k2_ext(k))) - endif + end if if(debug) & write(*,fmt="(A,I4,2(A,I4,A,F5.2))")'vertical_interpolate: level',k,& ' is the sum of level ', k1_ext(k),' weight ',weight_k1(k),& ' and level ', k2_ext(k),' weight ',1.0-weight_k1(k) - enddo - endif + end do + end if forall(i=1:limax,j=1:ljmax,k=1:KMAX_MID)& Rvar_emep(i,j,k)=weight_k1(k) *Rvar(k1_ext(k),i,j)& @@ -4362,7 +4749,7 @@ subroutine vertical_interpolate(filename,Rvar,KMAX_ext,Rvar_emep,debug) deallocate(P_ext,hyam_ext,hybm_ext,k1_ext,k2_ext,weight_k1) call check(nf90_close(ncFileID)) -endsubroutine vertical_interpolate +end subroutine vertical_interpolate function IsCDFfractionFormat(filename) result(foundFractions) @@ -4376,7 +4763,7 @@ function IsCDFfractionFormat(filename) result(foundFractions) cdfstatus = nf90_inq_varid(ncid = ncFileID, name = 'NCodes', varID = VarID) call check(nf90_close(ncFileID)) if(cdfstatus == nf90_noerr)foundFractions=.true. - endif + end if end function IsCDFfractionFormat @@ -4392,7 +4779,67 @@ subroutine ReadSectorName(filename,cdf_sector_name) cdfstatus=nf90_get_att(ncFileID,nf90_global,'SECTORS_NAME',sector_name) call check(nf90_close(ncFileID)) if(cdfstatus == nf90_noerr)cdf_sector_name=trim(sector_name) - endif + end if end subroutine ReadSectorName + + subroutine readfrac(Ncc,CC,Rvalues,fraction_in,fractions_out,Ncc_out,CC_out,val,dim1dim2,igjgk,ijk,latlon_weight,Reduc) +!accumulates the values val, and update fractions + implicit none + real, optional,intent(in) :: Reduc(NLAND) + integer, intent(in) :: dim1dim2,igjgk,ijk + real, intent(inout) :: fractions_out(LIMAX*LJMAX,*),val + real, intent(in) :: Rvalues,fraction_in(dim1dim2,*),latlon_weight + integer, intent(inout) ::Ncc_out(*), CC_out(LIMAX*LJMAX,*) + integer, intent(in) ::Ncc,CC(dim1dim2,*) + integer :: N,Ng,N_out,ic + real :: factor, total + + do Ng=1,Ncc!number of fields at igjg as read + do N_out=1,Ncc_out(ijk) !number of fields at ij already saved in the model grid + if(CC(igjgk,Ng)==CC_out(ijk,N_out))goto 737 + end do + !the country is not yet used for this gridcell. Define it now + Ncc_out(ijk)=Ncc_out(ijk)+1 + N_out=Ncc_out(ijk) + CC_out(ijk, N_out)=CC(igjgk,Ng) + fractions_out(ijk,N_out)=0.0 +737 continue + factor=1.0!default reduction factor + !if(present(Reduc).and.CC(igjgk,Ng)>0.and.CC(igjgk,Ng)<=NLAND)factor=Reduc(CC(igjgk,Ng)) + if(present(Reduc).and.CC(igjgk,Ng)>0)then + ic=find_index(CC(igjgk,Ng),Country(:)%icode) + if(ic>NLAND.or.ic<1)then + write(*,*)"ReadField_cdf: COUNTRY CODE NOT RECOGNIZED OR UNDEFINED: ",& + CC(igjgk,Ng) + call StopAll("COUNTRY CODE NOT RECOGNIZED ") + end if + factor=Reduc(ic) + end if + !update fractions + total=val+Rvalues*fraction_in(igjgk,Ng)*factor*latlon_weight +! if(debug.and.fraction_in(igjgk,Ng)>1.001)then +! write(*,*)'fractions_in TOO LARGE ',Ng,ig,jg,k,fraction_in(igjgk,Ng) +! stop +! end if + if(abs(total)>1.0E-30)then + do N=1,Ncc_out(ijk) + !reduce previously defined fractions + fractions_out(ijk,N)=fractions_out(ijk,N)*val/total + end do + !increase fraction of this country (yes, after having reduced it!) + fractions_out(ijk,N_out)=fractions_out(ijk,N_out)+Rvalues*fraction_in(igjgk,Ng)*latlon_weight/total*factor + else + !should try to keep proportions right in case cancellation of positive an negative; not finished! + do N=1,Ncc_out(ijk) + !reduce existing fractions + fractions_out(ijk,N)=fractions_out(ijk,N)/Ncc_out(ijk) + end do + !increase fraction of this country (yes, after having reduced it!) + fractions_out(ijk,N_out)=fractions_out(ijk,N_out)+Rvalues*fraction_in(igjgk,Ng)*latlon_weight/Ncc_out(ijk)*factor + end if + val=total + enddo + end subroutine readfrac + endmodule NetCDF_ml diff --git a/NumberConstants.f90 b/NumberConstants.f90 index d22f334..9e07602 100644 --- a/NumberConstants.f90 +++ b/NumberConstants.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/OutputChem_ml.f90 b/OutputChem_ml.f90 index b3bfd7e..8558df2 100644 --- a/OutputChem_ml.f90 +++ b/OutputChem_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -40,13 +40,13 @@ module OutputChem_ml DEBUG => DEBUG_OUTPUTCHEM, METSTEP, & IOU_INST, IOU_YEAR, IOU_MON, IOU_DAY,& IOU_HOUR,IOU_HOUR_INST, IOU_MAX_MAX,& - startdate, enddate + startdate, enddate, USE_uEMEP use NetCDF_ml, only: CloseNetCDF, Out_netCDF, filename_iou use OwnDataTypes_ml, only: Deriv, print_deriv_type use Par_ml, only: LIMAX,LJMAX use TimeDate_ml, only: tdif_secs,date,timestamp,make_timestamp,current_date, max_day ! days in month use TimeDate_ExtraUtil_ml,only: date2string - +use uEMEP_ml, only: out_uEMEP implicit none @@ -76,11 +76,10 @@ subroutine Wrtchem(ONLY_HOUR) !---------------------------------------------------------------------- integer, intent(in), optional :: ONLY_HOUR ! output hourly fields - integer :: i,j,n,k,msnr1 + integer :: n integer :: nyear,nmonth,nday,nhour,nmonpr integer :: mm_out, dd_out logical :: Jan_1st, End_of_Run - character(len=30) :: outfilename logical,save :: first_call = .true. TYPE(timestamp) :: ts1,ts2 !--------------------------------------------------------------------- @@ -119,8 +118,8 @@ subroutine Wrtchem(ONLY_HOUR) if( MasterProc .and. DEBUG) write(6,"(a12,i5,4i4)") "DAILY FIX ", & nmonth, mm_out, nday, dd_out - endif - endif ! for END_OF_EMEPDAY <= 7 + end if + end if ! for END_OF_EMEPDAY <= 7 !== Instantaneous results output ==== ! Possible actual array output for specified days and hours @@ -130,34 +129,34 @@ subroutine Wrtchem(ONLY_HOUR) wanted_dates_inst(n)%day == nday .and. & wanted_dates_inst(n)%hour == nhour ) then call Output_fields(IOU_INST) - endif - enddo + end if + end do !== Hourly output ==== if(modulo(current_date%hour,FREQ_HOURLY)==0) then call Output_fields(IOU_HOUR_INST) if(present(ONLY_HOUR))then if(ONLY_HOUR==IOU_HOUR_INST)return - endif + end if call Output_fields(IOU_HOUR) call ResetDerived(IOU_HOUR) if(present(ONLY_HOUR))then if(ONLY_HOUR==IOU_HOUR)return - endif - endif + end if + end if !== Daily output ==== if (nhour == END_OF_EMEPDAY ) then if (.not.first_call .and. .not.Jan_1st ) & ! Doesn't write out 1 Jan. at start call Output_fields(IOU_DAY) call ResetDerived(IOU_DAY) ! For daily averaging, reset also 1 Jan. - endif + end if !== Output at the end of the run if ( End_of_Run ) then if(nhour/=END_OF_EMEPDAY) call Output_fields(IOU_DAY)! Daily outputs call Output_fields(IOU_YEAR) ! Yearly outputs - endif + end if !/ NEW MONTH @@ -169,10 +168,10 @@ subroutine Wrtchem(ONLY_HOUR) call Output_fields(IOU_MON) call ResetDerived(IOU_MON) - endif ! End of NEW MONTH + end if ! End of NEW MONTH first_call=.false. -endsubroutine Wrtchem +end subroutine Wrtchem subroutine Output_fields(iotyp) integer, intent(in) :: iotyp @@ -186,7 +185,7 @@ subroutine Output_fields(iotyp) if(num_deriv3d > 0) call Output_f3d(iotyp,num_deriv3d,nav_3d,f_3d,d_3d,Init_Only) myfirstcall(iotyp) = .false. IF(DEBUG.and.MasterProc)write(*,*)'2d and 3D OUTPUT INITIALIZED',iotyp - endif + end if Init_Only = .false. IF(DEBUG.and.MasterProc)write(*,*)'2d and 3D OUTPUT WRITING',iotyp !*** 2D fields, e.g. surface SO2, SO4, NO2, NO3 etc.; AOT, fluxes @@ -200,6 +199,11 @@ subroutine Output_fields(iotyp) call CloseNetCDF + !uemep use own outputting for now, since it has several extra dimensions + if(USE_uEMEP)then + call out_uEMEP(iotyp) + endif + ! Write text file to mark output is finished if(.not.all([FORECAST,MasterProc,wanted_iou(iotyp)]))return i=index(filename_iou(iotyp),'.nc')-1 @@ -207,7 +211,7 @@ subroutine Output_fields(iotyp) open(IO_TMP,file=filename_iou(iotyp)(1:i)//'.msg',position='append') write(IO_TMP,*)date2string('FFFF: YYYY-MM-DD hh',current_date) close(IO_TMP) -endsubroutine Output_fields +end subroutine Output_fields subroutine Output_f2d (iotyp, dim, nav, def, dat, Init_Only) !--------------------------------------------------------------------- @@ -241,15 +245,15 @@ subroutine Output_f2d (iotyp, dim, nav, def, dat, Init_Only) if( def(icmp)%name == "Emis_mgm2_co" ) then call print_deriv_type(def(icmp)) call datewrite("SnapEmis-Output_f2d Emis", iotyp, (/ dat(icmp,debug_li,debug_lj,my_iotyp) /) ) - endif - endif + end if + end if call Out_netCDF(iotyp,def(icmp),2,1,dat(icmp,:,:,my_iotyp),scale,& create_var_only=Init_Only) - endif ! wanted - enddo ! component loop + end if ! wanted + end do ! component loop -endsubroutine Output_f2d +end subroutine Output_f2d subroutine Output_f3d (iotyp, dim, nav, def, dat, Init_Only) !--------------------------------------------------------------------- @@ -276,9 +280,9 @@ subroutine Output_f3d (iotyp, dim, nav, def, dat, Init_Only) call Out_netCDF(iotyp,def(icmp),3,num_lev3d,dat(icmp,:,:,:,my_iotyp),scale,& create_var_only=Init_Only) - endif ! wanted - enddo ! component loop + end if ! wanted + end do ! component loop -endsubroutine Output_f3d +end subroutine Output_f3d endmodule OutputChem_ml diff --git a/Output_hourly.f90 b/Output_hourly.f90 index 8211cb6..67f49ec 100644 --- a/Output_hourly.f90 +++ b/Output_hourly.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -67,7 +67,6 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) nmax6_hourly ! 6 hourly maximum use CheckStop_ml, only: CheckStop use Chemfields_ml, only: xn_adv,xn_shl,cfac,PM25_water,PM25_water_rh50 -use ChemGroups_ml, only: chemgroups use Derived_ml, only: num_deriv2d,nav_2d,LENOUT2D,& ! D2D num_deriv3d,nav_3d,LENOUT3D ! D3D use DerivedFields_ml, only: f_2d,d_2d,f_3d,d_3d ! houtly output types @@ -81,14 +80,12 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) DEBUG => DEBUG_OUT_HOUR,runlabel1,HOURLYFILE_ending,& FORECAST, hour_DOMAIN, SELECT_LEVELS_HOURLY !NML use MetFields_ml, only: t2_nwp,th, q, roa, surface_precip, ws_10m ,rh2m,& - pzpbl, ustar_nwp, Kz_m2s, & Idirect, Idiffuse, z_bnd, z_mid,ps use NetCDF_ml, only: Out_netCDF, CloseNetCDF, Init_new_netCDF, & max_filename_length, fileName_iou, & Int1, Int2, Int4, Real4, Real8 !Output data type to choose use OwnDataTypes_ml, only: TXTLEN_DERIV,TXTLEN_SHORT -use Par_ml, only: LIMAX, LJMAX, GIMAX,GJMAX, & - me, IRUNBEG, JRUNBEG, limax, ljmax +use Par_ml, only: me, limax, ljmax use Pollen_ml, only: heatsum, pollen_released=>R, AreaPOLL use Pollen_const_ml, only: pollen_total=>N_TOT use SmallUtils_ml, only: find_index @@ -156,7 +153,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,*)"DEBUG Hourly_out: nothing to output!" first_call=.false. return - endif + end if ! write(*,*) " START: nmax6_hourly ",nmax6_hourly,allocated(max6_hourly) if (nmax6_hourly > 0 .and. .not.allocated(max6_hourly)) then @@ -165,7 +162,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) max6_hourly(:,:,:,:) = 0. imax6_hourly(:) =typ_si("none",-99) write(*,*) "allocate: ", imax6_hourly,KMAX_MID - endif + end if ! only write at 12UTC for "TRENDS@12UTC", eg ! if(MY_OUTPUTS=="TRENDS@12UTC".and.current_date%hour/=12)return @@ -173,14 +170,14 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) if(i>0)then read(MY_OUTPUTS(i+1:i+2),*)ih if(current_date%hour/=ih)return - endif + end if if(first_call) then first_call = .false. debug_flag=(debug_proc.and.DEBUG) allocate(navg(NHOURLY_OUT)) ! allocate and initialize navg(:)=0 ! D2D average counter - endif ! first_call + end if ! first_call filename=trim(runlabel1)//date2string(trim(HOURLYFILE_ending),current_date) if(filename/=filename_iou(IOU_HOUR_EXTRA))then @@ -209,9 +206,9 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) nj=hour_DOMAIN(4)-hour_DOMAIN(3)+1 call Out_netCDF(IOU_HOUR_EXTRA,def1,3,1,hourly,scale,CDFtype,ik=1,& create_var_only=.true.,ncFileID_given=ncFileID,chunksizes=[ni,nj,1,1]) - endselect - enddo - endif + end select + end do + end if !......... Uses concentration/met arrays from Chem_ml or Met_ml .................. ! ! real xn_adv(NSPEC_ADV,LIMAX,LJMAX,KMAX_MID) @@ -249,7 +246,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) hr_out_type="D2D_mean" ! output mean values else ! accumulated variables hr_out_type="D2D_accum" - endif + end if case("D3D") call CheckStop(SELECT_LEVELS_HOURLY,& "D3D hourly output does not support SELECT_LEVELS_HOURLY") @@ -259,7 +256,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) hr_out_type="D3D_mean" ! output mean values else ! accumulated variables hr_out_type="D3D_accum" - endif + end if case("ADVppbv","ADVugXX","ADVugXXgroup","PMwaterSRF",& "D2D_inst","D2D_mean","D2D_accum") ik=KMAX_MID ! surface/lowermost level @@ -283,10 +280,10 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) hr_out_type(1:3)="ADV" case("PMwater") hr_out_type=trim(hr_out_type)//"SRF" - endselect - endselect - endif - endselect + end select + end select + end if + end select if(debug_flag) write(*,"(5a,i4)") "DEBUG Hourly MULTI ",& @@ -328,7 +325,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) endforall else call CheckStop("SHL Out3D option not coded yet") - endif + end if else ! ADV:, original code @@ -345,20 +342,20 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) endforall else call CheckStop("ERROR: Output_hourly unit problem"//trim(name) ) - endif - endif ! ADV/SHL split + end if + end if ! ADV/SHL split if(surf_corrected.and.ik==KMAX_MID.and.itot>NSPEC_SHL) then forall(i=1:limax,j=1:ljmax) hourly(i,j) = hourly(i,j)*cfac(iadv,i,j) ! 50m->3m conversion endforall - endif + end if if(debug_flag) then i=debug_li; j=debug_lj write(*,'(A,2I4,1X,L2,2f10.4)')"Out3D K-level"//trim(name), ik, & itot, surf_corrected, hourly(i,j), cfac(ispec-NSPEC_SHL,i,j) - endif + end if case("BCVppbv") call CheckStop(ENFORCE_HOURLY_DERIVED.and.MasterProc,& @@ -449,7 +446,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) forall(i=1:limax,j=1:ljmax) hourly(i,j) = 3.0*unit_conv else forall(i=1:limax,j=1:ljmax) hourly(i,j) = z_mid(i,j,ik)*unit_conv - endif + end if case("dZ","dZ_BND") ! level thickness call CheckStop(ENFORCE_HOURLY_DERIVED.and.MasterProc,& @@ -474,7 +471,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) * roa(i,j,iik,1) & ! density. * (z_bnd(i,j,iik)-z_bnd(i,j,iik+1)) ! level thickness endforall - enddo + end do case("COLUMNgroup")! GROUP Column output in ug/m2, ugX/m2, molec/cm2 call CheckStop(ENFORCE_HOURLY_DERIVED.and.MasterProc,& @@ -489,7 +486,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) * roa(i,j,iik,1) & ! density. * (z_bnd(i,j,iik)-z_bnd(i,j,iik+1)) ! level thickness endforall - enddo + end do if(DEBUG) & write(*,'(a10,i7,a10,i7)')"K-level", ik, trim(name), gspec+NSPEC_SHL deallocate(gspec,gunit_conv) @@ -519,7 +516,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) forall(i=1:limax,j=1:ljmax) hourly(i,j)=heatsum(i,j,ik) else hourly(:,:) = 0.0 - endif + end if case("pollen_left") ik = hr_out(ih)%spec @@ -529,7 +526,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) forall(i=1:limax,j=1:ljmax) hourly(i,j) = 1.0-pollen_released(i,j,ik)/pollen_total(ik) else hourly(:,:) = 0.0 - endif + end if case("pollen_emiss") ik = hr_out(ih)%spec @@ -539,7 +536,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) forall(i=1:limax,j=1:ljmax) hourly(i,j) = AreaPOLL(i,j,ik) else hourly(:,:) = 0.0 - endif + end if case("theta") ! No cfac for surf.variable; Skip Units conv. forall(i=1:limax,j=1:ljmax) hourly(i,j) = th(i,j,ik,1) @@ -569,9 +566,9 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) imax6_hourly(n)%ind = ih intmax = n exit - endif - enddo - endif + end if + end do + end if if(allocated(max6_hourly))then do i=1,limax do j=1,ljmax @@ -580,7 +577,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) do k_flight = KMAX_MID,1,-1 !if(me==23.and.i==3.and.j==10)write(*,*) "k_flight: ",k_flight,z_mid(i,j,k_flight) if (z_mid(i,j,k_flight) .gt. 6096.0) exit !0 - 20 000 feet - enddo + end do flight_start = KMAX_MID flight_end = k_flight+1 !if(me==23.and.i==3.and.j==10)write(*,*) "ik: 20 ",flight_start,flight_end,z_mid(i,j,flight_start),z_mid(i,j,flight_end) @@ -591,11 +588,11 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) z_mid(i,j,flight_end).eq. z_mid(i,j,KMAX_MID)) then flight_start = k_flight flight_end = k_flight - endif + end if if(z_mid(i,j,k_flight) .gt. 6096.0 .and. & z_mid(i,j,k_flight) .lt. 10668.0) flight_end = k_flight if(z_mid(i,j,k_flight) .gt. 10668.0) exit - enddo + end do elseif (ik .eq. KMAX_MID-2) then flight_end = KMAX_MID if (z_mid(i,j,1) .lt. 10668.0) then @@ -607,26 +604,26 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) z_mid(i,j,flight_end).eq. z_mid(i,j,KMAX_MID)) then flight_start = k_flight flight_end = k_flight - endif + end if if(z_mid(i,j,k_flight) .gt. 10668.0 .and. & z_mid(i,j,k_flight) .lt. 15240.0) flight_end = k_flight if(z_mid(i,j,k_flight) .gt. 15240.0) exit - enddo - endif - endif + end do + end if + end if do k_flight = flight_end,flight_start temp = dot_product(xn_adv(gspec,i,j,k_flight),gunit_conv(:))& * roa(i,j,k_flight,1) if(flight_max .lt. temp) flight_max = temp - enddo + end do max6_hourly(intmax,i,j,ik)=max(max6_hourly(intmax,i,j,ik),flight_max) - enddo - enddo + end do + end do forall(i=1:limax,j=1:ljmax) hourly(i,j) = max6_hourly(intmax,i,j,ik) else hourly(:,:) = 0.0 - endif + end if if(mod(current_date%hour,6)==0) max6_hourly(:,:,:,ik) = 0.0 case("D2D_inst") @@ -644,7 +641,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(2a,2i4,a,3g12.3)") "OUTHOUR "//trim(hr_out_type),& trim(hr_out(ih)%name), ih, ispec,trim(f_2d(ispec)%name),& d_2d(ispec,i,j,[IOU_INST,IOU_YEAR]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = d_2d(ispec,i,j,IOU_INST) * unit_conv endforall @@ -667,7 +664,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(2a,2i4,a,3g12.3)") "OUTHOUR "//trim(hr_out_type),& trim(hr_out(ih)%name), ih, ispec,trim(f_3d(ispec)%name),& d_3d(ispec,i,j,ik,[IOU_INST,IOU_YEAR]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = d_3d(ispec,i,j,ik,IOU_INST) * unit_conv endforall @@ -692,7 +689,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(2a,2i4,a,3g12.3)") "OUTHOUR "//trim(hr_out_type),& trim(hr_out(ih)%name), ih, ispec,trim(f_2d(ispec)%name),& d_2d(ispec,i,j,[IOU_YEAR,IOU_YEAR_LASTHH]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = (d_2d(ispec,i,j,IOU_YEAR)& -d_2d(ispec,i,j,IOU_YEAR_LASTHH)) * unit_conv @@ -719,7 +716,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(2a,2i4,a,3g12.3)") "OUTHOUR "//trim(hr_out_type),& trim(hr_out(ih)%name), ih, ispec,trim(f_3d(ispec)%name),& d_3d(ispec,i,j,ik,[IOU_YEAR,IOU_YEAR_LASTHH]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = (d_3d(ispec,i,j,ik,IOU_YEAR)& -d_3d(ispec,i,j,ik,IOU_YEAR_LASTHH)) * unit_conv @@ -747,13 +744,13 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(a,1x)",advance='no') "OUTHOUR D2D_mean avg" else ! accumulated variables --> mean write(*,"(a,1x)",advance='no') "OUTHOUR D2D_mean acc" - endif + end if i=debug_li j=debug_lj write(*,"(a,2i4,a,3g12.3)")& trim(hr_out(ih)%name), ih, ispec,trim(f_2d(ispec)%name),& d_2d(ispec,i,j,[IOU_YEAR,IOU_YEAR_LASTHH]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = (d_2d(ispec,i,j,IOU_YEAR)& -d_2d(ispec,i,j,IOU_YEAR_LASTHH)) * unit_conv @@ -781,13 +778,13 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) write(*,"(a,1x)",advance='no') "OUTHOUR D3D_mean avg" else ! accumulated variables --> mean write(*,"(a,1x)",advance='no') "OUTHOUR D3D_mean acc" - endif + end if i=debug_li j=debug_lj write(*,"(a,2i4,a,3g12.3)")& trim(hr_out(ih)%name), ih, ispec,trim(f_3d(ispec)%name),& d_3d(ispec,i,j,ik,[IOU_YEAR,IOU_YEAR_LASTHH]),unit_conv - endif + end if forall(i=1:limax,j=1:ljmax) hourly(i,j) = (d_3d(ispec,i,j,ik,IOU_YEAR)& -d_3d(ispec,i,j,ik,IOU_YEAR_LASTHH)) * unit_conv @@ -801,7 +798,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) call CheckStop( "ERROR-DEF! Hourly_out: '"//trim(hr_out(ih)%type)//& "' hourly type not found!") - endselect OPTIONS + end select OPTIONS if(debug_flag) & write(*,"(a,3i4,2g12.3)")"DEBUG-HOURLY-OUT:"//trim(hr_out(ih)%name),& @@ -826,9 +823,9 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) if(hr_out(ih)%type(1:3)=="ADV") then write(*,*) "xn_ADV is ", xn_adv(ispec,maxpos(1),maxpos(2),KMAX_MID) write(*,*) "cfac is ", cfac(ispec,maxpos(1),maxpos(2)) - endif + end if errmsg="Error, Output_hourly/hourly_out: too big!" - endif + end if ! NetCDF hourly output def1%name=hr_out(ih)%name @@ -849,9 +846,9 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) call Out_netCDF(IOU_HOUR_EXTRA,def1,3,1,hourly,scale,CDFtype,ik=klevel,& ncFileID_given=ncFileID) !case default ! no output - endselect - enddo KVLOOP - enddo HLOOP + end select + end do KVLOOP + end do HLOOP ! CF convention: surface pressure to define vertical coordinates. if(Nhourly_out>0.and.NLEVELS_HOURLY>0.and.all(hr_out(:)%name/="PS"))then def1%name='PS' @@ -861,7 +858,7 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) scale=1. call Out_netCDF(IOU_HOUR_EXTRA,def1,2,1,ps(:,:,1)*0.01,scale,CDFtype,& ncFileID_given=ncFileID) - endif + end if ! Not closing seems to give a segmentation fault when opening the file ! Probably just a bug in the netcdf4/hdf5 library. @@ -875,4 +872,4 @@ subroutine hourly_out() !! spec,ofmt,ix1,ix2,iy1,iy2,unitfac) open(IO_TMP,file=filename(1:i)//'.msg',position='append') write(IO_TMP,*)date2string('FFFF: YYYY-MM-DD hh',current_date) close(IO_TMP) -endsubroutine hourly_out +end subroutine hourly_out diff --git a/OwnDataTypes_ml.f90 b/OwnDataTypes_ml.f90 index 15fc1b3..cf6ae18 100644 --- a/OwnDataTypes_ml.f90 +++ b/OwnDataTypes_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -28,12 +28,10 @@ !! ***************************************************************************! module OwnDataTypes_ml -use NumberConstants, only : UNDEF_R, UNDEF_I +use NumberConstants, only : UNDEF_I, UNDEF_R implicit none private -! depmap -! gtype for species groups, used in CM_ChemSpecs and Derived public :: print_Deriv_type public :: print_Asc2D @@ -57,62 +55,74 @@ module OwnDataTypes_ml integer :: ind ! Index of species in IXADV_ or IX_ arrays integer :: calc ! Index of species in calculated dep arrays real :: vg ! if CDDEP_SET, give vg in m/s -endtype depmap - -!================== -!/ generic group for two integers -type, public :: typ_i2 - integer :: int1,int2 -endtype typ_i2 - -type, public :: typ_i3 - integer :: int1,int2,int3 -endtype typ_i3 - -!/ generic group for two (short) strings -type, public :: typ_ss - character(len=TXTLEN_SHORT) :: txt1,txt2 ! e.g. POD1_IAM_DF -endtype typ_ss - -!/ generic group for name and pointer to arrays -type, public :: typ_sp - character(len=TXTLEN_SHORT) :: name ! e.g. POD1_IAM_DF - integer, dimension(:), pointer :: ptr -endtype typ_sp - -!/ generic group one (short) string & one integer -type, public :: typ_si - character(len=TXTLEN_SHORT) :: name - integer :: ind -endtype typ_si -!/ generic group for one (short) string & one shorter string -type, public :: typ_s1ind - character(len=TXTLEN_SHORT) :: name - character(len=TXTLEN_IND) :: ind ! e.g. YMDHI -endtype typ_s1ind +end type depmap + + !================== + !/ generic groups for integers + type, public :: typ_i2 + integer :: int1 + integer :: int2 + end type typ_i2 + + type, public :: typ_i3 + integer :: int1 + integer :: int2 + integer :: int3 + end type typ_i3 + + !/ generic group for two (short) strings + type, public :: typ_ss + character(len=TXTLEN_SHORT) :: txt1='-' ! e.g. POD1_IAM_DF + character(len=TXTLEN_SHORT) :: txt2='-' ! e.g. POD1_IAM_DF + end type typ_ss + + !/ generic group for name and pointer to arrays + type, public :: typ_sp + character(len=TXTLEN_SHORT) :: name ! e.g. POD1_IAM_DF + integer, dimension(:), pointer :: specs + end type typ_sp + + !/ HI: generic group for name and two pointers to integer arrays + type, public :: typ_maps + character(len=TXTLEN_SHORT) :: name ! e.g. POD1_IAM_DF + integer, dimension(:), pointer :: species ! like specs in typ_sp + integer, dimension(:), pointer :: maps ! other species to map this + ! one to + end type typ_maps + + !/ generic group one (short) string & one integer + type, public :: typ_si + character(len=TXTLEN_SHORT) :: name + integer :: ind + end type typ_si + !/ generic group for one (short) string & one shorter string + type, public :: typ_s1ind + character(len=TXTLEN_SHORT) :: name + character(len=TXTLEN_IND) :: ind ! e.g. YMDHI + end type typ_s1ind !/ generic group for three (short) strings type, public :: typ_s3 character(len=TXTLEN_SHORT) :: txt1,txt2,txt3 -endtype typ_s3 +end type typ_s3 !/ generic group for four (short) strings type, public :: typ_s4 character(len=TXTLEN_SHORT) :: txt1,txt2,txt3,txt4 ! e.g. POD1_IAM_DF -endtype typ_s4 +end type typ_s4 !/ generic group for five (short) strings & one integer type, public :: typ_s5i character(len=TXTLEN_SHORT) :: txt1,txt2,txt3,txt4, & txt5 ! e.g. SO2,ugS,2d,AIR_CONC,SPEC integer :: ind ! e.g. IOU_DAY -endtype typ_s5i +end type typ_s5i !/ generic group for five (short) strings & one shorter string type, public :: typ_s5ind character(len=TXTLEN_SHORT) :: txt1,txt2,txt3,txt4, & txt5 ! e.g. SO2,ugS,2d,AIR_CONC,SPEC, character(len=TXTLEN_IND) :: ind ! e.g. YMDHI -endtype typ_s5ind +end type typ_s5ind !================== !+ Derived output type @@ -129,7 +139,7 @@ module OwnDataTypes_ml logical :: avg =.true. ! True => average data (divide by nav at end), ! else accumulate over run period character(len=TXTLEN_IND) :: iotype = '-' ! sets output timing -endtype +end type ! Sentinel values (moved to NumberConstants) ! real, private, parameter :: UNDEF_R = -huge(0.0) @@ -147,7 +157,7 @@ module OwnDataTypes_ml character(len=TXTLEN_SHORT) :: unit ! Unit used real :: unitconv = UNDEF_R ! conv. factor real :: max = UNDEF_R ! Max allowed value for output -endtype +end type !================== !+ Defines SOA, NONVOL and VBS params @@ -156,17 +166,38 @@ module OwnDataTypes_ml real :: CiStar ! ug/m3 !real :: Tref ! Assumed 300 real :: DeltaH ! kJ/mole -endtype VBST +end type VBST !================== !================== ! uEMEP parameters -type, public :: uEMEP_type - integer :: Nix=0 ! Number of components to take - integer, dimension(15) :: ix ! Index of components to take - integer :: sector=0 ! if only one sector is to be taken +integer, public, parameter :: Npoll_uemep_max=7 !max number of uEMEP pollutant +integer, public, parameter :: Nsector_uemep_max=10 !max number of sectors for each uEMEP pollutant +type, public :: poll_type character(len=4):: emis='none' ! one of EMIS_File: "sox ", "nox ", "co ", "voc ", "nh3 ", "pm25", "pmco" -endtype uEMEP_type + integer, dimension(Nsector_uemep_max) ::sector=-1 ! sectors to be included for this pollutant. Zero is sum of all sectors + integer :: EMIS_File_ix = 0 !index in EMIS_File (set by model) + integer :: Nsectors = 0 !set by model + integer :: sec_poll_ishift = 0 !The start of index for isec_poll loops + integer :: Nix=0 ! Number of components to take (set by model) + integer, dimension(15) :: ix ! Index of components to take (set by model) + real, dimension(15) :: mw=0.0 ! (set by model) +end type poll_type + +type, public :: uEMEP_type + integer :: Npoll=0 ! Number of pollutants to treat in total + integer :: Nsec_poll=1 ! Number of sector and pollutants to treat in total + integer :: dist=0 ! max distance of neighbor to include. (will include a square with edge size=2*dist+1) + integer :: Nvert=20 ! number of k levels to include + integer :: DOMAIN(4) = -999 + type(poll_type) :: poll(Npoll_uemep_max) !pollutants to include + logical :: YEAR =.true.! Output frequency + logical :: MONTH =.false. + logical :: DAY =.false. + logical :: HOUR =.false. + logical :: HOUR_INST =.false. + logical :: COMPUTE_LOCAL_TRANSPORT=.true. +end type uEMEP_type contains !========================================================================= @@ -203,6 +234,6 @@ subroutine print_Deriv_type(w) write(*,"(a,es10.3)") "scale :", w%scale write(*,*) "dt_scale:", w%dt_scale write(*,*) "avg :", w%avg -endsubroutine print_Deriv_type +end subroutine print_Deriv_type !========================================================================= endmodule OwnDataTypes_ml diff --git a/Par_ml.f90 b/Par_ml.f90 index 2fbc871..c7171cd 100644 --- a/Par_ml.f90 +++ b/Par_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -65,7 +65,8 @@ module Par_ml integer, public, save :: & IRUNBEG,JRUNBEG, & GIMAX,GJMAX, & ! Number of rundomain points in x,y direction - MAXLIMAX,MAXLJMAX ! Maximum number of subdomain points in x,y + MAXLIMAX,MAXLJMAX,& ! Maximum number of subdomain points in x,y + MINLIMAX,MINLJMAX ! Minimum number of subdomain points in x,y ! Parameter statements for the parameters used to access the table ! of neighbor processors (neighbor) @@ -115,7 +116,6 @@ module Par_ml integer, public, parameter :: NX_BROADCAST = -1 ! The different messages used in the bott version of airpol -character (len=230) :: txt integer, public, parameter :: & MSG_INIT0 = 10, & MSG_INIT1 = 11, & @@ -187,11 +187,11 @@ subroutine parinit(min_grids,Pole_singular) DOMAIN_DECOM_MODE="Y=2" ! even NPROC --> divide Y into 2 else DOMAIN_DECOM_MODE="Y=1" ! odd NPROC --> divide only in X direction - endif + end if case default call CheckStop('parinit: Wrong Pole_singular value') - endselect - endif + end select + end if select case(DOMAIN_DECOM_MODE) case("X*Y","XY") ! try X,Y values until X*Y==NPROC @@ -202,7 +202,7 @@ subroutine parinit(min_grids,Pole_singular) if(NPROCX*NPROCY==NPROC)exit ! we found some values that divide NPROC NPROCX=NPROCX+1 call CheckStop(NPROCX>NPROC,'parinit: bug in NPROCX algorithm') - enddo + end do case("X*1","Y=1","X") ! divide only in X direction NPROCX=NPROC NPROCY=1 @@ -217,7 +217,7 @@ subroutine parinit(min_grids,Pole_singular) NPROCY=2 case default call CheckStop('parinit: Unknown DOMAIN_DECOM_MODE') - endselect + end select call CheckStop(NPROCX*NPROCY,NPROC,'parinit: X*Y /= NPROC') ! Check if the subdomain is large enough @@ -225,7 +225,7 @@ subroutine parinit(min_grids,Pole_singular) if(MasterProc) write(*,*)'change number of processors, or rundomain ',min_grids call CheckStop(GJMAX/NPROCY divide Y into 2 else DOMAIN_DECOM_MODE="Y=1" ! odd NPROC --> divide only in X direction - endif + end if case default call CheckStop('parinit: Wrong Pole_singular value') - endselect - endif + end select + end if !decompose into largesubdomains ! select case(DOMAIN_DECOM_MODE) @@ -384,7 +386,7 @@ subroutine parinit_groups(min_grids,Pole_singular) ! if(NPROCX_IO*NPROCY_IO==NPROC_IO)exit ! we found some values that divide NPROC ! NPROCY_IO=NPROCY_IO+1 ! call CheckStop(NPROCX_IO>NPROC_IO,'parinit: bug in NPROCX_IO algorithm') - ! enddo + ! end do ! case("X*1","Y=1","X") ! divide only in X direction ! NPROCX_IO=NPROC_IO ! NPROCY_IO=1 @@ -401,7 +403,7 @@ subroutine parinit_groups(min_grids,Pole_singular) ! NPROCY_IO=2 ! case default ! call CheckStop('parinit: Unknown DOMAIN_DECOM_MODE') - ! endselect + ! end select call CheckStop(NPROCX_IO*NPROCY_IO,NPROC_IO,'parinit: X*Y/=NPROC_IO') if(me_MPI==0)write(*,*)'large subdomain decomposition ',NPROCX_IO,'X',NPROCY_IO @@ -416,7 +418,7 @@ subroutine parinit_groups(min_grids,Pole_singular) if(NPROCX_SUB*NPROCY_SUB==NPROC_SUB)exit ! we found some values that divide NPROC NPROCX_SUB=NPROCX_SUB+1 call CheckStop(NPROCX_SUB>NPROC_SUB,'parinit: bug in NPROCX_SUB algorithm') - enddo + end do case("X*1","Y=1","X") ! divide only in X direction NPROCX_SUB=NPROC_SUB NPROCY_SUB=1 @@ -431,7 +433,7 @@ subroutine parinit_groups(min_grids,Pole_singular) else NPROCX_SUB=NPROC_SUB/2 NPROCY_SUB=2 - endif + end if case("X*2","Y=2") ! divide Y into 2 if(NPROCY_IO==2)then !Y already divided! @@ -440,10 +442,10 @@ subroutine parinit_groups(min_grids,Pole_singular) else NPROCX_SUB=NPROC_SUB/2 NPROCY_SUB=2 - endif + end if case default call CheckStop('parinit: Unknown DOMAIN_DECOM_MODE') - endselect + end select if(me_MPI==0)write(*,*)'each large subdomain divided into',NPROCX_SUB,'X',NPROCY_SUB,' subdomains' call CheckStop(NPROCX_SUB*NPROCY_SUB,NPROC_SUB,'parinit: X*Y/=NPROC_SUB') @@ -458,7 +460,7 @@ subroutine parinit_groups(min_grids,Pole_singular) write(*,*)'change number of processors, or rundomain ',min_grids,GJMAX,NPROCY call CheckStop(GJMAX/NPROCY=0)then largeLIMAX= tlargeimax(ME_IO) @@ -611,7 +613,7 @@ subroutine parinit_groups(min_grids,Pole_singular) i=ME_MPI/(NPROC_MPI/NPROC_IO) largeLIMAX= tlargeimax(i) largeLJMAX= tlargejmax(i) - endif + end if if(ME_SUB==0)write(*,*)ME_IO,'size large subdomain',largeLIMAX,'X',largeLJMAX if(ME_SUB==0)write(*,*)ME_IO,'from ',gi0,',',gj0,'to',gi1,',',gj1 write(*,"(a12,20i6)") "gi ", me_io, me, me_sub, & @@ -623,8 +625,8 @@ subroutine parinit_groups(min_grids,Pole_singular) & Limax must be at least min_grids") call CheckStop(ljmax < min_grids,"Subdomain too small!& & Ljmax must be at least min_grids") - endif -endsubroutine parinit_groups + end if +end subroutine parinit_groups subroutine Topology(cyclicgrid,poles) ! Defines the neighbors and boundaries of (sub)domain @@ -651,13 +653,13 @@ subroutine Topology(cyclicgrid,poles) else neighbor(SOUTH) = NOPROC if(poles(2)==0)lj0 = 2 - endif + end if if(mey 0) then neighbor(WEST) = me-1 li0 = 1 @@ -667,8 +669,8 @@ subroutine Topology(cyclicgrid,poles) if(Cyclicgrid==1)then neighbor(WEST) = me+NPROCX-1 li0 = 1 - endif - endif + end if + end if if(mex < NPROCX-1) then neighbor(EAST) = me+1 li1 = limax @@ -678,10 +680,10 @@ subroutine Topology(cyclicgrid,poles) if(Cyclicgrid==1)then neighbor(EAST) = me-NPROCX+1 li1 = limax - endif - endif + end if + end if -endsubroutine topology +end subroutine topology subroutine Topology_io(cyclicgrid,poles) ! Defines the neighbors and boundaries of (sub)domain ! Boundaries are defined as having coordinates @@ -706,13 +708,13 @@ subroutine Topology_io(cyclicgrid,poles) else neighbor(SOUTH) = NOPROC if(poles(2)==0)lj0 = 2 - endif + end if if(mey 0) then neighbor(WEST) = me_IO-1 li0 = 1 @@ -722,8 +724,8 @@ subroutine Topology_io(cyclicgrid,poles) if(Cyclicgrid==1)then neighbor(WEST) = me_IO+NPROCX_IO-1 li0 = 1 - endif - endif + end if + end if if(mex < NPROCX_IO-1) then neighbor(EAST) = me_IO+1 li1 = largelimax @@ -733,9 +735,9 @@ subroutine Topology_io(cyclicgrid,poles) if(Cyclicgrid==1)then neighbor(EAST) = me_IO-NPROCX_IO+1 li1 = largelimax - endif - endif + end if + end if write(*,*)'topology io',me_mpi,neighbor(EAST),neighbor(WEST),neighbor(SOUTH),neighbor(NORTH) -endsubroutine topology_io +end subroutine topology_io endmodule Par_ml diff --git a/PhyChem_ml.f90 b/PhyChem_ml.f90 index 9f1361b..1008b1f 100644 --- a/PhyChem_ml.f90 +++ b/PhyChem_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -43,30 +43,34 @@ module PhyChem_ml use Derived_ml, only: DerivedProds, Derived, num_deriv2d use DerivedFields_ml, only: d_2d, f_2d use DryDep_ml, only: init_drydep -use EmisDef_ml, only: loc_frac -use Emissions_ml, only: EmisSet,uemep_emis -!use Gravset_ml, only: gravset +use EmisDef_ml, only: loc_frac, loc_frac_day, loc_tot_day, loc_frac_month& + , loc_tot_month,loc_frac_full,loc_tot_full, NSECTORS +use Emissions_ml, only: EmisSet +use Gravset_ml, only: gravset use GridValues_ml, only: debug_proc,debug_li,debug_lj,& glon,glat,projection,i_local,j_local,i_fdom,j_fdom use ModelConstants_ml,only: MasterProc, KMAX_MID, nmax, nstep & ,dt_advec & ! time-step for phyche/advection - ,DEBUG, PPBINV, PPTINV & + ,DEBUG, PPBINV, PPTINV & ,END_OF_EMEPDAY & ! (usually 6am) ,IOU_INST & ,FORECAST & ! use advecdiff_poles on FORECAST mode ,ANALYSIS & ! 3D-VAR Analysis ,SOURCE_RECEPTOR& -! ,USE_GRAVSET& + ,USE_ASH& ,FREQ_HOURLY & ! hourly netcdf output frequency ,USE_POLLEN, USE_EtaCOORDINATES,JUMPOVER29FEB& - ,USE_uEMEP, IOU_HOUR, IOU_HOUR_INST + ,USE_uEMEP, IOU_HOUR, IOU_HOUR_INST, IOU_YEAR& + ,fileName_O3_Top use MetFields_ml, only: ps,roa,z_bnd,z_mid,cc3dmax, & zen,coszen,Idirect,Idiffuse +use NetCDF_ml, only: ReadField_CDF,Real4 use OutputChem_ml, only: WrtChem use My_Outputs_ml , only: NHOURLY_OUT, FREQ_SITE, FREQ_SONDE -use My_Timing_ml, only: Code_timer, Add_2timing, tim_before, tim_after +use My_Timing_ml, only: Code_timer, Add_2timing, tim_before, tim_before0, tim_after use Nest_ml, only: readxn, wrtxn use Par_ml, only: me, LIMAX, LJMAX +use PhysicalConstants_ml, only : ATWAIR use Pollen_ml, only: pollen_dump,pollen_read use SoilWater_ml, only: Set_SoilWater use TimeDate_ml, only: date,daynumber,day_of_year, add_secs, & @@ -74,6 +78,7 @@ module PhyChem_ml make_timestamp, make_current_date use TimeDate_ExtraUtil_ml,only : date2string use Trajectory_ml, only: trajectory_out ! 'Aircraft'-type outputs +use uEMEP_ml, only: uEMEP_emis use Radiation_ml, only: SolarSetup, &! sets up radn params ZenithAngle, &! gets zenith angle ClearSkyRadn, &! Idirect, Idiffuse @@ -93,7 +98,7 @@ module PhyChem_ml subroutine phyche() logical, save :: End_of_Day = .false. - integer :: ndays,status + integer :: ndays,status,nstart,kstart real :: thour type(timestamp) :: ts_now !date in timestamp format logical,save :: first_call = .true. @@ -101,7 +106,6 @@ subroutine phyche() !------------------------------------------------------------------ ! physical and chemical routines. - ! Hours since midnight at any time-step ! using current_date we have already nstep taken into account thour = real(current_date%hour) + current_date%seconds/3600.0 @@ -114,15 +118,27 @@ subroutine phyche() ndays = day_of_year(current_date%year,current_date%month, & current_date%day) write(*,*) 'thour,ndays,nstep,dt', thour,ndays,nstep,dt_advec - endif + end if + end if + + if(trim(fileName_O3_Top)/="NOTSET" .and.& + mod(current_date%hour,3)==0.and.current_date%seconds==0)then + kstart=6!NB: must be the level corresponding to model top! Hardcoded for now + if(DEBUG%PHYCHEM .and. MasterProc)write(*,*)'UPDATING TOP O3 with ',trim(fileName_O3_Top) + !first available day is 2nd January for 2008,2009,2011,2012: + nstart=max(1,8*(daynumber-2)+current_date%hour/3) + !first available day is 2nd January for 2010: + if(current_date%year==2010)nstart=max(1,8*(daynumber-1)+current_date%hour/3) + call ReadField_CDF(trim(fileName_O3_Top),'O3',xn_adv(IXADV_O3,:,:,1),& + nstart=nstart,kstart=kstart,kend=kstart,& + interpol='zero_order',debug_flag=.false.) endif -! if(MasterProc) write(*,"(a15,i6,f8.3)") 'timestep nr.',nstep,thour - call Code_timer(tim_before) call readxn(current_date) !Read xn_adv from earlier runs + if(FORECAST.and.USE_POLLEN) call pollen_read () - call Add_2timing(19,tim_after,tim_before,"nest: Read") + call Add_2timing(15,tim_after,tim_before,"nest: Read") if(ANALYSIS.and.first_call)then call main_3dvar(status) ! 3D-VAR Analysis for "Zero hour" call CheckStop(status,"main_3dvar in PhyChem_ml/PhyChe") @@ -132,22 +148,22 @@ subroutine phyche() write(*,*) 'ANALYSIS DEBUG_DA_1STEP: only 1st assimilation step' call Derived(dt_advec,End_of_Day) return - endif - endif + end if + end if if(FORECAST.and.first_call)then ! Zero hour output call Derived(dt_advec,End_of_Day,ONLY_IOU=IOU_HOUR) ! update D2D outputs, to avoid call WrtChem(ONLY_HOUR=IOU_HOUR) ! eg PM10:=0.0 on first output - call Add_2timing(35,tim_after,tim_before,"phyche:outs") - endif + end if call EmisSet(current_date) - call Add_2timing(15,tim_after,tim_before,"phyche:EmisSet") - ! For safety we initialise instant. values here to zero. - ! Usually not needed, but sometimes - ! ================== + call Add_2timing(12,tim_after,tim_before,"phyche:EmisSet") + + ! For safety we initialise instant. values here to zero. + ! Usually not needed, but sometimes + ! ======================== d_2d(:,:,:,IOU_INST) = 0.0 - ! ================== + ! ======================== !=================================== @@ -165,29 +181,29 @@ subroutine phyche() call CloudAtten(cc3dmax(:,:,KMAX_MID),Idirect,Idiffuse) - !=================================== - call Add_2timing(16,tim_after,tim_before,"phyche:ZenAng") - !================ ! advecdiff_poles considers the local Courant number along a 1D line ! and divides the advection step "locally" in a number of substeps. ! Up north in a LatLong domain such as MACC02, mapfactors go up to four, ! so using advecdiff_poles pays off, even though none of the poles are ! included in the domain. - ! For efficient parallellisation each subdomain needs to have the same work - ! load; this can be obtained by setting NPROCY=1 (number of subdomains in + ! For efficient parallellisation each subdomain needs to have the same work + ! load; this can be obtained by setting NPROCY=1 (number of subdomains in ! latitude- or y-direction). ! Then, all subdomains have exactly the same geometry. + call Code_timer(tim_before0) + if(USE_EtaCOORDINATES)then call advecdiff_Eta else call advecdiff_poles - endif + end if + + call Add_2timing(13,tim_after,tim_before0,"phyche: total advecdiff") -! if(USE_GRAVSET) call gravset + if(USE_ASH) call gravset - call Add_2timing(17,tim_after,tim_before,"phyche:advecdiff") !================ call Code_timer(tim_before) @@ -198,7 +214,6 @@ subroutine phyche() if ( nstep == nmax ) call DerivedProds("Before",dt_advec) !============================= - call Add_2timing(26,tim_after,tim_before,"phyche:prod") !=================================== call Set_SoilWater() @@ -208,16 +223,18 @@ subroutine phyche() call init_drydep() !=================================== + !must be placed just before emissions are used + if(USE_uEMEP)call uemep_emis(current_date) + !=========================================================! call debug_concs("PhyChe pre-chem ") !************ NOW THE HEAVY BIT **************************! - if(USE_uEMEP)call uemep_emis(current_date) - + call Code_timer(tim_before0) call runchem() ! calls setup subs and runs chemistry - call Add_2timing(28,tim_after,tim_before,"Runchem") + call Add_2timing(23,tim_after,tim_before0,"Total Runchem") call debug_concs("PhyChe post-chem ") !*********************************************************! @@ -230,10 +247,6 @@ subroutine phyche() if(nstep==nmax) call DerivedProds("After",dt_advec) !============================= - call Code_timer(tim_before) - !============================= - call Add_2timing(34,tim_after,tim_before,"phyche:drydep") - !============================= ! this output needs the 'old' current_date_hour @@ -256,21 +269,21 @@ subroutine phyche() if(MasterProc)print "(2(1X,A))",'current date and time before jump:',& date2string("YYYY-MM-DD hh:mm:ss",current_date) call add_secs(ts_now,24*3600.) - current_date = make_current_date(ts_now) + current_date = make_current_date(ts_now) if(MasterProc)print "(2(1X,A))",'current date and time after jump:',& date2string("YYYY-MM-DD hh:mm:ss",current_date) - endif + end if + call Code_timer(tim_before) !==================================== - call Add_2timing(35,tim_after,tim_before,"phyche:outs") if(ANALYSIS)then call main_3dvar(status) ! 3D-VAR Analysis for "non-Zero hours" call CheckStop(status,"main_3dvar in PhyChem_ml/PhyChe") call Add_2timing(T_3DVAR,tim_after,tim_before) - endif + end if call wrtxn(current_date,.false.) !Write xn_adv for future nesting if(FORECAST.and.USE_POLLEN) call pollen_dump() - call Add_2timing(18,tim_after,tim_before,"nest: Write") + call Add_2timing(14,tim_after,tim_before,"nest: Write") End_of_Day=(current_date%seconds==0).and.(current_date%hour==END_OF_EMEPDAY) @@ -278,12 +291,16 @@ subroutine phyche() print "(a,a)",' End of EMEP-day ',date2string("(hh:mm:ss)",current_date) if(DEBUG%PHYCHEM)write(*,"(a20,2i4,i6)") "END_OF_EMEPDAY ", & END_OF_EMEPDAY, current_date%hour,current_date%seconds - endif + end if call debug_concs("PhyChe pre-Derived ") + call Derived(dt_advec,End_of_Day) + call Add_2timing(34,tim_after,tim_before,"phyche:Derived") + ! Hourly Outputs: + if(current_date%seconds==0) then if(.not.SOURCE_RECEPTOR .and. FREQ_SITE>0 .and.& @@ -298,7 +315,9 @@ subroutine phyche() modulo(current_date%hour,FREQ_HOURLY)==0) & call hourly_out() - endif + call Add_2timing(35,tim_after,tim_before,"phyche:sites and hourly out") + + end if ! CoDep if(modulo(current_date%hour,1)==0) & ! every hour @@ -308,10 +327,8 @@ subroutine phyche() cfac(IXADV_SO2,:,:),& cfac(IXADV_NH3,:,:)) - call Add_2timing(35,tim_after,tim_before,"phyche:outs") - first_call=.false. -endsubroutine phyche +end subroutine phyche !-------------------------------------------------------------------------- subroutine debug_concs(txt) character(len=*), intent(in) :: txt @@ -330,19 +347,19 @@ subroutine debug_concs(txt) unit = 'ppbv' if(ispec<=NSPEC_SHL) unit='pptv' first_call = .false. - endif + end if if(ispec>NSPEC_SHL)then - c1=xn_adv(iadv,debug_li,debug_lj,KMAX_MID)*PPBINV + c1=xn_adv(iadv,debug_li,debug_lj,KMAX_MID)*PPBINV c2=c1* cfac(iadv,debug_li,debug_lj) else c1=xn_shl(ispec,debug_li,debug_lj,KMAX_MID)*PPTINV c2=-1.0 - endif + end if write(*,"(a,2i3,i5,i3,a12,2g12.4,1x,a4)") "debug_concs:"// & trim(txt), me, current_date%hour, current_date%seconds, nstep,& trim(species(ispec)%name), c1, c2, unit - endif -endsubroutine debug_concs + end if +end subroutine debug_concs !-------------------------------------------------------------------------- endmodule PhyChem_ml diff --git a/PhysicalConstants_ml.f90 b/PhysicalConstants_ml.f90 index 93c9015..eacd795 100644 --- a/PhysicalConstants_ml.f90 +++ b/PhysicalConstants_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/PlumeRise_ml.f90 b/PlumeRise_ml.f90 index f53e79c..9be7ac0 100644 --- a/PlumeRise_ml.f90 +++ b/PlumeRise_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -313,11 +313,11 @@ function plume_nilu(hs, ust, w,d,tg,ta,z2,hmix,v,cl,bh,bw) result (hnew) if (dhp < 0.) then iwash = 1 if (id == 1) dhp = 0. - endif + end if hf = hs + dhp if(debug) print *, "tsd: ", hf - endif + end if ! no downwash below ground @@ -370,7 +370,7 @@ function plume_nilu(hs, ust, w,d,tg,ta,z2,hmix,v,cl,bh,bw) result (hnew) else xf = 0.119*f**(2./5.) dhb = 38.71*f**(3./5.)/up - endif + end if if(debug) print *, "neutrl: ", niter,f, xf, up, dhb else @@ -401,7 +401,7 @@ function plume_nilu(hs, ust, w,d,tg,ta,z2,hmix,v,cl,bh,bw) result (hnew) dhb = min(dhb1,dhb2) if(debug) print *, "stab: ", niter, rs, s, xf, up, dhb1, dhb2 - endif + end if else @@ -423,9 +423,9 @@ function plume_nilu(hs, ust, w,d,tg,ta,z2,hmix,v,cl,bh,bw) result (hnew) dhm = 1.5*((w*w*d*d*ta)/(4.*tg*up))**(1./3.)*s**(-1./6.) - endif + end if - endif + end if ! no momentum rise if stack downwash @@ -463,7 +463,7 @@ function plume_nilu(hs, ust, w,d,tg,ta,z2,hmix,v,cl,bh,bw) result (hnew) testhp = hfl if (diffht <= testhfl) exit - endif + end if ! if (idh .ne. 3 .and. diffht > testhfl .and. & ! niter .le. 100) goto 100 @@ -529,7 +529,7 @@ subroutine penetr(hs,hmix,hfl,idh,hnew) hnew = hs return - endif + end if if (idh == 3) then @@ -539,7 +539,7 @@ subroutine penetr(hs,hmix,hfl,idh,hnew) hnew = hfl return - endif + end if dm = hmix - hs dp = hfl - hs @@ -554,7 +554,7 @@ subroutine penetr(hs,hmix,hfl,idh,hnew) rmp = dm/dp - endif + end if !print *, "rmp ", hmix, hfl, rmp if (rmp >= 1.5) then @@ -581,7 +581,7 @@ subroutine penetr(hs,hmix,hfl,idh,hnew) hpen = hs + (0.62 + 0.38*ps)*dm !print *, "partial p", hnew, hpen - endif + end if ! choose the lowest of effective plume rise and rise due to penetration @@ -646,7 +646,7 @@ subroutine building(bh,bw,hs,v,hf,hp,dhm,idh,iwash) if (iwash == 1) hp = hf return - endif + end if bt = bh + 1.5*bl @@ -669,7 +669,7 @@ subroutine building(bh,bw,hs,v,hf,hp,dhm,idh,iwash) he = 2.*hf - (bh + 1.5*bl) else he = hf - 1.5*bl - endif + end if th = 0.5*bl @@ -687,7 +687,7 @@ subroutine building(bh,bw,hs,v,hf,hp,dhm,idh,iwash) hp = he - endif + end if else @@ -696,9 +696,9 @@ subroutine building(bh,bw,hs,v,hf,hp,dhm,idh,iwash) idh = 3 hp = 0.0 - endif + end if - endif + end if return diff --git a/PointSource_ml.f90 b/PointSource_ml.f90 index e419b4c..ce8deb6 100644 --- a/PointSource_ml.f90 +++ b/PointSource_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -152,7 +152,7 @@ subroutine readstacks(io) fname = "PointSources.txt" !TEST call open_file(io,"r",fname,needed=.true.) call CheckStop(ios,"open_file error on " // fname ) - endif + end if ! First, we read file to get number and list of country codes n = 0 @@ -181,8 +181,8 @@ subroutine readstacks(io) ispec_emis(nemis_found) = ispec icol_emis(nemis_found) = emcol if(MasterProc) print *, "STACKem ", nemis_found, iemis, species(ispec)%name - endif - enddo + end if + end do cycle else @@ -191,7 +191,7 @@ subroutine readstacks(io) lat, long, Ts, diam, Vs, ( emis(nn), nn=1,nemis_cols ) if(MasterProc) print *, "STACK n HERE ", n, ns, trim(txtcode), lat, long - endif + end if n = n + 1 ! number, this emis file ns = ns + 1 ! number, all emis files @@ -230,7 +230,7 @@ subroutine readstacks(io) ncol = icol_emis(nn) stack(ns)%emis(nn) = emis(ncol) if( MasterProc ) print *, "STACK SETS ", ns, nn, ncol, emis(ncol) - enddo + end do if(debug_flag ) write(*,"(a,i5,es10.3)") " StacksEmis ", & ispec_emis(1), ispec_emis(2) !DS iemist, emisa1 @@ -240,7 +240,7 @@ subroutine readstacks(io) me, i, j,iloc,jloc, lat, long, hs, dh4, he, stack(ns)%flow !if ( he > he_max) he_max = he - enddo + end do nstacks = ns if(debug_flag) write(*,*) "Stacks Read. Done" @@ -251,9 +251,9 @@ subroutine readstacks(io) ! if ( layer_z(k) > he_max ) then ! Stacks%kup = k ! exit -! endif -! enddo -endsubroutine readstacks +! end if +! end do +end subroutine readstacks !---------------------------------------------------------------------------- subroutine get_pointsources(i,j, debug_flag) integer, intent(in) :: i,j @@ -288,7 +288,7 @@ subroutine get_pointsources(i,j, debug_flag) write(*,"(a,i3,f10.4,2f10.4,a,2f10.3,es10.2)") & "Plume_ASME: stack he dh",n,he,dh, dtdz, & "Tpot?", Grid%theta_ref, Ta, pp(KMAX_MID) - endif + end if case("NILU") ObukhovL = 1.0e4 ! safety @@ -304,7 +304,7 @@ subroutine get_pointsources(i,j, debug_flag) if (n==1) write(*,"(a,i3,f10.4,f10.4)") "Plume_NILU: stack he dh", & n,he,he - Stack(n)%hs !if (n==1) write(*,*) i,j,GridArea_m2(i,j) - endif + end if case("PVDI") ! Mh: Emitted heat flux in MW, VDI(1985) @@ -316,7 +316,7 @@ subroutine get_pointsources(i,j, debug_flag) case default call CheckStop("Unknown PlumeMethod: "//trim(USES%PlumeMethod)) - endselect + end select dh = he - Stack(n)%hs @@ -349,15 +349,15 @@ subroutine get_pointsources(i,j, debug_flag) if(mydebug) write(*,"(a20,i3,f7.3,3es10.3)") & " StacksEmisRC "//trim(species(ispec)%name), & k, fraction_per_layer(kk), emiss, rcemis(ispec,k) - enddo !kk - enddo ! iemis + end do !kk + end do ! iemis if(mydebug ) write(*,"(a,es10.3,es10.3,a,2es10.3)") " StacksEmisConv ", & uconv,GridArea_m2(i,j),trim(species(ispec)%name),species(ispec)%molwt,emiss - enddo + end do myfirstcall = .false. -endsubroutine get_pointsources +end subroutine get_pointsources !---------------------------------------------------------------------------- subroutine spread_plume( h, w, layer_z, fraction_per_layer,Nz) !gives the fraction of a gaussian distribution between layer_z levels @@ -378,14 +378,14 @@ subroutine spread_plume( h, w, layer_z, fraction_per_layer,Nz) do i=2,Nz-1 fraction_per_layer(i)=gauss_integral(layer_z(i-1),layer_z(i),h,w) - enddo + end do fraction_per_layer(Nz)=gauss_integral(layer_z(Nz-1),large,h,w) !normalize (only to get last digits right) sum=0.0 do i=1,Nz sum=sum+fraction_per_layer(i) - enddo + end do do i=1,Nz fraction_per_layer(i)=fraction_per_layer(i)/sum @@ -393,9 +393,9 @@ subroutine spread_plume( h, w, layer_z, fraction_per_layer,Nz) if( fraction_per_layer(i) > 1.0 ) then print *, "FRAC WRONG ", i, h,w,Nz, fraction_per_layer(i) call CheckStop("FRAC WRONG in spread_plume") - endif - enddo -endsubroutine spread_plume + end if + end do +end subroutine spread_plume !-------------------------------------------------------------------------- real function gauss_integral(x1,x2,x0,sigma) result(integral) @@ -442,7 +442,7 @@ real function errorfunctionc(x_in) result(erfc) do i=1,40,1 y=-y*x*x/i erfc=erfc+y*x/(2*i+1) - enddo + end do erfc=1.0-erfc*2/sqrt(pi) ! write(*,*)'result small x',x_in,erfc else @@ -455,11 +455,11 @@ real function errorfunctionc(x_in) result(erfc) fac=-fac*i y=y*d2x2 erfc=erfc+fac*y - enddo + end do erfc=exp(-x*x)*erfc/(x*sqrt(pi)) ! write(*,*)'result large x',x_in,erfc - endif -endfunction errorfunctionc + end if +end function errorfunctionc !-------------------------------------------------------------------------- @@ -476,7 +476,7 @@ real function errorfunctionc(x_in) result(erfc) ! integer, parameter :: IONUM = 10 ! do i=1,Nz-1 ! layer_z(i)=50+i*50!example -! enddo +! end do ! ! call readstacks(IONUM, Nz, layer_z) ! diff --git a/Precision_ml.f90 b/Precision_ml.f90 index 7a725ab..4a103aa 100644 --- a/Precision_ml.f90 +++ b/Precision_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/README.md b/README.md index 9a4aae4..72c38ed 100644 --- a/README.md +++ b/README.md @@ -1,108 +1,69 @@ -# Open Source EMEP/MSC-W model - -The EMEP models have been instrumental to the development of -air quality policies in Europe since the late 1970s, -mainly through their support to the strategy work under the -[Convention on Long-range Transboundary Air Pollution][CLRTAP]. -In the 1990s the EMEP models became also the reference tools for -atmospheric dispersion calculations as input to the Integrated Assessment Modelling, -which supports the development of air quality polices in the European Union. - -[CLRTAP]: http://www.unece.org/env/lrtap/welcome.html -[GPLv3]: http://www.gnu.org/copyleft/gpl.html -[publ2017]: http://emep.int/publ/emep2017_publications.html -[rel415]: http://github.com/metno/emep-ctm/releases/tag/rv4_15 -[rel410]: http://github.com/metno/emep-ctm/releases/tag/rv4_10 -[rel48]: http://github.com/metno/emep-ctm/releases/tag/rv4_8 -[rel45]: http://github.com/metno/emep-ctm/releases/tag/rv4_5 -[rel44]: http://github.com/metno/emep-ctm/releases/tag/rv4_4 -[rel43]: http://github.com/metno/emep-ctm/releases/tag/rv4_3 -[readme43]: http://github.com/metno/emep-ctm/releases/download/rv4_3/README_rv4_3special.txt -[rel40]: http://github.com/metno/emep-ctm/releases/tag/rv4_0 -[rel201106]:http://github.com/metno/emep-ctm/releases/tag/v201106 -[rel30]: http://github.com/metno/emep-ctm/releases/tag/rv3 - -## Releases -The latest Open Source EMEP/MSC-W model version ([rv4.15][rel415]), -corresponds to the [EMEP status reporting of the year 2017][publ2017]. -The source code, together with a set of input data, -an updated user guide and a full year model results for the year 2015, -under [GPL license v3][GPLv3]. - -#### Previous releases (YYYYMM - date of release) -* [OpenSource rv4.10 (201609)][rel410]. -* [OpenSource rv4.8 (201510)][rel48]. -* [OpenSource rv4.5 (201409)][rel45]. -* [OpenSource rv4.4 (201309)][rel44]. -* [OpenSource rv4.3 (201304)][rel43] *read the file [README_rv4_3special.txt][readme43]*. -* [OpenSource rv4.0 (201209)][rel40]. -* [OpenSource v.2011-06 (201108)][rel201106]. -* [OpenSource rv3 (200802)][rel30]. - -## Documentation -The EMEP/MSC-W model is a chemical transport model developed at the -Meteorological Synthesizing Centre - West (MSC-W) -at the Norwegian Meteorological Institute (met.no). -The EMEP model is a limited-area, terrain following sigma coordinate model -designed to calculate air concentration and deposition fields for - -* acidifying and eutrophying compounds (S, N) -* ground level ozone (O3) -* particulate matter (PM2.5, PM10). - -as well as their long-range transport and fluxes across national boundaries -(Transboundary air pollution). -A history of the development of the EMEP model can be found at -[http://www.emep.int/models][mscwmodels]. - -[mscwmodels]: http://www.emep.int/mscw/models.html#mscwmodels - -### Model Description - -The EMEP MSC-W chemical transport model -- technical description -D. Simpson, A. Benedictow, H. Berge, R. Bergstrõm, L. D. Emberson, H. Fagerli, -C. R. Flechard, G. D. Hayman, M. Gauss, J. E. Jonson, M. E. Jenkin, A. Nyíri, -C. Richter, V. S. Semeena, S. Tsyro, J.-P. Tuovinen, Á. Valdebenito, and P. Wind -Atmos. Chem. Phys., 12, 7825-7865, 2012 -http://www.atmos-chem-phys.net/12/7825/2012/acp-12-7825-2012.html - -### Computer requirements -To compile the EMEP model you need: - -* Fortran 95 compiler -* NetCDF Library (>4.1.3) -* MPI Library (>1.0) - -It is necessary to compile with double precision reals (8 bytes reals). -The program has been used on computers ranging from a Linux laptop -to supercomputers (Itanium2 cluster, Intel Xeon cluster, Cray XT4, IBM power5+). -It is compatible with all compilers tested so far: Intel, PGI, gfortran, XL fortran. -A Makefile is included, the path to netcdf (INCL and LLIB) has to be adapted -to your machine, and to the fortran compiler (F90) and flags (F90FLAGS) -to the compiler you are using. - -The code has been tested with 1 to 1024 CPUs, and scales well (for large grids). -If only one CPU is used 1-2 GB memory is required. -If more than one, for example 64 CPUs are used, 200 MB of memory per CPU is enough -(in the case of a 132 X 159 grid size). -For runs on more than 32 CPUs, a fast interconnect is recommended -(infiniband for example), for smaller runs, gigabit ethernet is sufficient. -It takes ~3.5 hrs on 64*Xeon X5355 (2.66GHz) for a 1-year simulation. - -When downloading input data in order to do a "base run" please make sure that there -are 35 Gb disc space available, especially due to large meteorology input files. -The model can be run for shorter periods, users can download meteorology for -only the period they are interested in, plus one day. - -## Verification -The EMEP/MSC-W model is validated and reported to the -Cooperative Programme for Monitoring and Evaluation of the -Long-range Transmission for Air Pollutants in Europe ([EMEP][]) each year -by the EMEP/MSC-W group. -The reports can be found under the following links: -* [Status Reports][] -* [Country Reports][] - -[EMEP]: http://www.emep.int/ -[Status Reports]: http://www.emep.int/publ/common_publications.html -[Country Reports]:http://www.emep.int/mscw/mscw_datanotes.html +# EMEP MSC-W OPEN SOURCE CODE - 2017 + +The source code in this 2017 release is essentially that used to model +air pollution in the year 2015 (rv4.15), as reported in EMEP MSC-W Status +Report 1/2017 (www.emep.int). For basic documentation of the model see +the file CITATION.txt which is released with the code. A major difference +in the model setup this year is a finer resolution, namely 0.1x0.1 +degree in the horizontal and 34 layers in the vertical. Furthermore, +this model version has had several major coding and data-input changes +since the 2016 release, and in many ways should be seen as an interim +version of the model. Here we just list some specific issues associated +with the code and model usage. + + +## 34-layers + +The use of 34 layers rather than 20 is very new to the EMEP model, +and some aspects of the model formulation may need to be revised if we +continue with this setup. In particular the dry-deposition formulation +was originally designed for thicker (ca. 90 m) lower-layers, and may +need modification to cope with the new structure. + +The revised model still works however with the 20 layer meteorology as +provided with previous releases, and indeed is still flexible in terms +of allowing additional layers within the 20-layer structure (through +interpolation) or for use with e.g. WRF meteorology. + + +## Shipping emissions + +The new IMO (International Maritime Organization) regulation on sulfur +emissions from international shipping, which came into effect in January +2015, has led to a significant reduction in sulfur emissions within +the so-called Sulfur Emission Control Areas (SECAs) in Europe, i.e. the +Baltic Sea and the North Sea. The MACC-TNO-III data set for 2011, which +was used for EMEP reporting until last year could thus not be used any +longer, 2011 SOx emissions are significantly larger than those of 2015. + +A new data set (see Status Report 1/2017) has been made available to us +for 2015 by the Finnish Meteorological Institute (FMI). It is based on +accurate ship position data from AIS (Automated Identification System) +and also takes into account the new IMO regulations. As part of the +Copernicus Atmospheric Monitoring Service (CAMS), ship emissions will +be calculated by FMI also for years after 2015, and it is assumed that +data for 2016 will arrive in time for next year's EMEP reporting. + +Unfortunately, this situation results in an inconsistency in data-sources +between the MACC-TNO-III data and the FMI data. Users should be aware of +this and make appropriate choices when running years other than 2015. + +Implementation of these new emissions into the EMEP model was rather +hurried, with the new emissions in a special format, and with specific +code changes to cope with this format. For future releases of the model +we will re-format the emissions to comply with the usual EMEP formats, +and eliminate special coding as far as possible. + +## Code structure + +Some code from `ModelConstants_ml.f90` has been moved into a new +`emep_Config_mod.f90` module. The aim is to restore `ModelConstants_ml.f90` to +its original role as a place to store some model-specific variables, and +to let `emep_Config_mod.f90` take over the operations of reading namelists +and setting the configuration variables. This work has only just started, +however, and so unfortunately the current release has configuration +variables in both modules. This will be rectified in future release. + +(The suffix `_mod` will also be used in future to represent module, rather +than ml as used prevously, since `_mod` seems to be gaining ground among +other fortran projects.) diff --git a/Radiation_ml.f90 b/Radiation_ml.f90 index 71e01ee..40e158b 100644 --- a/Radiation_ml.f90 +++ b/Radiation_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -414,7 +414,7 @@ subroutine ScaleRad(ObsRad, Idrctt,Idfuse) if (Scale <0.1 .or. Scale>10.0) then print "(a35,2f10.3)","Obs and Mod Radiation large diff", & ObsRad,Idrctt+Idfuse - endif + end if end if Idrctt=Scale*Idrctt Idfuse=Scale*Idfuse diff --git a/Rb_ml.f90 b/Rb_ml.f90 index bf8ff9a..e489110 100644 --- a/Rb_ml.f90 +++ b/Rb_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -30,7 +30,7 @@ module Rb_ml use ModelConstants_ml, only : DEBUG_RB use PhysicalConstants_ml, only : KARMAN -use Wesely_ml, only :Wesely_tab2 & ! Wesely Table 2 for 14 gases +use GasParticleCoeffs_ml, only : DryDepDefs & ! Table for 64 gases ,Rb_cor ! implicit none private @@ -48,7 +48,7 @@ subroutine Rb_gas(water,ustar,z0,DRYDEP_GAS,Rb) logical, intent(in) :: water real, intent(in) :: ustar, z0 integer, dimension(:), intent(in) :: & - DRYDEP_GAS ! Array with Wesely indices of gases wanted + DRYDEP_GAS ! Array with DryDepDefs indices of gases wanted ! Output: @@ -57,7 +57,7 @@ subroutine Rb_gas(water,ustar,z0,DRYDEP_GAS,Rb) ! Working values: integer :: icmp ! gaseous species - integer :: iwes ! gaseous species, Wesely tables + integer :: iwes ! gaseous species, DryDepDefs tables real, parameter :: D_H2O = 0.21e-4 ! Diffusivity of H2O, m2/s real :: D_i ! Diffusivity of gas species, m2/s @@ -74,7 +74,7 @@ subroutine Rb_gas(water,ustar,z0,DRYDEP_GAS,Rb) if ( water ) then - D_i = D_H2O / Wesely_tab2(1,iwes) ! CORR ! + D_i = D_H2O / DryDepDefs(1,iwes) ! CORR ! Rb(icmp) = log( z0 * KARMAN * ustar/ D_i ) Rb(icmp) = Rb(icmp)/(ustar*KARMAN) diff --git a/ReadField_ml.f90 b/ReadField_ml.f90 index 49ec729..6c327ed 100644 --- a/ReadField_ml.f90 +++ b/ReadField_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -53,7 +53,7 @@ Module ReadField_ml use Io_ml, only : ios, open_file implicit none - integer,private :: i, j, n, INFO ! Local variables + integer,private :: i, j ! Local variables interface ReadField module procedure ReadField_r @@ -107,10 +107,10 @@ subroutine ReadField_r(IO_INFILE,fname,local_field,needed_found,fill_needed) j < 1 .or. j > JJFULLDOM ) then errmsg = "error in i,j index in IO_INFILE=" exit READFIELD - endif + end if in_field(i,j) = in_field(i,j) + tmpin cell_set(i,j) = .true. - enddo READFIELD + end do READFIELD close(IO_INFILE) call CheckStop( errmsg ,"ReadField_r: errmsg in ReadField") @@ -120,8 +120,8 @@ subroutine ReadField_r(IO_INFILE,fname,local_field,needed_found,fill_needed) end if ios=0 - endif - endif !me==0 + end if + end if !me==0 call MPI_BCAST( ios, 1, MPI_INTEGER, 0, MPI_COMM_CALC,IERROR) @@ -131,7 +131,7 @@ subroutine ReadField_r(IO_INFILE,fname,local_field,needed_found,fill_needed) if(present(needed_found))needed_found=.true. call global2local(in_field,local_field,MSG_READ7 & ,1,IIFULLDOM,JJFULLDOM,1,IRUNBEG,JRUNBEG) - endif + end if end subroutine ReadField_r !>=========================================================================< @@ -173,10 +173,10 @@ subroutine ReadField_i(IO_INFILE,fname,local_field,needed_found,fill_needed) j < 1 .or. j > JJFULLDOM ) then errmsg = "error in i,j index in IO_INFILE=" // fname exit READFIELD - endif + end if in_field(i,j) = in_field(i,j) + intmp cell_set(i,j) = .true. - enddo READFIELD + end do READFIELD close(IO_INFILE) call CheckStop( errmsg ,"ReadField: errmsg in ReadField") ios=0 @@ -185,9 +185,9 @@ subroutine ReadField_i(IO_INFILE,fname,local_field,needed_found,fill_needed) call CheckStop( any( cell_set .eqv. .false. ) ,& "ERROR: ReadField_i: cell_not_set "//trim(fname)) end if - endif + end if - endif !me==0 + end if !me==0 call MPI_BCAST( ios, 1, MPI_INTEGER, 0, MPI_COMM_CALC,IERROR) @@ -197,7 +197,7 @@ subroutine ReadField_i(IO_INFILE,fname,local_field,needed_found,fill_needed) if(present(needed_found))needed_found=.true. call global2local_int(in_field,local_field,MSG_READ5 & ,IIFULLDOM,JJFULLDOM,1,IRUNBEG,JRUNBEG) - endif + end if end subroutine ReadField_i !>=========================================================================< @@ -233,13 +233,13 @@ subroutine ReadField_3dr(IO_INFILE,fname,DIM3,local_field,opened) j < 1 .or. j > JJFULLDOM ) then errmsg = "error in i,j index in IO_INFILE=" !!! ,fname, i,j exit READFIELD - endif + end if in_field(i,j,:) = in_field(i,j,:) + tmpin(:) - enddo READFIELD + end do READFIELD close(IO_INFILE) call CheckStop(errmsg, "ReadField_r: error reading" // fname ) - endif !me==0 + end if !me==0 call global2local(in_field,local_field,MSG_READ7 & ,1,IIFULLDOM,JJFULLDOM,DIM3,IRUNBEG,JRUNBEG) @@ -272,13 +272,13 @@ subroutine ReadField_3di(IO_INFILE,fname,DIM3,local_field) j < 1 .or. j > JJFULLDOM ) then errmsg = "error in i,j index in IO_INFILE=" // fname exit READFIELD - endif + end if in_field(i,j,:) = in_field(i,j,:) + intmp(:) - enddo READFIELD + end do READFIELD close(IO_INFILE) call CheckStop(errmsg," ReadField_3di: error reading" // fname) - endif !me==0 + end if !me==0 call global2local_int(in_field,local_field,MSG_READ5 & ,IIFULLDOM,JJFULLDOM,DIM3,IRUNBEG,JRUNBEG) diff --git a/Rsurface_ml.f90 b/Rsurface_ml.f90 index a31b5c9..3c18434 100644 --- a/Rsurface_ml.f90 +++ b/Rsurface_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -39,7 +39,7 @@ module Rsurface_ml use ModelConstants_ml, only: DEBUG, NO_CROPNH3DEP use Radiation_ml, only : CanopyPAR use TimeDate_ml, only : current_date -use Wesely_ml, only : Wesely_tab2 & ! Wesely Table 2 for 14 gases +use GasParticleCoeffs_ml, only : DryDepDefs & ! Extension of Wesely Table 2 ,WES_HNO3, WES_NH3,DRx,WES_SO2 ! Indices and Ratio of diffusivities to ozone use MetFields_ml, only : foundsdepth, foundice use Par_ml,only :me @@ -48,8 +48,6 @@ module Rsurface_ml public :: Rsurface INCLUDE 'mpif.h' -INTEGER STATUS(MPI_STATUS_SIZE),INFO - real, public, save :: Rinc, RigsO, GnsO, RgsS @@ -121,7 +119,7 @@ subroutine Rsurface(i,j,DRYDEP_CALC,Gsto,Rsur,errmsg,debug_arg,fsnow) ! Input: integer, intent(in) :: i,j integer, dimension(:), intent(in) :: & - DRYDEP_CALC ! Array with Wesely indices of gases wanted + DRYDEP_CALC ! Array with DryDepDefs indices of gases wanted ! Output: @@ -154,11 +152,11 @@ subroutine Rsurface(i,j,DRYDEP_CALC,Gsto,Rsur,errmsg,debug_arg,fsnow) ! Working values: integer :: icmp ! gaseous species - integer :: iwes ! gaseous species, Wesely tables + integer :: iwes ! gaseous species, DryDepDefs tables logical :: canopy & ! For SAI>0, .e.g grass, forest, also in winter ,leafy_canopy ! For LAI>0, only when green real, parameter :: SMALLSAI= 0.05 ! arbitrary value but small enough - real :: Hstar, f0 ! Wesely tabulated Henry's coeff.'s, reactivity + real :: Hstar, f0 ! DryDepDefs tabulated Henry's coeff.'s, reactivity real :: Rgs ! real :: GigsO real :: RsnowS, RsnowO !surface resistance for snow_flag, S and O3 @@ -343,8 +341,8 @@ subroutine Rsurface(i,j,DRYDEP_CALC,Gsto,Rsur,errmsg,debug_arg,fsnow) !------------------------------------------------------------------------- ! Calculate the Wesely variables Hstar (solubility) and f0 (reactivity) - Hstar =Wesely_tab2(2,iwes) !Extract H*'s - f0 =Wesely_tab2(5,iwes) !Extract f0's + Hstar =DryDepDefs(2,iwes) !Extract H*'s + f0 =DryDepDefs(5,iwes) !Extract f0's !------------------------------------------------------------------------- diff --git a/Runchem_ml.f90 b/Runchem_ml.f90 index 449cec8..85ea75b 100644 --- a/Runchem_ml.f90 +++ b/Runchem_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -34,7 +34,7 @@ module RunChem_ml use AerosolCalls, only: AerosolEquilib & !-> My_MARS, My_EQSAM, & - ,Aero_water, Aero_water_MARS !DUST -> USE_DUST + ,Aero_water, Aero_water_MARS use My_Timing_ml, only: Code_timer, Add_2timing, & tim_before, tim_after use AOD_PM_ml, only: AOD_Ext @@ -45,9 +45,10 @@ module RunChem_ml use Chemfields_ml, only: xn_adv ! For DEBUG use Chemsolver_ml, only: chemistry use ChemSpecs ! DEBUG ONLY + use ColumnSource_ml, only: Winds, getWinds use DefPhotolysis_ml, only: setup_phot use DryDep_ml, only: drydep - use DustProd_ml, only: WindDust + use DustProd_ml, only: WindDust !DUST -> USE_DUST use FastJ_ml, only: setup_phot_fastj,phot_fastj_interpolate use GridValues_ml, only: debug_proc, debug_li, debug_lj, i_fdom, j_fdom use Io_Progs_ml, only: datewrite @@ -57,8 +58,10 @@ module RunChem_ml KMAX_MID, END_OF_EMEPDAY, nstep, & AERO, USES, & ! need USES%EMISSTACKS USE_FASTJ, & + dt_advec, USE_NOCHEM, & ! for Emergency DEBUG_EMISSTACKS, & ! MKPS - DebugCell, DEBUG ! RUNCHEM + DebugCell, DEBUG, & ! RUNCHEM + USE_PreADV use OrganicAerosol_ml,only: ORGANIC_AEROSOLS, OrganicAerosol, & Init_OrganicAerosol, & Reset_OrganicAerosol, & @@ -71,7 +74,7 @@ module RunChem_ml use Setup_1d_ml, only: setup_1d, setup_rcemis, reset_3d use Setup_1dfields_ml,only: first_call, & amk, rcemis, xn_2d ! DEBUG for testing - use TimeDate_ml, only: current_date,daynumber + use TimeDate_ml, only: current_date,daynumber,print_date !-------------------------------- implicit none private @@ -84,15 +87,13 @@ module RunChem_ml subroutine runchem() ! local - integer :: i, j, n + integer :: i, j integer :: errcode integer :: nmonth, nday, nhour - logical :: Jan_1st, End_of_Run + logical :: Jan_1st logical :: debug_flag ! => Set true for selected i,j logical, save :: first_tstep = .true. ! J16 - logical :: dbg character(len=*), parameter :: sub='RunChem:' - character(len=10) :: dbgtxt ! ============================= nmonth = current_date%month nday = current_date%day @@ -106,6 +107,10 @@ subroutine runchem() call CheckStop(SOA_MODULE_FLAG == "NotUsed", & ! Just safety "Wrong My_SOA? Flag is "// trim(SOA_MODULE_FLAG) ) +!TEMPORARY HERE could be put in Met_ml + if( (.not. first_call) .and. USE_PreADV)then + call getWinds + endif ! Processes calls errcode = 0 @@ -121,19 +126,24 @@ subroutine runchem() if(DEBUG%RUNCHEM.and.debug_proc) then debug_flag = (debug_li==i .and. debug_lj==j) DebugCell = debug_flag + DEBUG%datetxt = print_date(current_date) if(debug_flag) write(*,*) "RUNCHEM DEBUG START!" - endif + end if !write(*,"(a,4i4)") "RUNCHEM DEBUG IJTESTS", debug_li, debug_lj, i,j !write(*,*) "RUNCHEM DEBUG LLTESTS", me,debug_proc,debug_flag ! Prepare some near-surface grid and sub-scale meteorology for MicroMet call Get_CellMet(i,j,debug_flag) + call Add_2timing(24,tim_after,tim_before,"Runchem:Get_CellMet ") ! we need to get the gas fraction of semivols: if ( ORGANIC_AEROSOLS ) call Init_OrganicAerosol(i,j,debug_flag) + call Add_2timing(25,tim_after,tim_before,"Runchem:OrganicAerosol") - call setup_1d(i,j) + call setup_1d(i,j) ! Extracting i,j column data + call Add_2timing(26,tim_after,tim_before,"Runchem:setup_1d") call setup_rcemis(i,j) ! Sets initial rcemis=0.0 + call Add_2timing(27,tim_after,tim_before,"Runchem:setup_rcemis ") if(USE_SEASALT) & call SeaSalt_flux(i,j,debug_flag) ! sets rcemis(SEASALT_...) @@ -153,7 +163,6 @@ subroutine runchem() call setup_bio(i,j) ! Adds bio/nat to rcemis call emis_massbudget_1d(i,j) ! Adds bio/nat to rcemis - call Add_2timing(28,tim_after,tim_before,"Runchem:setup_cl/bio") if(USE_FASTJ)then ! call setup_phot_fastj(i,j,errcode,0)! recalculate the column @@ -161,10 +170,9 @@ subroutine runchem() call phot_fastj_interpolate(i,j,errcode) else call setup_phot(i,j,errcode) - endif + end if call CheckStop(errcode,"setup_photerror in Runchem") - call Add_2timing(29,tim_after,tim_before,"Runchem:1st setups") if(DEBUG%RUNCHEM.and.debug_flag) & call datewrite("Runchem Pre-Chem", (/ rcemis(NO,20), & @@ -177,15 +185,20 @@ subroutine runchem() call OrganicAerosol(i,j,first_tstep,debug_flag) ! J16 first_tstep added if(DEBUG%RUNCHEM) call check_negs(i,j,'B') - call Add_2timing(30,tim_after,tim_before,"Runchem:2nd setups") - call Add_2timing(27,tim_after,tim_before,"Runchem:setup_1d+rcemis") - + call Add_2timing(28,tim_after,tim_before,"Runchem:other setups") ! if(DEBUG%RUNCHEM.and.debug_flag) & ! call datewrite("RUNCHEM PRE-CHEM",(/xn_2d(PPM25,20),xn_2d(AER_BGNDOC,20)/)) ! !------------------------------------------------- ! !------------------------------------------------- ! !------------------------------------------------- - call chemistry(i,j,DEBUG%RUNCHEM.and.debug_flag) + + if( .not. USE_NOCHEM) then + call chemistry(i,j,DEBUG%RUNCHEM.and.debug_flag) + else + xn_2d(NSPEC_SHL+1:NSPEC_TOT,:) = xn_2d(NSPEC_SHL+1:NSPEC_TOT,:) & + +rcemis(NSPEC_SHL+1:NSPEC_TOT,:)*dt_advec + end if + if(DEBUG%RUNCHEM) call check_negs(i,j,'C') ! !------------------------------------------------- ! !------------------------------------------------- @@ -194,34 +207,37 @@ subroutine runchem() call datewrite("Runchem Post-Chem",(/xn_2d(NO,20),xn_2d(C5H8,20)/)) !_________________________________________________ - call Add_2timing(31,tim_after,tim_before,"Runchem:chemistry") + call Add_2timing(29,tim_after,tim_before,"Runchem:chemistry") ! Alternating Dry Deposition and Equilibrium chemistry ! Check that one and only one eq is chosen if(mod(nstep,2)/=0) then call AerosolEquilib(debug_flag) + call Add_2timing(30,tim_after,tim_before,"Runchem:AerosolEquilib") if(DEBUG%RUNCHEM) call check_negs(i,j,'D') !if(AERO%EQUILIB=='EMEP' ) call ammonium() !if(AERO%EQUILIB=='MARS' ) call My_MARS(debug_flag) !if(AERO%EQUILIB=='EQSAM') call My_EQSAM(debug_flag) call DryDep(i,j) + call Add_2timing(31,tim_after,tim_before,"Runchem:DryDep") if(DEBUG%RUNCHEM) call check_negs(i,j,'E') else !do drydep first, then eq call DryDep(i,j) + call Add_2timing(31,tim_after,tim_before,"Runchem:DryDep") if(DEBUG%RUNCHEM) call check_negs(i,j,'F') call AerosolEquilib(debug_flag) + call Add_2timing(30,tim_after,tim_before,"Runchem:AerosolEquilib") if(DEBUG%RUNCHEM) call check_negs(i,j,'G') !if(AERO%EQUILIB=='EMEP' ) call ammonium() !if(AERO%EQUILIB=='MARS' ) call My_MARS(debug_flag) !if(AERO%EQUILIB=='EQSAM') call My_EQSAM(debug_flag) - endif + end if !???????????????????????????????????????????????????? - call Add_2timing(32,tim_after,tim_before,"Runchem:ammonium+Drydep") - if(prclouds_present) then call WetDeposition(i,j,debug_flag) call check_negs(i,j,'H') + call Add_2timing(32,tim_after,tim_before,"Runchem:WetDeposition") end if !Should be no further concentration changes due to emissions or deposition @@ -233,7 +249,7 @@ subroutine runchem() if(USE_AOD) & call AOD_Ext(i,j,debug_flag) - ! Calculates PM water: 1. for ambient condition (3D) + ! Calculates PM water: 1. for ambient Rh and T (3D) ! and for filter equlibration conditions (2D at surface) ! T=20C and Rh=50% for comparability with gravimetric PM call Aero_water_MARS(i,j, debug_flag) @@ -253,11 +269,11 @@ subroutine runchem() call Add_2timing(33,tim_after,tim_before,"Runchem:post stuff") first_call = .false. ! end of first call - enddo ! j - enddo ! i + end do ! j + end do ! i first_tstep = .false. ! end of first call over all i,j -endsubroutine runchem +end subroutine runchem !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine check_negs(i,j,txt) integer, intent(in) :: i,j diff --git a/SOA_ml.f90 b/SOA_ml.f90 index 34c06d4..1d2e373 100644 --- a/SOA_ml.f90 +++ b/SOA_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -174,8 +174,8 @@ subroutine Init_OrganicAerosol(i,j,debug_flag) nonvolpcm = find_index( 'NONVOLPCM', chemgroups(:)%name ) nvabsom = find_index( 'NVABSOM', chemgroups(:)%name ) - if( nonvolpcm > 0 ) NUM_NONVOLPCM = size(chemgroups(nonvolpcm)%ptr) - if( nvabsom > 0 ) NUM_NVABSOM = size(chemgroups(nvabsom)%ptr) + if( nonvolpcm > 0 ) NUM_NONVOLPCM = size(chemgroups(nonvolpcm)%specs) + if( nvabsom > 0 ) NUM_NVABSOM = size(chemgroups(nvabsom)%specs) if( MasterProc ) then write(*,*) dtxt//"itot_bgnd, om25sum = ", itot_bgnd, itot_om25, igrp_om25 @@ -248,7 +248,7 @@ subroutine Init_OrganicAerosol(i,j,debug_flag) Fpart(:,:) = 0.0 - Fpart(chemgroups(nonvolpcm)%ptr,:) = 1.0 + Fpart(chemgroups(nonvolpcm)%specs,:) = 1.0 Fgas(:,:) = max(0.0, 1.0 - Fpart(:,:) ) !NOT needed Fgas3d(S1:S2,i,j,:)=Fgas(S1:S2,:) ! J29 @@ -316,7 +316,7 @@ subroutine OrganicAerosol(i_pos,j_pos,first_tstep,debug_flag) ! NVABSOM - Only include fine OM! That is no EC and no coarse OM! do i = 1, NUM_NVABSOM ! OA/OC for POC about 1.333 - ispec = chemgroups(nvabsom)%ptr(i) + ispec = chemgroups(nvabsom)%specs(i) ug_nonvol(i,:) = molcc2ugm3 * xn(ispec,:)*species(ispec)%molwt @@ -364,7 +364,7 @@ subroutine OrganicAerosol(i_pos,j_pos,first_tstep,debug_flag) "Ci* ", "Ki"," ", "Fpart", "ng" do i = 1, NUM_NONVOLPCM - ispec = chemgroups(nonvolpcm)%ptr(i) + ispec = chemgroups(nonvolpcm)%specs(i) write(unit=6,fmt="(a4,i3,a15,es10.2,2f10.3)")& "NVOL", ispec,& species(ispec)%name, xn(ispec,K2),-999.999, & @@ -433,7 +433,7 @@ subroutine Reset_OrganicAerosol(i_pos,j_pos,debug_flag) if ( first_call .and. debug_proc ) then J16tmp = xn(itot_bgnd,20) ! just for printout write(*,*) "Into Reset Organic Aerosol?",& - itot_bgnd , first_call, size(chemgroups(igrp_om25)%ptr) + itot_bgnd , first_call, size(chemgroups(igrp_om25)%specs) end if @@ -449,12 +449,12 @@ subroutine Reset_OrganicAerosol(i_pos,j_pos,debug_flag) xn(itot_om25,:) = 0.0 if( dbg ) write(*,*) 'OFSOA scaling ', xn2ug1MW, molcc2ugm3, & - size(chemgroups(igrp_om25)%ptr) + size(chemgroups(igrp_om25)%specs) !cf xn(itot_bgnd,:) = COA(:)/(molcc2ugm3*species(itot_bgnd)%molwt) - do n = 1, size(chemgroups(igrp_om25)%ptr) + do n = 1, size(chemgroups(igrp_om25)%specs) - itot = chemgroups(igrp_om25)%ptr(n) + itot = chemgroups(igrp_om25)%specs(n) ! NOTE ! Assumes molwt is 1.0 for itot_om25 xn(itot_om25,:) = xn(itot_om25,:) + & diff --git a/SeaSalt_ml.f90 b/SeaSalt_ml.f90 index 2cc6166..e462320 100644 --- a/SeaSalt_ml.f90 +++ b/SeaSalt_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -80,7 +80,6 @@ module SeaSalt_ml logical, private, save :: my_first_call = .true. logical, private, save :: seasalt_found - integer, private, save :: iseasalt ! index of SEASALT_F ! Indices for the species defined in this routine. Only set if found ! Hard-coded for 2 specs just now. Could extend and allocate. @@ -209,7 +208,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) whitecap = 4.82e-6 * (u10 + 1.98)**3 else whitecap = 4.82e-6 * (23.09 + 1.98)**3 !7.594 ! - endif + end if end select if(DEBUG%SEASALT .and. debug_flag) & @@ -228,7 +227,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) Tw = sst(i,j,1) else Tw = Grid%t2 - endif + end if Tw = max(Tw, 270.0)! prevents unrealistic sub.zero values Tw = min(Tw, 300.0)! prevents unrealistic high values @@ -248,7 +247,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) if(DEBUG%SEASALT .and. debug_flag) write(6,'(a20,i5,es13.4)') & 'SSALT Flux Maarten -> ',ii, ss_flux(ii) - enddo + end do !... Fluxes of larger aerosols for each size bin (Monahan etal,1986) do ii = 1, SS_MONA @@ -263,7 +262,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) if(DEBUG%SEASALT .and. debug_flag) & write(6,'(a20,i5,es13.4)') 'SSALT Flux Monah -> ',ii, ss_flux(jj) - enddo + end do if(DEBUG%SEASALT .and. debug_flag) & write(6,'(a20,es13.3)') 'SSALT Total SS flux -> ', total_flux @@ -290,7 +289,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) * water_fraction(i,j) if(DEBUG%SEASALT .and. debug_flag) & write(6,'(a20,i5,2es13.4)') 'SSALT Flux fine -> ',ii,d3(ii), rcss( iSSFI ) !ESX SS_prod(QSSFI,i,j) - enddo + end do !..Coarse particles emission [molec/cm3/s] do ii = NFIN+1, NFIN+NCOA @@ -300,7 +299,7 @@ subroutine SeaSalt_flux (i,j, debug_flag) * water_fraction(i,j) if(DEBUG%SEASALT .and. debug_flag) & write(6,'(a20,i5,2es13.4)') 'SSALT Flux coarse -> ',ii,d3(ii), rcss( iSSCO ) !ESX SS_prod(QSSCO,i,j) - enddo + end do !... Crude fix for the effect of lower salinity in the Baltic Sea @@ -309,14 +308,14 @@ subroutine SeaSalt_flux (i,j, debug_flag) rcss( iSSFI ) = 0.2 * rcss( iSSFI ) rcss( iSSCO ) = 0.2 * rcss( iSSCO ) - endif + end if if(DEBUG%SEASALT .and. debug_flag) write(6,'(a35,2es15.4)') & '>> SSALT production fine/coarse >>', & rcss( iSSFI ), rcss( iSSCO ) - endif ! water - enddo ! LU classes + end if ! water + end do ! LU classes EmisNat( inat_SSFI, i,j ) = rcss( iSSFI ) * moleccm3s_2_kgm2h * species( itot_SSFI )%molwt EmisNat( inat_SSCO, i,j ) = rcss( iSSCO ) * moleccm3s_2_kgm2h * species( itot_SSCO )%molwt @@ -435,7 +434,7 @@ subroutine init_seasalt ! umWetRad(RLIM(i+1), 0.8, GbSeaSalt),& ! umWetRad(RLIM(i), 0.8, GbSeaSalt) end if - enddo + end do !.. Help parameter do i = 1, SS_MONA @@ -445,7 +444,7 @@ subroutine init_seasalt !st update /3.84e-6 temp_Monah(i) = 1.373 * radSS(i)**(-3) * Rrange(i) * temp_Monah(i) = 3.5755e5 * radSS(i)**(-3) * Rrange(i) * & ( 1.0 + 0.057 * radSS(i)**1.05 )* 10.0**a2 - enddo + end do !// D_dry^3 - for production of dry SS mass dSS3(:) = ( 2.0 * rdry(:) )**3 diff --git a/Setup_1d_ml.f90 b/Setup_1d_ml.f90 index d6a48ad..880b144 100644 --- a/Setup_1d_ml.f90 +++ b/Setup_1d_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -43,14 +43,16 @@ module Setup_1d_ml use ColumnSource_ml, only: ColumnRate use DerivedFields_ml, only: d_2d, f_2d use EmisDef_ml, only: gridrcemis, gridrcroadd, KEMISTOP,Emis_4D,N_Emis_4D,Found_Emis_4D& - , O_NH3, O_DMS -use EmisGet_ml, only: nrcemis, iqrc2itot !DSRC added nrcemis -use Emissions_ml, only: SumSplitEmis + , O_NH3, O_DMS, SumSplitEmis& + ,AISco, AISnox, AISsox, AISso4, AISash, AISec , AISoc, FOUND_Special_ShipEmis& + ,NO_ix,NO2_ix,SO2_ix,SO4_ix,CO_ix,REMPPM25_ix& + ,EC_F_FFUEL_NEW_ix,EC_F_FFUEL_AGE_ix,POM_F_FFUEL_ix +use EmisGet_ml, only: nrcemis, iqrc2itot use ForestFire_ml, only: Fire_rcemis, burning use Functions_ml, only: Tpot_2_T use ChemFields_ml, only: SurfArea_um2cm3 use ChemSpecs !, only: SO4,C5H8,NO,NO2,SO2,CO, -use ChemRates_rct_ml, only: set_rct_rates, rct +use ChemRates_rct_ml, only: set_rct_rates, rct, NRCT use GridValues_ml, only: xmd, GridArea_m2, & debug_proc, debug_li, debug_lj,& A_mid,B_mid,gridwidth_m,dA,dB,& @@ -67,16 +69,16 @@ module Setup_1d_ml ,SKIP_RCT & ! kHet tests ,dt_advec & ! time-step ,IOU_INST & ! for OUTMISC - ,MasterProc & - ,PPB, PT & ! Pressure at top - ,USES & ! Forest fires so far + ,MasterProc & + ,PPB, PT & ! PT-pressure at top + ,USES & ! forest fires, hydrolysis, dergee_days etc. ,USE_SEASALT & ,USE_LIGHTNING_EMIS, USE_AIRCRAFT_EMIS & ,USE_GLOBAL_SOILNOX, USE_DUST, USE_ROADDUST & ,USE_OCEAN_NH3,USE_OCEAN_DMS,FOUND_OCEAN_DMS& ,VOLCANO_SR & ! Reduce Volcanic Emissions ,emis_inputlist & ! Used in EEMEP - ,KMAX_MID ,KMAX_BND, KCHEMTOP ! Start and upper k for 1d fields + ,KMAX_MID ,KMAX_BND, KCHEMTOP ! Upper layer (k), upper level, and k for 1d fields use My_Derived_ml, only: EmisSplit_OUT use Landuse_ml, only: water_fraction, ice_landcover use Par_ml, only: me, & @@ -84,14 +86,14 @@ module Setup_1d_ml use PhysicalConstants_ml,only: ATWAIR, AVOG, PI, GRAV, T0 use Radiation_ml, only: PARfrac, Wm2_uE use Setup_1dfields_ml, only: & - xn_2d & ! concentration terms - ,rcemis, deltaZcm & ! emission terms and layer thickness + xn_2d & ! concentration terms (molec/cm3) + ,rcemis, deltaZcm & ! emission terms and lowest layer thickness ,rh, temp, tinv, itemp,pp & ! ,amk, o2, n2, h2o & ! Air concentrations ,cN2O5, cHO2, cO3, cHNO3 & ! mol speeds, m/s - ,cNO2, cNO3 & ! mol speeds, m/s, kHet tests - ,gamN2O5 & !kHet for printout - ,DpgNw,S_m2m3 & ! for wet diameter and surf area + ,cNO2, cNO3 & ! mol speeds, m/s, kHetero tests + ,gamN2O5 & ! kHetero test - for printout + ,DpgNw, S_m2m3 & ! for wet diameter and surf area ,aero_fom, aero_fbc, aero_fss, aero_fdust use SmallUtils_ml, only: find_index use Tabulations_ml, only: tab_esat_Pa @@ -104,24 +106,19 @@ module Setup_1d_ml private !-----------------------------------------------------------------------! -public :: setup_1d ! Extracts results for i,j column from 3-D fields -public :: setup_rcemis ! Emissions (formerly "poll") -public :: reset_3d ! Exports final results for i,j column to 3-D fields +public :: setup_1d ! Extracts results for i,j column from 3-D fields +public :: setup_rcemis ! Emissions in i,j column +public :: reset_3d ! Exports final results from i,j column to 3-D fields ! (and XNCOL outputs if asked for) ! Indices for the species defined in this routine. Only set if found ! Hard-coded for 2 specs just now. Could extend and allocate. integer, private, parameter :: NROADDUST = 2 integer, private, parameter :: iROADF=1, iROADC=2 -integer, private, save :: inat_RDF, inat_RDC, inat_Rn222 +integer, private, save :: inat_RDF, inat_RDC integer, private, save :: itot_RDF=-999, itot_RDC=-999, itot_Rn222=-999 -! Minimum concentration allowed for advected species. Avoids some random -! variations between debugged/normal runs with concs of e.g. 1.0e-23 ppb or -! less. 1.0e-20 ppb is ca. 2.5e-10 molec/cm3 at sea-level, ca. 2.5e-11 at top -! e.g.: MINCONC = 1.0e-29 -!DUST_ROAD_F contains !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx @@ -140,7 +137,7 @@ subroutine setup_1d(i,j) real :: ugtmp, ugSIApm, ugDustF, ugSSaltF, ugDustC, ugSSaltC real, save :: ugBCf=0.0, ugBCc=0.0 !not always present real :: ugSO4, ugNO3f, ugNO3c, ugRemF, ugRemC, ugpmF, ugpmC, rho - logical :: is_finepm, is_ssalt, is_dust ,have_BC + logical :: is_finepm, is_ssalt, is_dust logical, dimension(size(PM10_GROUP)), save :: is_BC real, dimension(size(AERO%Inddry)) :: Ddry ! Dry diameter integer :: iw, ipm ! for wet rad @@ -154,6 +151,9 @@ subroutine setup_1d(i,j) integer :: k, n, ispec ! loop variables real :: qsat ! saturation water content integer, save :: nSKIP_RCT = 0 + logical, save ::is_finepm_a(size( PM10_GROUP )) + logical, save ::is_ssalt_a(size( PM10_GROUP )) + logical, save ::is_dust_a(size( PM10_GROUP )) debug_flag = ( DEBUG%SETUP_1DCHEM .and. debug_proc .and. & i==debug_li .and. j==debug_lj .and. current_date%seconds == 0 ) @@ -165,26 +165,35 @@ subroutine setup_1d(i,j) do n = 1, size(SKIP_RCT) if ( SKIP_RCT(n) > 0 ) nSKIP_RCT = nSKIP_RCT + 1 end do - if( MasterProc ) write(*,"(a,10i4)") dtxt//"SKIP_RCT:", SKIP_RCT(1:nSKIP_RCT) + if( MasterProc ) write(*,"(a,10i4)") & + dtxt//"SKIP_RCT:", SKIP_RCT(1:nSKIP_RCT) is_BC(:) = .false. iBCf = find_index('ECFINE',chemgroups(:)%name) - if( MasterProc ) write(*,*) dtxt//"is_BCf check ", iBCf, trim(USES%n2o5HydrolysisMethod) + if( MasterProc ) write(*,*) dtxt//"is_BCf check ", iBCf, & + trim(USES%n2o5HydrolysisMethod) if ( iBCf > 0 ) then iBCc = find_index('ECCOARSE',chemgroups(:)%name) if( MasterProc ) write(*,*) dtxt//"is_BCc check ", iBCc do ipm = 1, size( PM10_GROUP ) ispec = PM10_GROUP(ipm) - is_BC(ipm) = ( find_index( ispec, chemgroups(iBCf)%ptr ) >0 ) + is_BC(ipm) = ( find_index( ispec, chemgroups(iBCf)%specs ) >0 ) if( iBCc > 0 ) then ! have coarse BC too - if( find_index( ispec, chemgroups(iBCc)%ptr ) >0) & + if( find_index( ispec, chemgroups(iBCc)%specs ) >0) & is_BC(ipm) = .true. end if - if( MasterProc) write(*,*) dtxt//"is_BC ",species(ispec)%name, is_BC(ipm) + if( MasterProc) write(*,*) dtxt//"is_BC ",& + species(ispec)%name, is_BC(ipm) end do end if + do ipm = 1, size( PM10_GROUP ) + ispec = PM10_GROUP(ipm) + is_finepm_a(ipm) = ( find_index( ispec, PMFINE_GROUP) > 0 ) + is_ssalt_a(ipm) = ( find_index( ispec, SS_GROUP ) >0) + is_dust_a(ipm) = ( find_index( ispec, DUST_GROUP )>0) + enddo end if ! first_call if( debug_flag ) write(*,*) dtxt//"=DBG======= ", first_call, me @@ -200,8 +209,8 @@ subroutine setup_1d(i,j) h2o(k) = max( 1.e-5*amk(k), & q(i,j,k,1)*amk(k)*ATWAIR/18.0) - ! nb. max function for h2o used as semi-lagrangian scheme used - ! in LAM50 (and HIRLAM) often gives negative H2O.... :-( + ! nb. max function for h2o used as some NWP numerics can give + ! negative negative H2O.... :-( pp(k) = A_mid(k) + B_mid(k)*ps(i,j,1) @@ -214,7 +223,7 @@ subroutine setup_1d(i,j) rh(k) = min( q(i,j,k,1)/qsat , 1.0) rh(k) = max( rh(k) , 0.001) - ! 1)/ Short-lived species - no need to scale with M + ! 1)/ Short-lived species - no need to convert units do n = 1, NSPEC_SHL xn_2d(n,k) = max(0.0,xn_shl(n,i,j,k)) @@ -226,7 +235,7 @@ subroutine setup_1d(i,j) xn_2d(ispec,k) = max(0.0,xn_adv(n,i,j,k)*amk(k)) end do ! ispec - ! 3)/ Background species ( * CTM2 with units in mix. ratio) + ! 3)/ Background species (with units in mix. ratio) do n = 1, NSPEC_BGN xn_2d_bgn(n,k) = max(0.0,xn_bgn(n,i,j,k)*amk(k)) end do ! ispec @@ -241,8 +250,8 @@ subroutine setup_1d(i,j) ugRemC = 0.0 ugpmF = 0.0 ugpmC = 0.0 - ugNO3f = 0.0 ! 0.27*xn_2d(ispec,k)*species(ispec)%molwt*1.0e12/AVOG - ugNO3c = 0.0 ! 0.27*xn_2d(ispec,k)*species(ispec)%molwt*1.0e12/AVOG + ugNO3f = 0.0 ! 0.27*xn_2d(i,k)*species(i)%molwt*1.0e12/AVOG + ugNO3c = 0.0 ! 0.27*xn_2d(i,k)*species(i)%molwt*1.0e12/AVOG ugSIApm = 0.0 ugBCf = 0.0 ugBCc = 0.0 @@ -256,9 +265,9 @@ subroutine setup_1d(i,j) ispec = PM10_GROUP(ipm) ugtmp = xn_2d(ispec,k)*species(ispec)%molwt*1.0e12/AVOG - is_finepm = ( find_index( ispec, PMFINE_GROUP) > 0 ) - is_ssalt = ( find_index( ispec, SS_GROUP ) >0) - is_dust = ( find_index( ispec, DUST_GROUP )>0) + is_finepm = is_finepm_a(ipm) + is_ssalt = is_ssalt_a(ipm) + is_dust = is_dust_a(ipm) if( is_finepm ) then ugpmF = ugpmF + ugtmp if(is_ssalt) ugSSaltF = ugSSaltF + ugtmp @@ -289,7 +298,7 @@ subroutine setup_1d(i,j) end do ! FRACTIONS used for N2O5 hydrolysis - ! We use mass fractions, since we anyway don't have MW for OM, dust,... + ! We use mass fractions, since we anyway don't have MW for OM, dust, ! ugRemF will include OM, EC, PPM, Treat as OM ugRemF = ugpmf - ugSIApm -ugSSaltF -ugDustF @@ -371,7 +380,8 @@ subroutine setup_1d(i,j) ! For total area, we simply sum. We ignore some non-SS or dust _C. iw= AERO%PM - S_m2m3(iw,k) = S_m2m3(AERO%PM_F,k) + S_m2m3(AERO%SS_C,k) + S_m2m3(AERO%DU_C,k) + S_m2m3(iw,k) = S_m2m3(AERO%PM_F,k) + S_m2m3(AERO%SS_C,k) & + + S_m2m3(AERO%DU_C,k) iw= AERO%ORIG S_m2m3(iw,k) = S_RiemerN2O5(k) @@ -406,8 +416,8 @@ subroutine setup_1d(i,j) cHNO3(:) = cMolSpeed(temp(:), 63.0) cHO2(:) = cMolSpeed(temp(:), 33.0) cO3(:) = cMolSpeed(temp(:), 48.0) - !cNO3(:) = cMolSpeed(temp(:), 62.0) - !cNO2(:) = cMolSpeed(temp(:), 46.0) + cNO3(:) = cMolSpeed(temp(:), 62.0) + cNO2(:) = cMolSpeed(temp(:), 46.0) ! 5 ) Rates (!!!!!!!!!! NEEDS TO BE AFTER RH, XN, etc. !!!!!!!!!!) @@ -434,6 +444,12 @@ subroutine setup_1d(i,j) nd2d = 0 do itmp = 1, size(f_2d) if ( f_2d(itmp)%subclass == 'rct' ) then + !check if index of rate constant (config) possible + if ( f_2d(itmp)%index > NRCT ) then + if(MasterProc) write(*,*) 'RCT NOT AVAILABLE!', itmp, & + f_2d(itmp)%index, NRCT + cycle + end if nd2d = nd2d + 1 call CheckStop(nd2d>size(id2rct),dtxt//"Need bigger id2rct array") d2index(nd2d)= itmp @@ -461,20 +477,19 @@ subroutine setup_rcemis(i,j) !------------------------------------------------------------------- ! DESCRIPTION: ! Extracts emissions in column from gridrcemis, for input to chemistry -! routines. Results in "rcemis" array -! units of rcemis are molecule/cm3/s +! routines. Results in "rcemis" array with unts: molecule/cm3/s !------------------------------------------------------------------- !-- arguments integer, intent(in) :: i,j ! coordinates of column ! local - integer :: iqrc,k, itot + integer :: iqrc,k, itot real :: Kw,fac, eland ! for Pb210 - emissions from land - integer :: i_help,j_help,i_l,j_l, i_Emis_4D,n + integer :: i_Emis_4D,n logical, save :: first_call = .true. character(len=13) :: dtxt="setup_rcemis:" - real :: SC_DMS,SC_DMS_m23,SC_DMS_msqrt,SST_C + real :: SC_DMS,SC_DMS_m23,SC_DMS_msqrt,SST_C,invDeltaZfac integer,save ::IC_NH3 if(first_call)then @@ -485,7 +500,7 @@ subroutine setup_rcemis(i,j) itot_Rn222=find_index( "RN222", species(:)%name ) IC_NH3=find_index( "NH3", species(:)%name ) first_call = .false. - endif + end if ! initilize ! initilize ! initilize ! initilize rcemis(:,:)=0. @@ -500,60 +515,67 @@ subroutine setup_rcemis(i,j) rcemis(:,:)=rcemis(:,:)+ColumnRate(i,j,REDUCE_VOLCANO=0.85) else rcemis(:,:)=rcemis(:,:)+ColumnRate(i,j) - endif + end if - ! lightning and aircraft ... Airial NOx emissions if required: + ! lightning and aircraft ... Aerial NOx emissions if required: if(USE_LIGHTNING_EMIS)then do k=KCHEMTOP, KMAX_MID rcemis(NO ,k) = rcemis(NO ,k) + 0.95 * airlig(k,i,j) rcemis(NO2,k) = rcemis(NO2,k) + 0.05 * airlig(k,i,j) - enddo - endif + end do + end if if(USE_AIRCRAFT_EMIS) then do k=KCHEMTOP, KMAX_MID rcemis(NO ,k) = rcemis(NO ,k) + 0.95 * airn(k,i,j) rcemis(NO2,k) = rcemis(NO2,k) + 0.05 * airn(k,i,j) - enddo + end do end if ! AIRCRAFT NOX if(DEBUG%SETUP_1DCHEM.and.debug_proc.and.i==debug_li.and.j==debug_lj)& write(*,"(a,2L2,10es10.3)") & dtxt//"AIRNOX ", USE_LIGHTNING_EMIS, USE_AIRCRAFT_EMIS, & airn(KMAX_MID,i,j),airlig(KMAX_MID,i,j) - ! Add sea salt production + ! Road dust if(USE_ROADDUST.and.itot_RDF>0) then ! Hard-code indices for now rcemis(itot_RDF,KMAX_MID) = gridrcroadd(1,i,j) rcemis(itot_RDC,KMAX_MID) = gridrcroadd(2,i,j) - endif - + end if + + ! Forest fires if(USES%FOREST_FIRES) then if(burning(i,j))call Fire_rcemis(i,j) - endif + end if - !Soil NOx + ! Soil NOx if(USE_GLOBAL_SOILNOX)then !NEEDS CHECKING NOV2011 rcemis(NO,KMAX_MID)=rcemis(NO,KMAX_MID)+SoilNOx(i,j) - endif - + end if + ! Emissions from GEIA, was use for Aerocom NO3 experiment if(USE_OCEAN_NH3)then - !keep separated from snapemis/rcemis in order to be able to include more advanced processes + !keep separated from snapemis/rcemis in order to be able to include more + ! advanced processes k=KMAX_MID !convert from kg/m2/s into molecules/cm3/s . !kg->g=1000 , /m3->/cm3=1e-6 , 1000*1e-6=0.001 - rcemis(O_NH3%index,k)=rcemis(O_NH3%index,k)+O_NH3%emis(i,j)*0.001*AVOG/species(IC_NH3)%molwt& + rcemis(O_NH3%index,k)=rcemis(O_NH3%index,k)+ & + O_NH3%emis(i,j)*0.001*AVOG/species(IC_NH3)%molwt& *(GRAV*roa(i,j,k,1))/(dA(k)+dB(k)*ps(i,j,1)) + !make map in mg/m2 + O_NH3%map(i,j)=O_NH3%emis(i,j)*dt_advec*1.0E6!kg->mg = 1.0E6 - endif + end if + ! Ocean DMS -> SO2 if(FOUND_OCEAN_DMS)then!temporarily always compute budgets if file found - !keep separated from snapemis/rcemis in order to be able to include more advanced processes + !keep separated from snapemis/rcemis in order to be able to include more + ! advanced processes k=KMAX_MID !convert from mol/cm3 into molecules/cm3/s . !Kw in cm/hour after Leonor Tarrason (1995), after Liss and Merlivat (1986) !assumes 20 degrees C -!NB: misprint in gbc1385.pdf! + !NB: misprint in gbc1385.pdf! SST_C=max(0.0,min(30.0,(SST(i,j,1)-T0))) !the formula uses degrees C SC_DMS=2674 -147.12*SST_C + 3.726*SST_C*SST_C - 0.038 * SST_C*SST_C*SST_C SC_DMS=SC_DMS/600.0 @@ -565,37 +587,44 @@ subroutine setup_rcemis(i,j) elseif(ws_10m(i,j,1)<=13.0)then Kw=0.17*ws_10m(i,j,1)*SC_DMS_m23+2.68*(ws_10m(i,j,1)-3.6)*SC_DMS_msqrt else - Kw=0.17*ws_10m(i,j,1)*SC_DMS_m23+2.68*(ws_10m(i,j,1)-3.6)*SC_DMS_msqrt+3.05*(ws_10m(i,j,1)-13)*SC_DMS_msqrt - endif + Kw=0.17*ws_10m(i,j,1)*SC_DMS_m23+ & + 2.68*(ws_10m(i,j,1)-3.6)*SC_DMS_msqrt+ & + 3.05*(ws_10m(i,j,1)-13)*SC_DMS_msqrt + end if Kw=Kw/3600!cm/hour -> cm/s + !66% of DMS turns into SO2, Leonor Tarrason (1995) if(USE_OCEAN_DMS)then - rcemis(O_DMS%index,k)=rcemis(O_DMS%index,k)+0.66*O_DMS%emis(i,j)*Kw*0.01*GRAV*roa(i,j,k,1)/(dA(k)+dB(k)*ps(i,j,1)) *AVOG - endif - !in g . Multiply by dz(in cm) * dx*dx (in cm2) * molwgt(SO2) /AVOG . (dz/AVOG just removed from above) + rcemis(O_DMS%index,k)=rcemis(O_DMS%index,k)+ & + 0.66*O_DMS%emis(i,j)*Kw*0.01*GRAV*roa(i,j,k,1)/ & + (dA(k)+dB(k)*ps(i,j,1)) *AVOG + end if + !in g . Multiply by dz(in cm) * dx*dx (in cm2) * ... + !... molwgt(SO2) /AVOG . (dz/AVOG just removed from above) !g->Gg = 1.0E-9 O_DMS%sum_month = O_DMS%sum_month+0.66*O_DMS%emis(i,j)*Kw *1.e4*xmd(i,j)*& gridwidth_m*gridwidth_m*dt_advec *64.0*1.0E-9 -!make map in mg/m2 - O_DMS%map(i,j)=O_DMS%emis(i,j)*Kw *1.e4*62.13*1.0E3!g->mg = 1.0E3 ; /cm2 -> /m2 =1e4 +!make map in mg/m2, g->mg = 1.0E3 ; /cm2 -> /m2 =1e4 + O_DMS%map(i,j)=O_DMS%emis(i,j)*Kw *1.e4*62.13*1.0E3 - endif + end if if(Found_Emis_4D>0)then do i_Emis_4D=1,N_Emis_4D if(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D)=='NOTSET')exit - n=find_index(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D),species(:)%name) + n=find_index(emis_inputlist(Found_Emis_4D)%pollemepName(i_Emis_4D),& + species(:)%name) if(n>0)then fac=1.0/1000000.0/3600.0 !convert from Bq/m3/hour into Bq/cm3/s do k=KCHEMTOP, KMAX_MID rcemis(n,k)=rcemis(n,k)+Emis_4D(i,j,k,i_Emis_4D)*fac - enddo - endif - enddo - endif + end do + end if + end do + end if do k=KCHEMTOP, KMAX_MID @@ -611,6 +640,48 @@ subroutine setup_rcemis(i,j) end if end do + if(FOUND_Special_ShipEmis)then + !NB: the species indices (NO2, SO2...) may not be defined in some configurations: + ! this will make the model compilation crash *also* when no ship emis are used. + invDeltaZfac = 1.0/deltaZcm(KMAX_MID) + if(NO_ix>0) rcemis(NO_ix,KMAX_MID) = rcemis(NO_ix,KMAX_MID) & + + 0.95 * AISnox(i,j) * invDeltaZfac + if(NO2_ix>0) rcemis(NO2_ix,KMAX_MID) = rcemis(NO2_ix,KMAX_MID) & + + 0.05 * AISnox(i,j) * invDeltaZfac + if(SO2_ix>0) rcemis(SO2_ix,KMAX_MID) = rcemis(SO2_ix,KMAX_MID) & + + AISsox(i,j) * invDeltaZfac + if(SO4_ix>0) rcemis(SO4_ix,KMAX_MID) = rcemis(SO4_ix,KMAX_MID) & + + AISso4(i,j) * invDeltaZfac + if(CO_ix>0) rcemis(CO_ix,KMAX_MID) = rcemis(CO_ix,KMAX_MID) & + + AISco(i,j) * invDeltaZfac + +! Comments from Jukka-Pekka Jalkanen at FMI + +! The composition of Ash can be taken from Jana’s paper +! (Moldanova et al, Atm Env 43 (2009) 2632-2641), Table 8. According to +! that, the composition by weight is: C (11.1%), O (5.7%), S (4.9%), +! V (30.7%), Ni (20.9%), Ca (26.7%). This composition was determined for +! fuel with 1.9% sulphur and it will not be directly applicable to fuels +! used in the Baltic Sea during 2015. However, that is the only reference +! I could find which reports the elemental composition of Ash. + +! All primary PM emitted should be assigned to PM2.5 fraction since the PM +! size of fresh exhaust is less than 100 nm. Whether this grows fast enough +! to >2.5 microns in the timescale used by the regional models is not known +! to me at this point. + + if(REMPPM25_ix>0) rcemis(REMPPM25_ix,KMAX_MID) = rcemis(REMPPM25_ix,KMAX_MID) & + + 1.0 * AISash(i,j) * invDeltaZfac + + if(EC_F_FFUEL_NEW_ix>0) rcemis(EC_F_FFUEL_NEW_ix,KMAX_MID) = rcemis(EC_F_FFUEL_NEW_ix,KMAX_MID) & + + 0.8 * AISec(i,j) * invDeltaZfac + if(EC_F_FFUEL_AGE_ix>0) rcemis(EC_F_FFUEL_AGE_ix,KMAX_MID) = rcemis(EC_F_FFUEL_AGE_ix,KMAX_MID) & + + 0.2 * AISec(i,j) * invDeltaZfac + + if(POM_F_FFUEL_ix>0) rcemis(POM_F_FFUEL_ix,KMAX_MID) = rcemis(POM_F_FFUEL_ix,KMAX_MID) & + + AISoc(i,j) * invDeltaZfac + + endif @@ -624,9 +695,9 @@ subroutine setup_rcemis(i,j) SumSplitEmis(i,j,iqrc) = SumSplitEmis(i,j,iqrc)& +rcemis(itot,k)*species(itot)%molwt & *(dA(k)+dB(k)*ps(i,j,1))/(GRAV*amk(k)*ATWAIR) - enddo - enddo - endif + end do + end do + end if ! Soil Rn222 emissions from non-ice covered land, + water @@ -643,7 +714,7 @@ subroutine setup_rcemis(i,j) !ESX rc_Rnwater(KMAX_MID) = water_fraction(i,j) / & !ESX ((z_bnd(i,j,KMAX_BND-1) - z_bnd(i,j,KMAX_BND))*100.) -endsubroutine setup_rcemis +end subroutine setup_rcemis !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine reset_3d(i,j) integer, intent(in) :: i,j @@ -651,8 +722,8 @@ subroutine reset_3d(i,j) ! ! XNCOL testing -- sets d_2d for column data from molec/cm3 concs. ! if variables are wanted for d_2d output (via USET), we use these indices: character(len=*),parameter :: dtxt='reset3dxncol:' - character(len=10) :: specname - integer, dimension(10), save :: d2index, id2col + character(len=20) :: specname + integer, dimension(20), save :: d2index, id2col logical, save :: first_call = .true. integer, save :: nd2d !XNCOL end testing @@ -662,14 +733,14 @@ subroutine reset_3d(i,j) ! 1)/ Short-lived species - no need to scale with M do n = 1, NSPEC_SHL xn_shl(n,i,j,k) = xn_2d(n,k) - enddo ! ispec + end do ! ispec ! 2)/ Advected species do n = 1, NSPEC_ADV ispec = NSPEC_SHL + n xn_adv(n,i,j,k) = xn_2d(ispec,k)/amk(k) - enddo ! ispec - enddo ! k + end do ! ispec + end do ! k !XNCOL !====================================================================== !! If column totals are wanted, we can do those here also since xn_2d are @@ -684,7 +755,7 @@ subroutine reset_3d(i,j) nd2d = nd2d + 1 call CheckStop( nd2d > size(id2col), & dtxt//"Need bigger id2col array" ) - specname = f_2d(id)%name(7:) ! Strip XNCOL_ + specname = trim(f_2d(id)%name(7:)) ! Strip XNCOL_ ispec = find_index( specname, species(:)%name ) call CheckStop(ispec < 1, dtxt//"XNCOL not found"//specname ) d2index(nd2d)= id @@ -709,7 +780,7 @@ subroutine reset_3d(i,j) !!XNCOL -endsubroutine reset_3d +end subroutine reset_3d !--------------------------------------------------------------------------- endmodule Setup_1d_ml !_____________________________________________________________________________! diff --git a/Setup_1dfields_ml.f90 b/Setup_1dfields_ml.f90 index 0e4045a..5fe83c2 100644 --- a/Setup_1dfields_ml.f90 +++ b/Setup_1dfields_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/Sites_ml.f90 b/Sites_ml.f90 index 7f82af9..74ec08e 100644 --- a/Sites_ml.f90 +++ b/Sites_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -201,7 +201,7 @@ subroutine set_species(adv,shl,xtra,s) s(1:nadv) = species( NSPEC_SHL + adv(:) )%name s(nadv+1:n2) = species( shl(:) )%name s(n2+1:nout) = xtra(:) -endsubroutine set_species +end subroutine set_species !==================================================================== > subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & s_gindex, s_gx, s_gy, s_gz, s_x, s_y, s_z, s_n, s_name) @@ -256,8 +256,8 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & else call open_file(io_num,"r",infile,needed=.true.) call CheckStop(ios,"ios error on "//trim(infile)) - endif - endif + end if + end if call MPI_BCAST( ios, 1, MPI_INTEGER, 0, MPI_COMM_CALC,IERROR) if(ios/=0)return @@ -283,12 +283,12 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & lat=-999.0 if ( ios /= 0 ) exit ! End of file read(unit=txtinput,fmt=*) s, ix, iy, lev - endif + end if if (ioerr < 0) then write(6,*) sub//" end of file after ", nin-1, infile exit SITELOOP - endif ! ioerr + end if ! ioerr if ( ixRUNDOMAIN(2) .or. & @@ -310,18 +310,18 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & if(trim(fname)=="sites")then if(lon>-990)Sites_lon(n) = lon if(lat>-990)Sites_lat(n) = lat - endif + end if if(trim(fname)=="sondes")then if(lon>-990)Sondes_lon(n) = lon if(lat>-990)Sondes_lat(n) = lat - endif + end if s_name(n) = s !!! remove comments// comment if (DEBUG%SITES.and.MasterProc) write(6,"(a,i4,a)") sub//" s_name : ",& n, trim(s_name(n)) - endif + end if - enddo SITELOOP + end do SITELOOP nglobal = n @@ -354,9 +354,9 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & write(6,"(a,i3,a,2i3,4a)") Sub// trim(fname), me, & " Nos. ", n, nlocal, " ", trim(s_name(n)), " => ", trim(s_name(nlocal)) - endif + end if - enddo ! nglobal + end do ! nglobal ! inform me=0 of local array indices: if(DEBUG%SITES) write(6,*) sub//trim(fname), " before gc NLOCAL_SITES", & @@ -370,7 +370,7 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & if(DEBUG%SITES) write(6,*) sub//" for me =0 LOCAL_SITES", me, nlocal do n = 1, nlocal s_gindex(me,n) = s_n(n) - enddo + end do do d = 1, NPROC-1 call MPI_RECV(nloc, 4*1, MPI_BYTE, d, 333, MPI_COMM_CALC,MPISTATUS, IERROR) if(nloc>0) call MPI_RECV(s_n_recv, 4*nloc, MPI_BYTE, d, 334, & @@ -381,9 +381,9 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & s_gindex(d,n) = s_n_recv(n) if(DEBUG%SITES) write(6,*) sub//" for d =", fname, d, & " nloc = ", nloc, " n: ", n, " gives nglob ", s_gindex(d,n) - enddo ! n - enddo ! d - endif ! MasterProc + end do ! n + end do ! d + end if ! MasterProc if ( DEBUG%SITES ) write(6,*) sub//' on me', me, ' = ', nlocal @@ -416,7 +416,7 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) do i = 1, nlocal_sites write(6,*) "sitesdef Into surf x,y ",site_x(i),site_y(i),& site_z(i)," me ", me - enddo + end do if ( MasterProc ) then write(6,*) "======= site_gindex ======== sitesdef ============" @@ -424,10 +424,10 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) !write(6,'(a12,i4,2x,80(i4,:))') "sitesdef ", n, & write(6,'(a12,i4,2x,200i4)') "sitesdef ", n, & (site_gindex(d,n),d=0,NPROC-1) - enddo + end do write(6,*) "======= site_end ======== sitesdef ============" - endif ! MasterProc - endif ! DEBUG + end if ! MasterProc + end if ! DEBUG ! assign local data to out @@ -448,10 +448,10 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) cfac( SITE_ADV(ispec),ix,iy) * PPBINV else ! Mountain sites not corrected to surface out(ispec,i) = xn_adv( SITE_ADV(ispec) ,ix,iy,iz ) * PPBINV - endif + end if i_Att=i_Att+1 Spec_Att(i_Att,1)='units:C:ppb' - enddo + end do do ispec = 1, NSHL_SITE @@ -479,7 +479,7 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) case default call CheckStop("Error, Sites_ml/siteswrt_surf: SITE_XTRA_MISC:"& // trim(SITE_XTRA_MISC(ispec))) - endselect + end select call CheckStop( abs(out(nn,i))>1.0e99, & "ABS(SITES OUT: '"//trim(SITE_XTRA_MISC(ispec))//"') TOO BIG" ) end do @@ -507,9 +507,9 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) " "//trim(d2code), d2index, out(nn,i) call CheckStop( abs(out(nn,i))>1.0e99, & "ABS(SITES OUT: '"//trim(SITE_XTRA_D2D(ispec))//"') TOO BIG" ) - enddo - endif - enddo + end do + end if + end do my_first_call = .false. ! collect data into gout on me=0 t @@ -545,13 +545,15 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) case("PM25","PMco","NOy","SH","RH","roa","dz","z_mid","p_mid","Kz_m2s","th","U","V") errmsg = "ok" case("T") - call CheckStop(all(SONDE_XTRA(1:ispec)/="RH"),"Error, Sites_ml/siteswrt_sondes SONDE_XTRA: '"//trim(SONDE_XTRA(ispec))//"' needs to be requested after 'RH'") + call CheckStop(all(SONDE_XTRA(1:ispec)/="RH"),& + "Error, Sites_ml/siteswrt_sondes SONDE_XTRA: '"//& + trim(SONDE_XTRA(ispec))//"' needs to be requested after 'RH'") errmsg = "ok" case default call CheckStop("Error, Sites_ml/siteswrt_sondes SONDE_XTRA: "//& trim(SONDE_XTRA(ispec))) - endselect - enddo + end select + end do i_Att=0 NSpec_Att=1 !number of Spec attributes defined @@ -571,7 +573,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) nn = nn + NLEVELS_SONDE i_Att=i_Att+1 Spec_Att(i_Att,1)='units:C:ppb' - enddo + end do do ispec = 1, NSHL_SONDE !/ xn_shl in molecules/cm3 out(nn+1:nn+NLEVELS_SONDE,i) = xn_shl( SONDE_SHL(ispec) , & @@ -579,7 +581,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) nn = nn + NLEVELS_SONDE i_Att=i_Att+1 Spec_Att(i_Att,1)='units:C:molecules/cm3' - enddo + end do ! then print out XTRA stuff first, ! usually the height or pressure @@ -595,7 +597,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) dot_product(xn_adv(PMCO_GROUP-NSPEC_SHL,ix,iy,k),& to_ug_ADV(PMCO_GROUP-NSPEC_SHL)) & ) * roa(ix,iy,k,1) - enddo !k + end do !k !bug? out(nn+1:nn+KMAX_MID,i) = sum_PM(KMAX_MID:1:-1) out(nn+1:nn+NLEVELS_SONDE,i) = sum_PM(KMAX_MID:KTOP_SONDE:-1) i_Att=i_Att+1 @@ -607,7 +609,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) sum_PM(k) = dot_product(xn_adv(PMCO_GROUP-NSPEC_SHL,ix,iy,k),& to_ug_ADV(PMCO_GROUP-NSPEC_SHL)) & * roa(ix,iy,k,1) - enddo !k + end do !k !bug? out(nn+1:nn+KMAX_MID,i) = sum_PM(KMAX_MID:1:-1) out(nn+1:nn+NLEVELS_SONDE,i) = sum_PM(KMAX_MID:KTOP_SONDE:-1) i_Att=i_Att+1 @@ -617,7 +619,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) sum_NOy(:) = 0. do k = 1, KMAX_MID sum_NOy(k) = sum(xn_adv(OXN_GROUP-NSPEC_SHL,ix,iy,k)) - enddo + end do !bug? out(nn+1:nn+KMAX_MID,i) = PPBINV * sum_NOy(KMAX_MID:1:-1) out(nn+1:nn+NLEVELS_SONDE,i) = PPBINV * sum_NOy(KMAX_MID:KTOP_SONDE:-1) i_Att=i_Att+1 @@ -693,13 +695,13 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) case("D3D") call StopAll("D3D Sites out not defined") - endselect + end select nn=nn+NLEVELS_SONDE - enddo ! ispec (NXTRA_SONDE) + end do ! ispec (NXTRA_SONDE) ps_sonde(i)=ps(ix,iy,1)!surface pressure always needed to define the vertical levels - enddo ! i (nlocal_sondes) + end do ! i (nlocal_sondes) ! collect data into gout on me=0 t @@ -735,16 +737,13 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & character(len=4) :: suffix integer, parameter :: NTYPES = 2 ! No. types, now 2 (sites, sondes) integer :: type=-1 ! = 1 for sites, 2 for sondes - integer, save, dimension(NTYPES):: prev_month = (/ -99, -99 /) ! Initialise integer, save, dimension(NTYPES):: prev_year = (/ -99, -99 /) ! Initialise - integer :: ii,nn + integer :: ii integer, parameter :: NattributesMAX=10 character(len=200),allocatable :: SpecName(:),SpecDef(:,:),MetaData(:,:) character(len=200) :: fileName - real,allocatable :: CoordValues(:,:) integer :: Nlevels,ispec,NSPEC,NStations,NMetaData - real ::Values(KMAX_MID) integer ::i_Att_MPI logical :: debug_1d=.false. @@ -754,7 +753,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & case default write(6,*) "non-possible type in siteswrt_out for ", fname return - endselect + end select write(suffix,fmt="(i4)") prev_year(type) fileName = fname // "_" // suffix // ".nc"!Name of the NetCDF file. Will overwrite any preexisting file @@ -780,7 +779,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & write(io_num,"(i3,a)") f, " Hours between outputs" do n = 1, nglobal write(io_num,'(a50,3(",",i4))') s_name(n), s_gx(n), s_gy(n),s_gz(n) - enddo ! nglobal + end do ! nglobal write(io_num,'(i3,a)') size(s_species), " Variables units: ppb" !MV write(io_num,'(a9,(",",a))')"site,date",(trim(s_species(i)),i=1,size(s_species)) @@ -794,7 +793,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & case("sites") NLevels=1 NSPEC=NSPC_SITE !number of species defined for sites - endselect + end select NStations = nglobal !number of sondes or sites defined allocate(SpecDef(NSPEC,0:NattributesMAX),MetaData(0:NStations,NattributesMAX)) @@ -846,23 +845,23 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & write(MetaData(n,5),"(A,':D:',F10.3)")"longitude",sondes_lon(n) if(sondes_lat(n)>-990)& write(MetaData(n,6),"(A,':D:',F10.3)")"latitude" ,sondes_lat(n) - endselect - enddo + end select + end do !take Spec_Attributes from any processor with at least one site/sonde if(i_Att>0.and.i_Att/=NSPEC)then write(*,*)'MISSING species attribute? ',i_Att,NSPEC - endif + end if do d = 1, NPROC-1 call MPI_RECV(i_Att_MPI, 4*1, MPI_BYTE, d, 746, MPI_COMM_CALC,MPISTATUS, IERROR) if(i_Att_MPI>0)then if(i_Att_MPI/=NSPEC)then write(*,*)'MISSING species attribute? ',i_Att_MPI,NSPEC - endif + end if call MPI_RECV(Spec_Att,Spec_Att_Size*N_Spec_Att_MAX*NSPECMAX, & MPI_BYTE, d, 747, MPI_COMM_CALC,MPISTATUS, IERROR) - endif - enddo + end if + end do call CheckStop(NattributesMAX0)then call Create_CDF_sondes(fileName,& NSPEC,NSpec_Att+3,SpecDef(:,0:NSpec_Att+3),& @@ -883,7 +882,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & write(*,*)'Created ',trim(fileName) else write(*,*)'No Stations found! not creating ',trim(fileName) - endif + end if deallocate(SpecDef,MetaData) @@ -894,10 +893,10 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & call MPI_SEND(i_Att_MPI, 4*1, MPI_BYTE, 0, 746, MPI_COMM_CALC, IERROR) if(i_Att>0)then call MPI_SEND(Spec_Att, Spec_Att_Size*N_Spec_Att_MAX*NSPECMAX, MPI_BYTE, 0, 747, MPI_COMM_CALC, IERROR) - endif + end if prev_year(type) = current_date%year - endif ! MasterProc - endif ! current_date%year /= prev_year(type) + end if ! MasterProc + end if ! current_date%year /= prev_year(type) if(.not.MasterProc) then ! send data to me=0 (MasterProc) call MPI_SEND(nlocal, 4*1, MPI_BYTE, 0, 346, MPI_COMM_CALC, IERROR) @@ -912,7 +911,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & nglob = s_gindex(0,n) g_out(:,nglob) = out(:,n) if(trim(fname)=="sondes")g_ps(n) = ps_sonde(n) - enddo ! n + end do ! n do d = 1, NPROC-1 call MPI_RECV(nloc, 4*1, MPI_BYTE, d, 346, MPI_COMM_CALC,MPISTATUS, IERROR) @@ -924,8 +923,8 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & nglob = s_gindex(d,n) g_out(:,nglob) = out(:,n) if(trim(fname)=="sondes")g_ps(nglob) = ps_sonde(n) - enddo ! n - enddo ! d + end do ! n + end do ! d ! some computers print out e.g. "2.23-123" instead of "2.23e-123" ! when numbes get too small. Here we make a correction for this: @@ -943,7 +942,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & ! (The ':' format control item will stop processing once the g_out ! is done, avoiding runtime warnings.) - enddo + end do if(trim(fname)=="sondes")then NLevels = NLEVELS_SONDE !number of vertical levels (counting from surface) @@ -951,17 +950,17 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & else NLevels=1 NSPEC=NSPC_SITE!number of species defined for sites - endif + end if allocate(SpecName(NSPEC)) do ispec=1,NSPEC SpecName(ispec)=trim(s_species(ispec))!name of the variable for one sites/sonde and species - enddo ! n + end do ! n if(nglobal>0)then call Out_CDF_sondes(fileName,SpecName,NSPEC,g_out,NLevels,g_ps,debug=debug_1d) - endif + end if deallocate(SpecName) - endif ! MasterProc -endsubroutine siteswrt_out + end if ! MasterProc +end subroutine siteswrt_out !==================================================================== > endmodule Sites_ml diff --git a/SmallUtils_ml.f90 b/SmallUtils_ml.f90 index 0976bda..0780975 100644 --- a/SmallUtils_ml.f90 +++ b/SmallUtils_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -112,7 +112,7 @@ subroutine wordsplit(text,nword_max,wordarray,nwords,errcode,separator,& if(present(empty_words))then keep_empty=empty_words wasinword=keep_empty - endif + end if do i = 1, len_trim(text) c = text(i:i) @@ -131,17 +131,17 @@ subroutine wordsplit(text,nword_max,wordarray,nwords,errcode,separator,& print *,"Too many words" iw=iw-1 exit - endif - endif - enddo + end if + end if + end do nwords = iw ! Remove leading spaces if(keep_empty.or.present(strict_separator))then do iw=1,nwords wordarray(iw)=ADJUSTL(wordarray(iw)) - enddo - endif + end do + end if end subroutine wordsplit !============================================================================ @@ -156,7 +156,7 @@ function LenArray(a,notset) result (N) do i = 1, size(a) if ( index(a(i),notset) > 0 ) exit N=N+1 - enddo + end do end function LenArray !============================================================================ !> AddArray adds elements from new array to old array @@ -175,9 +175,9 @@ subroutine AddArray(new,old,notset,errmsg) 55 format(A,I0,A) write(errmsg, 55)"ERROR: Max Array size (",size(old),") exceeded!" return - endif + end if old(N) = new(i) - enddo + end do end subroutine AddArray !============================================================================ subroutine WriteArray(list,NList,txt,io_num) @@ -194,10 +194,10 @@ subroutine WriteArray(list,NList,txt,io_num) write(unit=*,fmt=*) "WRITEARRAY PROBLEM Nlist, size(List) ", & Nlist, size(list), trim(txt) return - endif + end if do i = 1, Nlist write(unit=io,fmt=*) txt, i, list(i) - enddo + end do end subroutine WriteArray !>=========================================================================== !! A series of find_index routines, for character (c) and integer (i) arrays: @@ -230,14 +230,14 @@ function find_index_c(wanted, list, first_only, debug) result(Index) print debug_fmt,n,n_match,trim(list(n)),"==",trim(wanted) elseif ( debug_print ) then print debug_fmt,n,n_match,trim(list(n)),"/=",trim(wanted) - endif - enddo + end if + end do if ( n_match > 1 ) then !! Too many! n_match = -1 * n_match if(debug_print) & print *, "debug find_index REVERSE", n_match - endif + end if end function find_index_c !============================================================================ @@ -266,12 +266,12 @@ function find_index_i(wanted, list, debug) result(Index) print debug_fmt,n,list(n),"==",wanted elseif ( debug_print ) then print debug_fmt,n,list(n),"/=",wanted - endif - enddo + end if + end do if ( n_match > 1 ) then !! Too many! n_match = -1 * n_match - endif + end if end function find_index_i !======================================================================= @@ -298,9 +298,9 @@ function find_indices(wanted, list, debug) result(Indices) print debug_fmt,n,trim(list(n)),"==",w,trim(wanted(w)) elseif ( debug_print ) then print debug_fmt,n,trim(list(n)),"/=",w,trim(wanted(w)) - endif - enddo - enddo + end if + end do + end do end function find_indices !======================================================================= function trims(str) result(trimmed) @@ -366,13 +366,13 @@ pure function skey2str(iname,key,val,xfmt) result(fname) write(aux,xfmt)trim(val) else ! keyword lenght same as key aux=trim(val) - endif + end if n=len_trim(key) do while (ind>0) fname=fname(1:ind-1)//trim(aux)//fname(ind+n:len_trim(fname)) ind=index(fname,trim(key)) - enddo -endfunction skey2str + end do +end function skey2str pure function ikey2str(iname,key,val,xfmt) result(fname) character(len=*), intent(in):: iname,key integer, intent(in) :: val @@ -384,7 +384,7 @@ pure function ikey2str(iname,key,val,xfmt) result(fname) if(index(iname,trim(key))==0)then fname=iname return - endif + end if if(present(xfmt))then ! user supplied format write(sval,xfmt)val if(index(sval,'*')>0)& ! problem with user format, @@ -393,13 +393,13 @@ pure function ikey2str(iname,key,val,xfmt) result(fname) if(val<0)then ! negative numbers would be printed as **** fname=iname ! keep as it is return - endif + end if n=len_trim(key) write(ifmt,"('(I',I0,'.',I0,')')")n,n write(sval,ifmt)val - endif + end if fname=trim(skey2str(iname,key,sval)) -endfunction ikey2str +end function ikey2str pure function rkey2str(iname,key,val,xfmt) result(fname) character(len=*), intent(in):: iname,key real, intent(in) :: val @@ -411,7 +411,7 @@ pure function rkey2str(iname,key,val,xfmt) result(fname) if(index(iname,trim(key))==0)then fname=iname return - endif + end if if(present(xfmt))then ! user supplied format write(sval,xfmt)val if(index(sval,'*')>0)& ! problem with user format, @@ -420,7 +420,7 @@ pure function rkey2str(iname,key,val,xfmt) result(fname) if(val<0)then ! negative numbers would be printed as **** fname=iname ! keep as it is return - endif + end if n=len_trim(key) n1=index(key,".") if(n1>0)then @@ -428,10 +428,10 @@ pure function rkey2str(iname,key,val,xfmt) result(fname) write(sval,ifmt)val else write(sval,"(I0)")int(val) - endif - endif + end if + end if fname=trim(skey2str(iname,key,sval)) -endfunction rkey2str +end function rkey2str !============================================================================ subroutine Self_test() diff --git a/Solver.f90 b/Solver.f90 index c528366..344c9a7 100644 --- a/Solver.f90 +++ b/Solver.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -47,16 +47,18 @@ module Chemsolver_ml !=======================================================================! use Aqueous_ml, only: aqrck, ICLOHSO2, ICLRC1, ICLRC2, ICLRC3 - use CheckStop_ml, only: CheckStop - use DefPhotolysis_ml ! => IDHNO3, etc. - use EmisDef_ml, only: KEMISTOP + use CheckStop_ml, only: CheckStop, StopAll use ChemFunctions_ml, only :VOLFACSO4,VOLFACNO3,VOLFACNH4 !TEST TTTT use ChemGroups_ml, only: RO2_POOL, RO2_GROUP use ChemSpecs ! => NSPEC_TOT, O3, NO2, etc. - use Chemfields_ml, only : NSPEC_BGN ! => IXBGN_ indices and xn_2d_bgn + use ChemFields_ml, only : x, xold ,xnew & ! Working arrays [molecules/cm3] + ,cell_tinv & ! tmp location, for Yields + ,NSPEC_BGN ! => IXBGN_ indices and xn_2d_bgn use ChemRates_rct_ml, only: rct - !ESX use ChemRates_rcmisc_ml,only: rcmisc - use GridValues_ml, only : GRIDWIDTH_M + use DefPhotolysis_ml ! => IDHNO3, etc. + use emep_Config_mod, only : YieldModifications + use EmisDef_ml, only: KEMISTOP + use GridValues_ml, only : GRIDWIDTH_M, i_fdom, j_fdom use Io_ml, only : IO_LOG, datewrite use ModelConstants_ml, only: KMAX_MID, KCHEMTOP, dt_advec,dt_advec_inv, & DebugCell, MasterProc, DEBUG, USE_SEASALT @@ -68,17 +70,18 @@ module Chemsolver_ml rh, & Fgas, & ! fraction in gas-phase, for SOA amk - !FUTURE rcnh3, & ! NH3emis - use Setup_1dfields_ml, only : itemp, tinv, rh, x=> xn_2d, amk + use Setup_1dfields_ml, only : itemp, tinv, rh, amk + use YieldModifications_mod ! eg YA_ for SOA aerosol. Allows changes with + ! e.g. concentrations + implicit none private public :: chemistry ! Runs chemical solver INCLUDE 'mpif.h' - - integer:: STATUS(MPI_STATUS_SIZE),INFO - integer, parameter:: nchemMAX=15 + + integer, parameter:: nchemMAX=15 integer, parameter:: NUM_INITCHEM=5 ! Number of initial time-steps with shorter dt real, save:: DT_INITCHEM=20.0 ! shorter dt for initial time-steps, reduced for integer, parameter :: EXTRA_ITER = 1 ! Set > 1 for even more iteration @@ -109,12 +112,11 @@ subroutine chemistry(i,j,debug_flag) real(kind=dp) :: dt2 real(kind=dp) :: P, L ! Production, loss terms real(kind=dp) :: xextrapol !help variable + character(len=15) :: runlabel ! Concentrations : xold=old, x=current, xnew=predicted ! - dimensioned to have same size as "x" - real(kind=dp), dimension(NSPEC_TOT) :: & - x, xold ,xnew ! Working array [molecules/cm3] real(kind=dp), dimension(nchemMAX), save :: & dti ! variable timestep*(c+1)/(c+2) real(kind=dp), dimension(nchemMAX), save :: & @@ -138,8 +140,13 @@ subroutine chemistry(i,j,debug_flag) write(IO_LOG,"(a,i4)") 'Chem dts: EXTRA_ITER: ', EXTRA_ITER if(DEBUG%DRYRUN) write(*,*) "DEBUG%DRYRUN Solver" end if + + if ( YieldModifications /= '-' ) then + ! sets YieldModificationsInUse + call doYieldModifications('first') + end if first_call = .false. - endif + end if !====================================================== @@ -171,19 +178,26 @@ subroutine chemistry(i,j,debug_flag) !************************************* ! Start of integration loop * !************************************* + if ( YieldModificationsInUse ) then + cell_tinv = tinv(k) + call doYieldModifications('init') + end if do ichem = 1, nchem do n=1,NSPEC_TOT +!if ( x(n) < 0.0 ) then +! print *, 'NCHEM', me, n, species(n)%name, x(n), xnew(n) +!end if xextrapol = xnew(n) + (xnew(n)-x(n)) *cc(ichem) xold(n) = coeff1(ichem)*xnew(n) - coeff2(ichem)*x(n) xold(n) = max( xold(n), 0.0 ) x(n) = xnew(n) xnew(n) = xextrapol - enddo + end do dt2 = dti(ichem) !*(1.0+cc(ichem))/(1.0+2.0*cc(ichem)) @@ -202,12 +216,12 @@ subroutine chemistry(i,j,debug_flag) ! The chemistry is iterated several times, more close to the ground than aloft. ! For some reason, it proved faster for some compilers to include files as given below ! with the if statements, than to use loops. -!Just add some comments: -!At present the "difference" between My_FastReactions and My_SlowReactions -!is that in My_Reactions the products do not reacts chemically at all, -!and therefore do not need to be iterated. We could have another class -!"slowreactions", which is not iterated or fewer times. This needs some -!work to draw a proper line ...... +! Just add some comments: +! At present the "difference" between My_FastReactions and My_SlowReactions +! is that in My_Reactions the products do not reacts chemically at all, +! and therefore do not need to be iterated. We could have another class +! "slowreactions", which is not iterated or fewer times. This needs some +! work to draw a proper line ...... !if(k>=KCHEMTOP)then @@ -215,15 +229,27 @@ subroutine chemistry(i,j,debug_flag) include 'CM_Reactions1.inc' !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx - !endif + !end if !if(k>=6)then ! include 'My_FastReactions.inc' - !endif + !end if !if(k>=KEMISTOP)then ! include 'My_FastReactions.inc' - !endif + !end if + + !Mar-Apr 2017 NEW + ! Allows change of gas/aerosol yield + ! BUT only takes effect on 2nd iteration + ! Still, we have nchem*niter loops + + if ( YieldModificationsInUse ) then + runlabel='run' + if( iter == toiter(k) ) runlabel='lastFastChem' + call doYieldModifications(runlabel) + + end if + end do !! End iterations - ! Just before SO4, look after slower? species !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx include 'CM_Reactions2.inc' @@ -243,7 +269,7 @@ subroutine chemistry(i,j,debug_flag) xn_2d(:,k) = xnew(:) - enddo ! End of vertical k-loop + end do ! End of vertical k-loop end subroutine chemistry @@ -296,7 +322,7 @@ subroutine makedt(dti,nchem,coeff1,coeff2,cc) if(dt_advec<= dt_init )then nchem=int(dt_advec/DT_INITCHEM)+1 dt=(dt_advec)/(nchem) - endif + end if !/ ** call CheckStop(nchem>nchemMAX,& @@ -313,13 +339,13 @@ subroutine makedt(dti,nchem,coeff1,coeff2,cc) do i=1,nchem ttot=ttot+dt(i) write(*,27)i,dt(i),ttot - enddo + end do !check that we are using consistent timesteps call CheckStop(abs(ttot-dt_advec)>1.E-5, & "Error in Solver/makedt: dt_advec and dt not compatible") - endif + end if !.. Help variables from Verwer & Simpson cc(1)=1.0 @@ -333,7 +359,7 @@ subroutine makedt(dti,nchem,coeff1,coeff2,cc) coeff1(i)=((cc(i)+1.0)**2)*coeff2(i) dti(i)=((cc(i)+1.0)/(cc(i)+2.0))*dt(i) cc(i)=1.0/cc(i) - enddo + end do end subroutine makedt !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/StoFlux_ml.f90 b/StoFlux_ml.f90 index 5b21d06..f1d0002 100644 --- a/StoFlux_ml.f90 +++ b/StoFlux_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -38,7 +38,7 @@ module StoFlux_ml use PhysicalConstants_ml, only : AVOG, KARMAN use SmallUtils_ml, only : find_index use SubMet_ml, only : Sub - use Wesely_ml, only : WES_O3, Rb_cor + use GasParticleCoeffs_ml, only : WES_O3, Rb_cor implicit none private @@ -58,7 +58,7 @@ module StoFlux_ml integer, private, save, dimension(NLANDUSEMAX) :: mapSumVPD real, private, save :: gext_leaf = 1.0/2500.0 - real, private :: rc_leaf, rb_leaf, Fst + real, private :: rc_leaf, rb_leaf @@ -158,7 +158,7 @@ subroutine Calc_StoFlux(nLC,iL_used,debug_flag) call datewrite("StoFlux SUMVPD ", iL, & (/ real(ivpd), L%rh, L%t2C, L%vpd, SumVPD(i,j,ivpd) /) ) ! old_gsun(i,j), tmp_gsun, L%g_sun , L%g_sto - endif + end if old_gsun(i,j,ivpd) = L%g_sun end if diff --git a/SubMet_ml.f90 b/SubMet_ml.f90 index fd0cc6e..6feea5b 100644 --- a/SubMet_ml.f90 +++ b/SubMet_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute diff --git a/Tabulations_ml.f90 b/Tabulations_ml.f90 index 300374a..76e6cc7 100644 --- a/Tabulations_ml.f90 +++ b/Tabulations_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -85,7 +85,7 @@ subroutine tabulate() do i = 1,131 p = PBAS + i*PINC tpi(i) = CP*(p/1.0e+5)**KAPPA - enddo + end do ! Temperature-dependant rates !------------------------------------------------------------------- diff --git a/TimeDate_ExtraUtil_ml.f90 b/TimeDate_ExtraUtil_ml.f90 index f830ca3..d09f7ea 100644 --- a/TimeDate_ExtraUtil_ml.f90 +++ b/TimeDate_ExtraUtil_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -40,7 +40,6 @@ MODULE TimeDate_ExtraUtil_ml PRIVATE public :: & - assign_NTERM, & ! set NTERM, the number of 3-hourly periods date2string, & ! date (various formats) --> formatted string date2file, & ! date (various formats) --> file name w/option for old file version string2date, & ! formatted string & format (pattern) --> date (CD format) @@ -51,8 +50,8 @@ MODULE TimeDate_ExtraUtil_ml to_stamp, & ! extended interface for make_timestamp (TimeDate_ml) to_date, & ! extended interface for make_current_date (TimeDate_ml) to_idate, & ! create int array from timestap or date - self_test ! test/example ussages for different interface/module procedures - + self_test, & ! test/example ussages for different interface/module procedures + assign_startandenddate !if needed, correct days and hours of startdate and enddate interface date2string!(iname,...,mode,debug) result(fname) ! character(len=*),intent(in) :: iname ! character(len=len(iname)) :: fname @@ -179,28 +178,28 @@ function date2int (cd,n) result (id) case (5); id=[cd%year,cd%month,cd%day,cd%hour,cd%seconds] case default; id(:)=-1 call CheckStop("ERROR in date2int: undetermined date") - endselect -endfunction date2int + end select +end function date2int function int2ts (id) result (ts) type(timestamp) :: ts integer, intent(in), dimension(:) :: id ts=date2ts(int2date(id)) -endfunction int2ts +end function int2ts function ts2int (ts,n) result (id) type(timestamp), intent(in) :: ts integer, intent(in) :: n integer, dimension(n) :: id id=date2int(ts2date(ts),n) -endfunction ts2int +end function ts2int subroutine init_ts() if(.not.first_call)return first_call=.false. ts1970=to_stamp(date(1970,1,1,0,0)) ts1900=to_stamp(date(1900,1,1,0,0)) -endsubroutine init_ts +end subroutine init_ts subroutine str2detail(str,fmt,year,month,day,hour,seconds,minute,second,days,& fstep,ntme,nlev,nlat,nlon,debug) @@ -230,7 +229,7 @@ subroutine str2detail(str,fmt,year,month,day,hour,seconds,minute,second,days,& ! if(present(nproc ))nproc =str2key(str,fmt,'PPP' ) if(present(debug))then if(debug) write(*,*)'string2date: ',trim(str),'/',trim(fmt) - endif + end if contains function str2key(str,xfmt,key) result(val) character(len=*), intent(in) :: str,xfmt,key @@ -239,8 +238,8 @@ function str2key(str,xfmt,key) result(val) val=0 ind=index(xfmt,trim(key)) if(ind>0)read(str(ind:ind+len_trim(key)-1),*)val -endfunction str2key -endsubroutine str2detail +end function str2key +end subroutine str2detail function string2date(str,fmt,debug) result(cd) character(len=*), intent(in) :: str,fmt @@ -248,14 +247,14 @@ function string2date(str,fmt,debug) result(cd) type(date) :: cd call str2detail(str,fmt,year=cd%year,month=cd%month,day=cd%day,& hour=cd%hour,seconds=cd%seconds,debug=debug) -endfunction string2date +end function string2date function str2ts(str,fmt,debug) result(ts) character(len=*), intent(in) :: str,fmt logical, intent(in), optional :: debug type(timestamp) :: ts ts=date2ts(string2date(str,fmt,debug=debug)) -endfunction str2ts +end function str2ts function str2int(str,fmt,n,debug) result(id) character(len=*), intent(in) :: str,fmt @@ -263,7 +262,7 @@ function str2int(str,fmt,n,debug) result(id) logical, intent(in), optional :: debug integer, dimension(n) :: id id=date2int(string2date(str,fmt,debug=debug),n) -endfunction str2int +end function str2int function detail2str(iname,year,month,day,hour,seconds,minute,second,days,& fstep,ntme,nlev,nlat,nlon,nproc,mode,debug) result(fname) @@ -314,11 +313,11 @@ function detail2str(iname,year,month,day,hour,seconds,minute,second,days,& if(present(year ))fname=key2str(fname,'YY' ,mod(year,100)) case default call CheckStop("Unsupported date2string(mode='"//trim(my_mode)//"')") - endselect + end select if(present(debug))then if(debug) write(*,*)'date2string: ',trim(iname),'-->',trim(fname) - endif -endfunction detail2str + end if +end function detail2str function cd2str(iname,cd,addsecs,mode,debug) result(fname) character(len=*),intent(in) :: iname @@ -337,7 +336,7 @@ function cd2str(iname,cd,addsecs,mode,debug) result(fname) days=day_of_year(ccd%year,ccd%month,ccd%day),& fstep=nint(tdif_days(to_stamp(startdate),to_stamp(ccd))*24),& nproc=me,mode=mode,debug=debug) -endfunction cd2str +end function cd2str function ts2str(iname,ts,addsecs,mode,debug) result(fname) character(len=*),intent(in) :: iname @@ -350,7 +349,7 @@ function ts2str(iname,ts,addsecs,mode,debug) result(fname) tts=ts if(present(addsecs))call ts_addSecs(tts,addsecs) fname=cd2str(iname,to_date(tts),mode=mode,debug=debug) -endfunction ts2str +end function ts2str function int2str(iname,id,addsecs,mode,debug) result(fname) character(len=*),intent(in) :: iname @@ -360,7 +359,7 @@ function int2str(iname,id,addsecs,mode,debug) result(fname) character(len=*),intent(in),optional :: mode logical,intent(in),optional :: debug fname=ts2str(iname,to_stamp(id),addsecs=addsecs,mode=mode,debug=debug) -endfunction int2str +end function int2str subroutine ts_to_secs1970(ts,nsecs,iotyp) !calculate how many seconds have passed since the start of the year 1970 @@ -385,9 +384,9 @@ subroutine ts_to_secs1970(ts,nsecs,iotyp) nsecs=nsecs-half_day case(IOU_HOUR,IOU_HOUR_EXTRA_MEAN) nsecs=nsecs-half_hour*FREQ_HOURLY - endselect - endif -endsubroutine ts_to_secs1970 + end select + end if +end subroutine ts_to_secs1970 subroutine cd_to_secs1970(cd,nsecs,iotyp) !calculate how many seconds have passed since the start of the year 1970 @@ -396,7 +395,7 @@ subroutine cd_to_secs1970(cd,nsecs,iotyp) integer, optional, intent(in) :: iotyp call ts_to_secs1970(to_stamp(cd),nsecs,iotyp=iotyp) -endsubroutine cd_to_secs1970 +end subroutine cd_to_secs1970 subroutine int_to_secs1970(id,nsecs,iotyp) !calculate how many seconds have passed since the start of the year 1970 @@ -405,7 +404,7 @@ subroutine int_to_secs1970(id,nsecs,iotyp) integer, optional, intent(in) :: iotyp call ts_to_secs1970(to_stamp(id),nsecs,iotyp=iotyp) -endsubroutine int_to_secs1970 +end subroutine int_to_secs1970 subroutine ts_to_days1900(ts,ndays,iotyp) ! calculate how many days have passed since the start of the year 1900 @@ -427,9 +426,9 @@ subroutine ts_to_days1900(ts,ndays,iotyp) ndays=ndays-0.5 case(IOU_HOUR,IOU_HOUR_EXTRA_MEAN) ndays=ndays-FREQ_HOURLY/48.0 !1.0/48.0=half hour - endselect - endif -endsubroutine ts_to_days1900 + end select + end if +end subroutine ts_to_days1900 subroutine cd_to_days1900(cd,ndays,iotyp) ! calculate how many days have passed since the start of the year 1900 @@ -438,7 +437,7 @@ subroutine cd_to_days1900(cd,ndays,iotyp) integer, optional, intent(in) :: iotyp call ts_to_days1900(to_stamp(cd),ndays,iotyp=iotyp) -endsubroutine cd_to_days1900 +end subroutine cd_to_days1900 subroutine int_to_days1900(id,ndays,iotyp) ! calculate how many days have passed since the start of the year 1900 @@ -447,7 +446,7 @@ subroutine int_to_days1900(id,ndays,iotyp) integer, optional, intent(in) :: iotyp call ts_to_days1900(to_stamp(id),ndays,iotyp=iotyp) -endsubroutine int_to_days1900 +end subroutine int_to_days1900 subroutine secs1970_to_ts(ts,nsecs,msg) !calculate date from seconds that have passed since the start of the year 1970 @@ -460,7 +459,7 @@ subroutine secs1970_to_ts(ts,nsecs,msg) call ts_addSecs(ts,float(nsecs)) if(present(msg)) write(*,*)date2string(msg,ts) -endsubroutine secs1970_to_ts +end subroutine secs1970_to_ts subroutine secs1970_to_cd(cd,nsecs,msg) !calculate date from seconds that have passed since the start of the year 1970 @@ -471,7 +470,7 @@ subroutine secs1970_to_cd(cd,nsecs,msg) call secs1970_to_ts(ts,nsecs,msg=msg) cd=to_date(ts) -endsubroutine secs1970_to_cd +end subroutine secs1970_to_cd subroutine secs1970_to_int(id,nsecs,msg) !calculate date from seconds that have passed since the start of the year 1970 @@ -483,7 +482,7 @@ subroutine secs1970_to_int(id,nsecs,msg) call secs1970_to_ts(ts,nsecs,msg=msg) ts%secs=nint(ts%secs)!to avoid 3599.9999 seconds id=to_idate(ts,size(id)) -endsubroutine secs1970_to_int +end subroutine secs1970_to_int subroutine days1900_to_ts(ts,ndays,msg) !calculate date from seconds that have passed since the start of the year 1900 @@ -496,7 +495,7 @@ subroutine days1900_to_ts(ts,ndays,msg) call ts_addSecs(ts,ndays*spd) if(present(msg)) write(*,*)date2string(msg,ts) -endsubroutine days1900_to_ts +end subroutine days1900_to_ts subroutine days1900_to_cd(cd,ndays,msg) !calculate date from seconds that have passed since the start of the year 1900 @@ -507,7 +506,7 @@ subroutine days1900_to_cd(cd,ndays,msg) call days1900_to_ts(ts,ndays,msg=msg) cd=to_date(ts) -endsubroutine days1900_to_cd +end subroutine days1900_to_cd subroutine days1900_to_int(id,ndays,msg) !calculate date from seconds that have passed since the start of the year 1900 @@ -519,7 +518,7 @@ subroutine days1900_to_int(id,ndays,msg) call days1900_to_ts(ts,ndays,msg=msg) if(size(id)<=4)ts%secs=ts%secs+0.1!correct for rounding errors id=to_idate(ts,size(id)) -endsubroutine days1900_to_int +end subroutine days1900_to_int function secs2str(iname,nsecs,debug) result(fname) character(len=*), intent(in) :: iname @@ -529,7 +528,7 @@ function secs2str(iname,nsecs,debug) result(fname) logical, intent(in), optional :: debug call nctime2date(idate,nsecs) fname=date2string(key2str(iname,nctime_key,nsecs,nctime_fmt),idate,debug=debug) -endfunction secs2str +end function secs2str function days2str(iname,ndays,debug) result(fname) character(len=*), intent(in) :: iname @@ -539,36 +538,7 @@ function days2str(iname,ndays,debug) result(fname) logical, intent(in), optional :: debug call nctime2date(idate,ndays) fname=date2string(key2str(iname,nctime_key,ndays,nctime_fmt),idate,debug=debug) -endfunction days2str - -subroutine assign_NTERM(NTERM) -! calculate NTERM (the number of metdata periods) -! on the basis of start and enddate - integer,intent(out) :: NTERM - type(timestamp) :: ts1, ts2 -! real :: spMETSTEP=sph*METSTEP ! seconds in period of metadat - - ! ensure that a valid day of the month, - ! e.g. Feb 31=>Feb 28/29 depending the year - startdate(3)=min(startdate(3),max_day(startdate(2),startdate(1))) - enddate (3)=min(enddate (3),max_day(enddate (2),enddate (1))) - - startdate(4)=0 ! simulation starts at 00:00 UTC - enddate (4)=24 ! simulation ends at 24:00 UTC - - ts1=to_stamp(startdate) - ts2=to_stamp(enddate) - - NTERM=1+ceiling(tdif_secs(ts1,ts2)/(sph*METSTEP)) !NTERM=1+#time-step - if(NTERM<=1)then - if(MasterProc)then - write(*,*)'WARNING: enddate before startdate, running only one metstep' - write(*,*)'Start date: ',startdate - write(*,*)'End date: ',enddate - endif - NTERM=max(2,NTERM)!run at least one period - endif -endsubroutine assign_NTERM +end function days2str function compare_date(n,dateA,dateB,wildcard) result(equal) integer, intent(in) :: n @@ -585,9 +555,9 @@ function compare_date(n,dateA,dateB,wildcard) result(equal) equal=equal.or.all((dA==dB).or.(dA==wildcard).or.(dB==wildcard)) else equal=equal.or.all(dA==dB) - endif - enddo -endfunction compare_date + end if + end do +end function compare_date function ts2file(iname,ts,max_age,age_unit,mode,last,debug) result(fname) intent(in) :: iname,ts,max_age,age_unit,mode,last,debug @@ -611,7 +581,7 @@ function ts2file(iname,ts,max_age,age_unit,mode,last,debug) result(fname) nsecs=864e2 case default call CheckStop("Unsupported string2file(age_unit='"//trim(age_unit)//"')") - endselect + end select ! find the nth '/' from the end of iname ind=0 @@ -620,8 +590,8 @@ function ts2file(iname,ts,max_age,age_unit,mode,last,debug) result(fname) do i=1,last if(ind==0)exit ind=index(iname(:ind),'/',BACK=.true.) - enddo - endif + end do + end if ! do not pharse the 1st ind chadacters if(ind>0)fname=iname(:ind) @@ -631,8 +601,8 @@ function ts2file(iname,ts,max_age,age_unit,mode,last,debug) result(fname) mode=mode,debug=debug) inquire(file=fname,exist=fexist) if(fexist)exit - enddo -endfunction ts2file + end do +end function ts2file function cd2file(iname,cd,max_age,age_unit,mode,last,debug) result(fname) intent(in) :: iname,cd,max_age,age_unit,mode,last,debug @@ -644,7 +614,7 @@ function cd2file(iname,cd,max_age,age_unit,mode,last,debug) result(fname) logical :: debug fname=ts2file(iname,to_stamp(cd),max_age,age_unit,& mode=mode,last=last,debug=debug) -endfunction cd2file +end function cd2file function int2file(iname,id,max_age,age_unit,mode,last,debug) result(fname) intent(in) :: iname,id,max_age,age_unit,mode,last,debug @@ -656,7 +626,7 @@ function int2file(iname,id,max_age,age_unit,mode,last,debug) result(fname) logical :: debug fname=ts2file(iname,to_stamp(id),max_age,age_unit,& mode=mode,last=last,debug=debug) -endfunction int2file +end function int2file subroutine self_test() character(len=*),parameter :: & @@ -731,7 +701,15 @@ subroutine self_test() print tfmt,'date2nctime',& key2str("HHHHHH secs since ","HHHHHH",secs)//date2string(dfmt,ts1970),& date2string(dfmt,intdate) -endsubroutine self_test +end subroutine self_test + +subroutine assign_startandenddate() + ! ensure that a valid day of the month, + ! e.g. Feb 31=>Feb 28/29 depending the year + startdate(3)=min(startdate(3),max_day(startdate(2),startdate(1))) + enddate (3)=min(enddate (3),max_day(enddate (2),enddate (1))) +end subroutine assign_startandenddate + ENDMODULE TimeDate_ExtraUtil_ml !DSX program tester diff --git a/TimeDate_ml.f90 b/TimeDate_ml.f90 index eedc830..4633ddf 100644 --- a/TimeDate_ml.f90 +++ b/TimeDate_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -96,7 +96,6 @@ MODULE TimeDate_ml REAL,private,PARAMETER :: sph = 3600.0 REAL,private,PARAMETER :: spm = 60.0 -TYPE(timestamp),private,PARAMETER :: ts_null = timestamp(0, 0.0) TYPE(timestamp),public, save :: ts_now ! current local time TYPE(timestamp),public, save :: ts_next ! next inp @@ -382,14 +381,16 @@ SUBROUTINE get_hms (secs,hour,minute,second) second = INT(secs - sph*REAL(hour) - spm*REAL(minute)) END SUBROUTINE get_hms -SUBROUTINE Init_nmdays (indate) +SUBROUTINE Init_nmdays (indate,JUMPOVER29FEB) TYPE(date),INTENT(IN) :: indate + LOGICAL , INTENT(IN) :: JUMPOVER29FEB INTEGER,DIMENSION(12),PARAMETER :: daycount = & (/31,28,31,30,31,30,31,31,30,31,30,31/) ! table lookup for most months nmdays(:)=daycount(:) - IF (leapyear(indate%year)) nmdays(2) = nmdays(2)+1 + IF (leapyear(indate%year) .and. .not. JUMPOVER29FEB) nmdays(2) = nmdays(2)+1 nydays=sum(nmdays) + if(JUMPOVER29FEB .and. leapyear(indate%year))write(*,*)'WARNING: assuming not leap year, even if it is! nydays = ',nydays END SUBROUTINE Init_nmdays END MODULE TimeDate_ml diff --git a/Timefactors_ml.f90 b/Timefactors_ml.f90 index 23e9e86..30398fd 100644 --- a/Timefactors_ml.f90 +++ b/Timefactors_ml.f90 @@ -2,7 +2,7 @@ ! Chemical transport Model> !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -188,7 +188,7 @@ subroutine timefactors(year) !Assume max change for august and february fac_cemm(mm) = 1.0 + fracchange * cos ( 2 * PI * (mm - 8)/ 12.0 ) write(unit=6,fmt="(a,i3,f8.3,a,f8.3)") "Change in fac_cemm ", mm,fac_cemm(mm) - enddo + end do write(*,"(a,f8.4)") "Mean fac_cemm ", sum( fac_cemm(:) )/12.0 if( INERIS_SNAP1 ) fac_cemm(:) = 1.0 @@ -212,7 +212,7 @@ subroutine timefactors(year) if(ic<1.or.ic>NLAND)then if(me==0.and.insec==1.and.iemis==1)write(*,*)"Monthlyfac code not used",inland cycle - endif + end if fac_emm(ic,1:12,insec,iemis)=buff(1:12) !defined after renormalization and send to al processors: ! fac_min(inland,insec,iemis) = minval( fac_emm(inland,:,insec,iemis) ) @@ -225,7 +225,7 @@ subroutine timefactors(year) call CheckStop( ios, "Timefactors: Read error in Monthlyfac") n = n + 1 - enddo + end do close(IO_TIMEFACS) @@ -235,16 +235,16 @@ subroutine timefactors(year) do mm=1,12 fac_emm(ic,mm,1,iemis)=fac_emm(ic,mm,1,iemis)*fac_cemm(mm) sumfac=sumfac+fac_emm(ic,mm,1,iemis) - enddo + end do ! normalize do mm=1,12 fac_emm(ic,mm,1,iemis)=fac_emm(ic,mm,1,iemis)*12./sumfac - enddo - enddo + end do + end do if (DEBUG) write(unit=6,fmt=*) "Read ", n, " records from ", fname2 - enddo ! iemis + end do ! iemis - endif + end if ! ################################# ! 2) Read in Daily factors @@ -268,7 +268,7 @@ subroutine timefactors(year) if(ic<1.or.ic>NLAND)then if(me==0.and.insec==1.and.iemis==1)write(*,*)"Dailyfac code not used",inland cycle - endif + end if fac_edd(ic,1:7,insec,iemis)=buff(1:7) call CheckStop( ios, "Timefactors: Read error in Dailyfac") @@ -280,12 +280,12 @@ subroutine timefactors(year) call CheckStop( xday > 1.001 .or. xday < 0.999, & "Timefactors: ERROR: Dailyfac - not normalised") - enddo + end do close(IO_TIMEFACS) if (DEBUG) write(unit=6,fmt=*) "Read ", n, " records from ", fname2 - enddo ! NEMIS_FILE + end do ! NEMIS_FILE ! ################################# ! 3) Read in hourly (24x7) factors, options set in run script. @@ -384,11 +384,11 @@ subroutine timefactors(year) end do ! mm end do ! ic - enddo ! isec + end do ! isec - enddo ! iemis + end do ! iemis - endif + end if ! normalize the factors over the year do iemis = 1, NEMIS_FILE @@ -433,7 +433,7 @@ subroutine timefactors(year) call CheckStop(errmsg) end if - endif + end if if ( sumfac < 0.99 .or. sumfac > 1.01 )write(*,*)'sumfac: ',iemis,isec,ic,sumfac if ( sumfac < 0.97 .or. sumfac > 1.03 ) then @@ -453,10 +453,10 @@ subroutine timefactors(year) "needed for country, isec, iemis, sumfac = " ,ic, isec, iemis, sumfac end do ! ic - enddo ! isec + end do ! isec - enddo ! iemis + end do ! iemis !######################################################################### @@ -538,9 +538,9 @@ subroutine NewDayFactors(newdate) call Averageconserved_interpolate(Start,Endval,Average,nmdays(nmnd),dd,x) timefac(iland,isec,iemis) = x * fac_edd(iland,weekday,isec,iemis) - enddo ! iland - enddo ! isec - enddo ! iemis + end do ! iland + end do ! isec + end do ! iemis end subroutine NewDayFactors !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -560,7 +560,7 @@ subroutine DegreeDayFactors(daynumber) integer,dimension(2) :: ijloc ! debug only integer :: iii, jjj ! debug only real :: checkmax - character(len=80) :: errmsg, units, varname + character(len=80) :: errmsg real, dimension(IIFULLDOM,JJFULLDOM) :: var2d_global integer :: kmax=1, nfetch=1 ! for HDD @@ -596,7 +596,7 @@ subroutine DegreeDayFactors(daynumber) if(.not.allocated(gridfac_HDD))then allocate(gridfac_HDD(MAXLIMAX,MAXLJMAX)) - endif + end if call global2local(var2d_global,gridfac_HDD,MSG_READ8,1,IIFULLDOM,JJFULLDOM,& kmax,IRUNBEG,JRUNBEG) @@ -632,9 +632,8 @@ subroutine Read_monthly_emis_grid_fac(month) implicit none integer, intent(in) ::month - integer ::iemis,isec,i + integer ::iemis,isec character(len=20) ::sector_map(NSECTORS_SNAP,NEMIS_FILE),name - real :: x(12) ! sector_map(sector,emis) = name_in_netcdf_file sector_map(:,:)='default' sector_map(2,:)='dom' @@ -642,7 +641,7 @@ subroutine Read_monthly_emis_grid_fac(month) sector_map(10,:)='agr' do iemis=1,NEMIS_FILE if(trim(EMIS_File(iemis))=='nh3')sector_map(10,iemis)='agr_NH3' - enddo + end do sector_map(3,:)='ind' sector_map(4,:)='ind' sector_map(7,:)='tra' @@ -650,7 +649,7 @@ subroutine Read_monthly_emis_grid_fac(month) if(.not.allocated(GridTfac))then allocate(GridTfac(LIMAX,LJMAX,NSECTORS_SNAP,NEMIS_FILE))! only snap sectors defined for GridTfac! GridTfac=dble(nmdays(month))/nydays !default, multiplied by inverse later!! - endif + end if name='none' do isec=1,NSECTORS_SNAP! only snap sectors defined for GridTfac! @@ -659,7 +658,7 @@ subroutine Read_monthly_emis_grid_fac(month) if(sector_map(isec,iemis)=='default')then GridTfac(:,:,isec,iemis)=dble(nmdays(month))/nydays!default, multiplied by inverse later!! cycle - endif + end if if(sector_map(isec,iemis)==name.and.iemis>1)then !has same values as before, no need to read again GridTfac(:,:,isec,iemis)=GridTfac(:,:,isec,iemis-1) @@ -672,9 +671,9 @@ subroutine Read_monthly_emis_grid_fac(month) known_projection='lon lat',needed=.true.,debug_flag=.false.,& Undef=real(nmdays(month))/nydays )!default, multiplied by inverse later!! - endif - enddo - enddo + end if + end do + end do !normalizations: ! in ECLIPSEv5_monthly_patterns.nc the "default" timefactors are defines as diff --git a/Timing_ml.f90 b/Timing_ml.f90 index a293e71..c61f379 100644 --- a/Timing_ml.f90 +++ b/Timing_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -52,7 +52,6 @@ module My_Timing_ml lastptim ! for final CPU-s character(len=30), dimension(:), allocatable, public, save :: & timing ! description -real, private, save :: rclksec ! rate-of-clock !/--- MAKE CHANGE HERE TO SWAP FROM SYSTEM_CLOCK TO SYSTEM_TIME @@ -60,7 +59,7 @@ module My_Timing_ml !SYS integer, public, save :: & !SYS real, public, save :: & !CPU - tim_before,tim_before0,tim_after,tim_after0,tim_before1 + tim_before,tim_before0,tim_after,tim_after0,tim_before1,tim_before2 contains !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -79,7 +78,7 @@ subroutine Init_timing(ntim) mytimm(:) = 0.0 !CPU and SYS lastptim(:)=0.0 !CPU and SYS timing(:) = "" -endsubroutine Init_timing +end subroutine Init_timing !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< subroutine Add_2timing(n,after,before,txt) !+ calculates CPU time and resets "before" to "after" @@ -98,26 +97,26 @@ subroutine Add_2timing(n,after,before,txt) if(present(txt)) timing(n) = txt ! Descriptive text if wanted if(after !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -79,7 +79,7 @@ subroutine trajectory_in character*20 falc logical tra_exist - integer ii,info + integer ii if(current_date%seconds /= 0 .or. (mod(current_date%hour,METSTEP)/=0) )return @@ -110,7 +110,7 @@ subroutine trajectory_in write(IO_AIRCR,*) 'month and day ',current_date%month& ,current_date%day close(IO_AIRCR) - endif + end if iii = 1 ! read on node 0 @@ -121,8 +121,8 @@ subroutine trajectory_in CALL MPI_BCAST( kfalc ,8*iimax,MPI_BYTE, 0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST( fapos ,4*2*iimax,MPI_BYTE, 0,MPI_COMM_CALC,IERROR) ! all distributed - endif - endif + end if + end if return end subroutine trajectory_in @@ -132,7 +132,7 @@ end subroutine trajectory_in subroutine trajectory_out real ttt, dtmil - integer ii,jj,k,jjj,info + integer ii,jj,k,jjj integer :: i ! trajectory positions diff --git a/Unimod.f90 b/Unimod.f90 index cfe64b8..3a80f99 100644 --- a/Unimod.f90 +++ b/Unimod.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -35,12 +35,12 @@ program myeul ! !-----------------------------------------------------------------------! - use My_Outputs_ml, only: set_output_defs, NHOURLY_OUT + use My_Outputs_ml, only: set_output_defs use My_Timing_ml, only: lastptim, mytimm, Output_timing, & Init_timing, Add_2timing, Code_timer, & - tim_before, tim_before0, tim_before1, & + tim_before, tim_before1, tim_before2, & tim_after, tim_after0, NTIMING_UNIMOD,NTIMING - use Advection_ml, only: vgrid, assign_nmax, assign_dtadvec + use Advection_ml, only: vgrid_Eta, assign_nmax, assign_dtadvec use Aqueous_ml, only: init_aqueous, Init_WetDep ! Initialises & tabulates use AirEmis_ml, only: lightning use Biogenics_ml, only: Init_BVOC, SetDailyBVOC @@ -49,10 +49,10 @@ program myeul use Chemfields_ml, only: alloc_ChemFields use ChemSpecs, only: define_chemicals use ChemGroups_ml, only: Init_ChemGroups - use Country_ml, only: Country_Init + use Country_ml, only: init_Country + use DA_3DVar_ml, only: NTIMING_3DVAR,DA_3DVar_Init, DA_3DVar_Done use DefPhotolysis_ml, only: readdiss use Derived_ml, only: Init_Derived, wanted_iou - use DerivedFields_ml, only: f_2d, f_3d use EcoSystem_ml, only: Init_EcoSystems use Emissions_ml, only: Emissions, newmonth use ForestFire_ml, only: Fire_Emis @@ -60,7 +60,7 @@ program myeul DefDebugProc, GridRead use Io_ml, only: IO_MYTIM,IO_RES,IO_LOG,IO_NML,IO_DO3SE use Io_Progs_ml, only: read_line, PrintLog - use Landuse_ml, only: InitLandUse, SetLanduse, Land_codes + use Landuse_ml, only: InitLandUse, SetLanduse use MassBudget_ml, only: Init_massbudget, massbudget use Met_ml, only: metfieldint, MetModel_LandUse, Meteoread use ModelConstants_ml,only: MasterProc, & ! set true for host processor, me==MasterPE @@ -69,13 +69,14 @@ program myeul METSTEP, & ! Hours between met input runlabel1, & ! explanatory text runlabel2, & ! explanatory text - nterm,iyr_trend, nmax,nstep , meteo, & + iyr_trend, nmax,nstep , meteo, & IOU_INST,IOU_HOUR,IOU_HOUR_INST, IOU_YEAR,IOU_MON, IOU_DAY, & - USES, USE_LIGHTNING_EMIS, & + USES, USE_LIGHTNING_EMIS, USE_uEMEP,JUMPOVER29FEB,& FORECAST,ANALYSIS ! FORECAST/ANALYSIS mode use ModelConstants_ml,only: Config_ModelConstants,DEBUG, startdate,enddate - use MPI_Groups_ml, only: MPI_BYTE, ME_CALC, ME_MPI, MPISTATUS, MPI_COMM_CALC,MPI_COMM_WORLD, & - MasterPE,IERROR, MPI_world_init, MPI_groups_split + use MPI_Groups_ml, only: MPI_BYTE, MPISTATUS, MPI_COMM_CALC,MPI_COMM_WORLD, & + MasterPE,IERROR, MPI_world_init + use Nest_ml, only: wrtxn ! write nested output (IC/BC) use NetCDF_ml, only: Init_new_netCDF use OutputChem_ml, only: WrtChem, wanted_iou use Par_ml, only: me, GIMAX, GJMAX, Topology_io, Topology, parinit @@ -85,10 +86,9 @@ program myeul use Tabulations_ml, only: tabulate use TimeDate_ml, only: date, current_date, day_of_year, daynumber,& tdif_secs,date,timestamp,make_timestamp,Init_nmdays - use TimeDate_ExtraUtil_ml,only : date2string, assign_NTERM + use TimeDate_ExtraUtil_ml,only : date2string, assign_startandenddate use Trajectory_ml, only: trajectory_init,trajectory_in - use Nest_ml, only: wrtxn ! write nested output (IC/BC) - use DA_3DVar_ml, only: NTIMING_3DVAR,DA_3DVar_Init, DA_3DVar_Done + use uEMEP_ml, only: init_uEMEP !-------------------------------------------------------------------- ! ! Variables. There are too many to list here. Still, here are a @@ -120,7 +120,7 @@ program myeul integer :: cyclicgrid TYPE(timestamp) :: ts1,ts2 logical :: End_of_Run=.false. - + real :: tim_before0 !private associate ( yyyy => current_date%year, mm => current_date%month, & dd => current_date%day, hh => current_date%hour) @@ -142,19 +142,21 @@ program myeul call define_chemicals() ! sets up species details call Config_ModelConstants(IO_LOG) + call assign_startandenddate() + if(MasterProc)then call PrintLog(trim(runlabel1)) call PrintLog(trim(runlabel2)) - call PrintLog(date2string("startdate = YYYYMMDD",startdate(1:3))) - call PrintLog(date2string("enddate = YYYYMMDD",enddate (1:3))) + call PrintLog(date2string("startdate = YYYYMMDDhh",startdate(1:4))) + call PrintLog(date2string("enddate = YYYYMMDDhh",enddate (1:4))) !call PrintLog(key2str("iyr_trend = YYYY","YYYY",iyr_trend)) - endif + end if if(ANALYSIS)then ! init 3D-var module call DA_3DVar_Init(status) ! pass settings call CheckStop(status,"DA_3DVar_Init in Unimod") - endif + end if !*** Timing ******** call Init_timing(NTIMING_UNIMOD+NTIMING_3DVAR) @@ -172,7 +174,6 @@ program myeul call Topology(cyclicgrid,Poles) ! def GlobalBoundaries & subdomain neighbors call DefDebugProc() ! Sets debug_proc, debug_li, debuglj - call assign_NTERM(NTERM) ! set NTERM, the number of 3-hourly periods call assign_dtadvec(GRIDWIDTH_M) ! set dt_advec ! daynumber needed for BCs, so call here to get initial @@ -182,7 +183,6 @@ program myeul ! !++ parameters and initial fields. ! - call Add_2timing(1,tim_after,tim_before,"Before define_Chemicals") call alloc_ChemFields !allocate chemistry arrays !TEST call define_chemicals() ! sets up species details @@ -192,20 +192,25 @@ program myeul call trajectory_init() - call Add_2timing(2,tim_after,tim_before,"After define_Chems, readpar") + call init_Country() ! In Country_ml, => NLAND, country codes and names, timezone - call Country_Init() ! In Country_ml, => NLAND, country codes and names, timezone + call Add_2timing(1,tim_after,tim_before,"Grid init + chem init") call SetLandUse(daynumber, mm) ! Reads Inputs.Landuse, Inputs.LandPhen + call Add_2timing(1,tim_after,tim_before,"landuse read in") + call MeteoRead() - call Add_2timing(3,tim_after,tim_before,"After infield") + call Add_2timing(2,tim_after,tim_before,"Meteo read first record") if (MasterProc.and.DEBUG%MAINCODE) print *,"Calling emissions with year",yyyy call Emissions(yyyy) + call Add_2timing(3,tim_after,tim_before,"Yearly emissions read in") + + if(USE_uEMEP) call init_uEMEP call MetModel_LandUse(1) ! @@ -223,7 +228,7 @@ program myeul call sitesdef() ! see if any output for specific sites is wanted ! (read input files "sites.dat" and "sondes.dat" ) - call vgrid ! initialisation of constants used in vertical advection + call vgrid_Eta ! initialisation of constants used in vertical advection if (MasterProc.and.DEBUG%MAINCODE ) print *,"vgrid finish" ! open only output netCDF files if needed @@ -246,7 +251,7 @@ program myeul if(wanted_iou(IOU_HOUR_INST)) & call Init_new_netCDF(trim(runlabel1)//'_hourInst.nc',IOU_HOUR_INST) - call Add_2timing(4,tim_after,tim_before,"After tabs, defs, adv_var") + call Add_2timing(4,tim_after,tim_before,"Other init") tim_before = tim_before0 call Add_2timing(5,tim_after,tim_before,"Total until time loop") @@ -272,12 +277,12 @@ program myeul case(3:5) ;newseason = 2 case(6:8) ;newseason = 3 case(9:11) ;newseason = 4 - endselect + end select ! daynumber needed for BCs daynumber=day_of_year(yyyy,mm,dd) - if(mm==1 .and. dd==1 .and. hh==0)call Init_nmdays(current_date)!new year starts + if(mm==1 .and. dd==1 .and. hh==0)call Init_nmdays(current_date, JUMPOVER29FEB)!new year starts call Code_timer(tim_before) if(mm_old/=mm) then ! START OF NEW MONTH !!!!! @@ -289,68 +294,69 @@ program myeul if(MasterProc.and.DEBUG%MAINCODE) & print *,'maaned og sesong', mm,mm_old,newseason,oldseason - call Add_2timing(6,tim_after,tim_before,"readdiss, aircr_nox") - call MetModel_LandUse(2) ! e.g. gets snow_flag - if(MasterProc.and.DEBUG%MAINCODE) write(*,*)"vnewmonth start" + if(MasterProc.and.DEBUG%MAINCODE) write(*,*)"Newmonth start" call newmonth - call Add_2timing(7,tim_after,tim_before,"newmonth") - - if(USE_LIGHTNING_EMIS) call lightning() + if(USE_LIGHTNING_EMIS) call lightning() call init_aqueous() - call Add_2timing(8,tim_after,tim_before,"init_aqueous") ! Monthly call to BoundaryConditions. if(DEBUG%MAINCODE) print *, "Into BCs" , me ! We set BCs using the specified iyr_trend ! which may or may not equal the meteorology year + call Code_timer(tim_before2) call BoundaryConditions(yyyy,mm) + call Add_2timing(6,tim_after,tim_before2,"BoundaryConditions") + if(DEBUG%MAINCODE) print *, "Finished BCs" , me !must be called only once, after BC is set if(mm_old==0)call Init_massbudget() if(DEBUG%MAINCODE) print *, "Finished Initmass" , me - endif + call Add_2timing(7,tim_after,tim_before,"Total newmonth setup") + + end if oldseason = newseason mm_old = mm - call Add_2timing(9,tim_after,tim_before,"BoundaryConditions") - if(DEBUG%MAINCODE) print *, "1st Infield" , me call SetLandUse(daynumber, mm) !daily - call Add_2timing(11,tim_after,tim_before,"SetLanduse") + call Add_2timing(8,tim_after,tim_before,"SetLanduse") call Meteoread() ! 3-hourly or hourly - call Add_2timing(10,tim_after,tim_before,"Meteoread") + call Add_2timing(9,tim_after,tim_before,"Meteoread") call SetDailyBVOC() !daily if(USES%FOREST_FIRES) call Fire_Emis(daynumber) - call Add_2timing(12,tim_after,tim_before,"Fires+BVOC") + call Add_2timing(10,tim_after,tim_before,"Fires+BVOC") if(MasterProc) print "(2(1X,A))",'current date and time:',& date2string("YYYY-MM-DD hh:mm:ss",current_date) - call Code_timer(tim_before) - + call Code_timer(tim_before2) call phyche() - call Add_2timing(14,tim_after,tim_before,"phyche") + call Add_2timing(11,tim_after,tim_before2,"Total phyche") + + call Code_timer(tim_before) call WrtChem() + call Add_2timing(36,tim_after,tim_before,"WrtChem") + call trajectory_in - call Add_2timing(37,tim_after,tim_before,"massbud,wrtchem,trajectory_in") call metfieldint - call Add_2timing(36,tim_after,tim_before,"metfieldint") + + call Add_2timing(37,tim_after,tim_before,"metfieldint") !this is a bit complicated because it must account for the fact that for instance 3feb24:00 = 4feb00:00 ts1=make_timestamp(current_date) @@ -360,7 +366,7 @@ program myeul if(DEBUG%STOP_HH>=0 .and. DEBUG%STOP_HH==current_date%hour) & End_of_Run=.true. - enddo ! time-loop + end do ! time-loop call Code_timer(tim_after0) call Add_2timing(38,tim_after0,tim_before1,"total within loops") @@ -379,22 +385,22 @@ program myeul CALL MPI_RECV(lastptim,NTIMING*8,MPI_BYTE,NPROC-1,765,MPI_COMM_CALC,MPISTATUS,IERROR) else lastptim(:) = mytimm(:) - endif - call Output_timing(IO_MYTIM,me,NPROC,nterm,GIMAX,GJMAX) + end if + call Output_timing(IO_MYTIM,me,NPROC,GIMAX,GJMAX) elseif(me==NPROC-1) then CALL MPI_SEND(mytimm,NTIMING*8,MPI_BYTE,MasterPE,765,MPI_COMM_CALC,IERROR) - endif + end if ! write 'modelrun.finished' file to flag the end of the FORECAST if(MasterProc.and.FORECAST)then open(1,file='modelrun.finished') close(1) - endif + end if if(ANALYSIS)then ! assimilation enabled call DA_3DVar_Done(status) ! done with 3D-var module: call CheckStop(status,"DA_3DVar_Done in Unimod") - endif + end if CALL MPI_BARRIER(MPI_COMM_CALC, IERROR) CALL MPI_FINALIZE(IERROR) diff --git a/Units_ml.f90 b/Units_ml.f90 index 50ac315..4af5c87 100644 --- a/Units_ml.f90 +++ b/Units_ml.f90 @@ -1,7 +1,7 @@ -! +! !*****************************************************************************! !* -!* Copyright (C) 2007-2016 met.no +!* Copyright (C) 2007-2017 met.no !* !* Contact information: !* Norwegian Meteorological Institute @@ -30,15 +30,15 @@ module Units_ml use ChemSpecs, only: NSPEC_ADV, NSPEC_SHL, species_adv use ModelConstants_ml, only: PPBINV use PhysicalConstants_ml, only: AVOG,ATWAIR +use Pollen_const_ml, only: pollen_check use OwnDataTypes_ml, only: TXTLEN_DERIV,TXTLEN_SHORT,Asc2D use SmallUtils_ml, only: find_index -use Pollen_const_ml, only: ug2grains implicit none private ! Subroutines & Functions public :: & - Init_Units, & ! initalize conversion arrays + Init_Units, & ! initialize conversion arrays Units_Scale, & ! unit factor for single SPC Group_Units, & ! unit factors for a GROUP Group_Scale ! function version of Group_Units @@ -59,7 +59,8 @@ module Units_ml mgSm2 = mgXm2*atwS, & ! species(?)%sulphurs mgNm2 = mgXm2*atwN, & ! species(?)%nitrogens mgCm2 = mgXm2*atwC, & ! species(?)%carbons - grainsXm3=ugXm3*ug2grains,& ! will be multiplied by species(?)%molwt + grainsXm3=ugXm3*1e-6, & ! [g/m3]/grain_wt=[#/m3] + grainsXm2=mgXm2*1e-3, & ! [g/m2]/grain_wt=[#/m2] ! Extinction coefficient [1/m] = %ExtC [m2/g] * mass [g/m3] extX = ugXm3*1e-6, & ! will be multiplied by species(?)%molwt*%ExtC s2h = 1.0/3600. ! sec to hour conversion factor @@ -69,7 +70,8 @@ module Units_ml to_mgSIA=to_ugSIA*1e3, & ! conversion to mg to_number_cm3=0.001*AVOG/ATWAIR,& ! from density (roa, kg/m3) to molecules/cm3 to_molec_cm3=to_number_cm3,& ! kg/m3=1000 g/m3=0.001*Avog/Atw molecules/cm3 - to_molec_cm2=to_molec_cm3*1e2 + to_molec_cm2=to_molec_cm3*1e2,& + to_number_m3=to_number_cm3*1e6 ! 1 [#/cm3]=1e6 [#/m3] ! Conversion to ug/m3 ! xn_adv(ixadv,ix,iy,k)*roa(ix,iy,k,1)*to_ug_ADV(ixadv) @@ -90,15 +92,15 @@ module Units_ml logical :: volunit ! volume unit (PPB output class)? logical :: needroa ! need to be multiplied by air density (roa)?, real, dimension(0:NSPEC_ADV) :: uconv ! conversion factor -endtype umap +end type umap type, public :: group_umap character(len=TXTLEN_DERIV) :: name = 'none' ! short name integer,pointer,dimension(:) :: iadv =>null() ! advection index real, pointer,dimension(:) :: uconv=>null() ! conversion factor -endtype group_umap +end type group_umap -type(umap), public, save :: unit_map(23)=(/& +type(umap), public, save :: unit_map(24)=(/& ! Air concentration umap("mix_ratio","mol/mol",T,F,1.0),& ! Internal model unit umap("mass_ratio","kg/kg" ,T,F,1.0/ATWAIR), & ! mass mixing ratio @@ -109,7 +111,7 @@ module Units_ml umap("ppbh","ppb h",T,F,s2h ),& ! PPBINV already included in AOT calculations umap("ug" ,"ug/m3" ,F,T,ugXm3),& ! ug* units need to be further multiplied umap("ugC","ugC/m3",F,T,ugCm3),& ! by the air density (roa) as part of the - umap("ugN","ugN/m3",F,T,ugNm3),& ! unit covnersion + umap("ugN","ugN/m3",F,T,ugNm3),& ! unit conversion umap("ugS","ugS/m3",F,T,ugSm3),& ! Dry/Wet deposition umap("mm" ,"mm" ,F,F,1.0 ),& @@ -117,15 +119,16 @@ module Units_ml umap("mgC","mgC/m2",F,F,mgCm2),& umap("mgN","mgN/m2",F,F,mgNm2),& umap("mgS","mgS/m2",F,F,mgSm2),& -! Pollen concentration - umap("grains","grains/m3",F,T,grainsXm3),& ! needs to be further multiplied +! Pollen concentration/deposition + umap("Gm3","grains/m3",F,T,grainsXm3),& + umap("Gm2","grains/m2",F,F,grainsXm2),& ! Exposure to radioactive material umap("uBq" ,"uBq/m3" ,F,T,ugXm3),& ! inst/mean exposure umap("uBqh","uBq h/m3",F,T,ugXm3),& ! accumulated exposure over 1 hour umap("mBq" ,"mBq/m2" ,F,F,mgXm2),& ! deposition ! Aerosol optical properties ! umap("ext" ,"ext550nm",F,T,extX),&! ext* units need to be further multiplied... -! Coulumn output +! Column output umap("ugm2" ,"ug/m2" ,F,T,ugXm3),& ! ug* units need to be further multiplied umap("mcm2" ,"molec/cm2" ,F,T,to_molec_cm2),& umap("e15mcm2","1e15molec/cm2",F,T,to_molec_cm2*1e-15)/) @@ -134,9 +137,13 @@ module Units_ml contains -subroutine Init_Units() +subroutine Init_Units(update) + logical, optional :: update real, dimension(NSPEC_ADV) :: uconv_spec integer :: i + if(present(update))then + Initialize_Units = Initialize_Units .or. update + endif if(.not.Initialize_Units) return Initialize_Units = .false. @@ -150,7 +157,7 @@ subroutine Init_Units() do i=1,size(unit_map) select case (unit_map(i)%utxt) - case("ug","mg","uBq","uBqh","mBq","ugm2","mass_ratio","grains") + case("ug","mg","uBq","uBqh","mBq","ugm2","mass_ratio") uconv_spec = species_adv%molwt case("ugC","mgC","ppbC") uconv_spec = species_adv%carbons @@ -158,15 +165,18 @@ subroutine Init_Units() uconv_spec = species_adv%nitrogens case("ugS","mgS","ppbS") uconv_spec = species_adv%sulphurs + case("Gm3","Gm2") + uconv_spec = species_adv%molwt + call pollen_check(uconv_adv=uconv_spec) ! case("ext") ! uconv_spec = species_adv%molwt*species_adv%ExtC ! uconv_spec = species_adv%molwt*Qm_grp(NSPEC_ADV,[1..NSPEC_ADV]+NSPEC_SHL,rh,...) case default uconv_spec = 1.0 - endselect + end select unit_map(i)%uconv(1:)=unit_map(i)%uconv(0)*uconv_spec - enddo -endsubroutine Init_Units + end do +end subroutine Init_Units subroutine Group_Units_Asc2D(hr_out,gspec,gunit_conv,debug,name,volunit,needroa) type(Asc2D), intent(in) :: hr_out @@ -187,8 +197,8 @@ subroutine Group_Units_Asc2D(hr_out,gspec,gunit_conv,debug,name,volunit,needroa) if(present(name))name = trim(dname) if(associated(gspec)) deallocate(gspec) - allocate(gspec(size(chemgroups(hr_out%spec)%ptr))) - gspec=chemgroups(hr_out%spec)%ptr-NSPEC_SHL + allocate(gspec(size(chemgroups(hr_out%spec)%specs))) + gspec=chemgroups(hr_out%spec)%specs-NSPEC_SHL if(debug) write(*,"(A,'=',30(A,':',I0,:,'+'))") & trim(dname),(trim(species_adv(gspec(i))%name),gspec(i),i=1,size(gspec)) @@ -202,7 +212,7 @@ subroutine Group_Units_Asc2D(hr_out,gspec,gunit_conv,debug,name,volunit,needroa) if(associated(gunit_conv)) deallocate(gunit_conv) allocate(gunit_conv(size(gspec))) gunit_conv(:)=unit_map(i)%uconv(gspec) -endsubroutine Group_Units_Asc2D +end subroutine Group_Units_Asc2D subroutine Group_Units_detail(igrp,unit,gspec,gunit_conv,debug,volunit,needroa) integer, intent(in) :: igrp @@ -217,7 +227,7 @@ subroutine Group_Units_detail(igrp,unit,gspec,gunit_conv,debug,volunit,needroa) hr_out%type="Group_Units_detail" call Group_Units_Asc2D(hr_out,gspec,gunit_conv,debug,& volunit=volunit,needroa=needroa) -endsubroutine Group_Units_detail +end subroutine Group_Units_detail function Group_Scale(igrp,unit,debug,volunit,needroa) result(gmap) integer, intent(in) :: igrp @@ -231,7 +241,7 @@ function Group_Scale(igrp,unit,debug,volunit,needroa) result(gmap) hr_out%type="Group_Scale" call Group_Units_Asc2D(hr_out,gmap%iadv,gmap%uconv,debug,& name=gmap%name,volunit=volunit,needroa=needroa) -endfunction Group_Scale +end function Group_Scale subroutine Units_Scale(txtin,iadv,unitscale,unitstxt,volunit,needroa,semivol,debug_msg) character(len=*), intent(in) :: txtin @@ -247,9 +257,9 @@ subroutine Units_Scale(txtin,iadv,unitscale,unitstxt,volunit,needroa,semivol,deb txt=ADJUSTL(txtin) ! Remove leading spaces do i=1,len(txt) ! Remove invisible character if(ichar(txt(i:i))==0)txt(i:i)=' ' ! char(0) - enddo + end do select case (txt) - case("ugSS","ugSS/m3","ugP","ugP/m3",& + case("ugSS","ugSS/m3","ugP","ugP/m3",& "mgSS","mgSS/m2","mgP","mgP/m2") txt=txt(1:2) case("micro g/m3") @@ -263,7 +273,7 @@ subroutine Units_Scale(txtin,iadv,unitscale,unitstxt,volunit,needroa,semivol,deb txt="mass_ratio" case("ppbv","ppbV") txt="ppb" - endselect + end select i=find_index(txt,unit_map(:)%utxt) if(i<1)i=find_index(txt,unit_map(:)%units) call CheckStop(i<1,"Units_Scale Error: Unknown unit "// trim(txtin) ) @@ -287,8 +297,8 @@ subroutine Units_Scale(txtin,iadv,unitscale,unitstxt,volunit,needroa,semivol,deb trim(species_adv(iadv)%name)//" in "//trim(unitstxt)//" at "//trim(debug_msg)) case default call CheckStop(iadv,"Units_Scale Error: Unknown iadv.") - endselect + end select -endsubroutine Units_Scale +end subroutine Units_Scale endmodule Units_ml diff --git a/Wesely_ml.f90 b/Wesely_ml.f90 deleted file mode 100644 index 80383ca..0000000 --- a/Wesely_ml.f90 +++ /dev/null @@ -1,172 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program is distributed in the hope that it will be useful, -!* but WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -module Wesely_ml -!.............................................................................. -! specifies data for deposition modelling using procedures recommended by -! Wesely, 1989, Atmos. Environ., 23, No.6, pp. 1293-1304 -! -!.............................................................................. - - -! includes Wesely_tab2 for 14 gases -! specifies Henry's coefficients, reactivities for gases -! -use PhysicalConstants_ml, only : PRANDTL, Sc_H20 -implicit none -private - - - -!------------------------------------------------------------------------- -! Table2: (variable, igas) -! Variable: -! 1 = DH2O/Dx ! ratio of diffusivities -! 2 = H* M atm^-1 ! effective Henry coeff. -! 3 = pe ! -! 4 = k (M s)**(-1) ! -! 5 = f0 ! -! -public :: Init_GasCoeff - - -integer, public, parameter :: NWESELY = 14 ! no. of gases in Wesely tables - - real, public, parameter, & ! Wesely Table 2 - dimension(5,NWESELY) :: Wesely_tab2 = & - reshape ( & - (/ & -! D H* pe k f0 - 1.9, 1.0e5, -5.0, 9999.0, 0.0, &! 1 = SO2 Sulphur dioxide - 1.6, 1.0e-2, 28.0, 6.0e8, 1.0, &! 2 = O3 Ozone - 1.6, 1.0e-2, 9999.0, 2.0e6, 0.1, &! 3 = NO2 Nitrogen dioxide - 1.3, 2.0e-3, 9999.0, 1.0e-2, 0.0, &! 4 = NO Nitric oxide - 1.9, 1.0e14, 7.0, 1.0e-2, 0.0, &! 5 = HNO3 Nitric acid vapour - 1.4, 1.0e5, 23.0, 7.0, 1.0, &! 6 = H2O2 Hydrogen peroxide - 1.6, 1.5e1, -1.0, 9999.0, 0.0, &! 7 = (ALD) Acetaldehyde - 1.3, 6.0e3, -3.0, 9999.0, 0.0, &! 8 = HCHO Formaldehyde - 1.6, 2.4e2, 9999.0, 2.0, 0.1, &! 9 = (OP) Methyl hydroperoxide - 2.0, 5.4e2, 9999.0, 6.0e2, 0.1, &! 10 = PAA Peroxyacetic acid - 1.6, 4.0e6, -8.0, 9999.0, 0.0, &! 11 = (ORA) Formic acid - ! followed CEH recommendation and set H* NH3 equal to sulphur - ! (actually, CEH would have set it much higher than SO2!) - !orig: 2.0e4, 9999.0, 9999.0, 0.0, &! 12 = NH3 Ammonia - 1.0, 1.0e5, 9999.0, 9999.0, 0.0, &! 12 = NH3 Ammonia - 2.6, 3.6e0, 9999.0, 3.0e3, 0.1, &! 13 = PAN Peroxyacetyl nitrate - 1.6, 1.0e5, 6.0, 4.0e-4, 0.1 &! 14 = HNO2 Nitrous acid - /), & - (/5,NWESELY/) ) - - -!/ Ratio of diffusivites compared to ozone.. - -real, public, dimension(NWESELY), save :: DRx ! Ratio D(O3)/D(x) - -!/ and for the calculation of Rb we need: - -real, public, dimension(NWESELY), save :: Rb_cor ! two-thirds power of the - ! Schmidt to Prandtl numbers - -integer, public, parameter :: & - WES_SO2 = 1, WES_O3 = 2, WES_NO2 = 3, WES_NO = 4, WES_HNO3 = 5, & - WES_H2O2= 6, WES_ALD= 7, WES_HCHO= 8, WES_OP = 9, WES_PAA = 10, & - WES_ORA = 11, WES_NH3= 12, WES_PAN = 13, WES_HNO2=14 - -!*** Variables used in deposition calculations - -! DDEP_xx gives the index that will be used in the EMEP model -! WES_xx gives the index of the Wesely gas to which this corresponds - -! Here we define the minimum set of species which has different -! deposition velocities. We calculate Vg for these, and then -! can use the rates for other similar species. (e.g. AMSU can use -! the Vg for SO4. Must set NDRYDEP_CALC species - -!*** IMPORTANT: the variables below must match up in the sense that, for -! example, if DDEP_NH3=4 then the 4th element of DRYDEP must be WES_NH3. - -integer, public, parameter :: NDRYDEP_GASES = 11 ! gases - -integer, public, parameter :: & - CDDEP_HNO3 = 1, CDDEP_O3 = 2, CDDEP_SO2 = 3, & - CDDEP_NH3 = 4, CDDEP_NO2 = 5, CDDEP_PAN = 6, & - CDDEP_H2O2 = 7, CDDEP_ALD = 8, CDDEP_HCHO= 9, & - CDDEP_ROOH = 10, CDDEP_HNO2= 11 !, CDDEP_PMf = 12, CDDEP_PMc = 13 -integer, public, parameter :: CDDEP_RCHO = CDDEP_ALD ! Convenience -!OP renamed to ROOH, FIN to PMf, COA to PMc -! specials for aerosols. we have 2 fine, 1 coarse and 1 'giant'type -integer, public, parameter :: & - CDDEP_PMfS= 12, CDDEP_PMfN= 13, CDDEP_PMc = 14, & - CDDEP_SSc = 15, CDDEP_DUc = 16, CDDEP_POLLd= 17 -integer, public, parameter :: CDDEP_PMfNH4 = 18 ! TEST_2014 -integer, public, parameter :: CDDEP_LASTPM = 18 ! Safety. Catches changes - -integer, dimension(CDDEP_PMfS:CDDEP_LASTPM), public, parameter :: & - AERO_SIZE = (/ 1, 1, 2, 3, 4, 5, 1 /) !1=fine,2=coarse,3=coarse sea salt, 4=dust, 5 = pollen - -integer, public, parameter :: NDRYDEP_AER = 7 ! aerosols with CDDEP_PMfNH4 -integer, public, parameter :: NDRYDEP_CALC = NDRYDEP_GASES + NDRYDEP_AER - -integer, public, parameter :: & - CDDEP_ASH1=CDDEP_PMfS,CDDEP_ASH2=CDDEP_PMfS,CDDEP_ASH3=CDDEP_PMfS,& - CDDEP_ASH4=CDDEP_PMfS,CDDEP_ASH5=CDDEP_PMc ,CDDEP_ASH6=CDDEP_PMc, & - CDDEP_ASH7=CDDEP_PMc - -integer, public, parameter :: CDDEP_SET = -99 - -integer, public, parameter, dimension(NDRYDEP_GASES) :: & - DRYDEP_GASES = (/ WES_HNO3, WES_O3, WES_SO2, & - WES_NH3, WES_NO2, WES_PAN, & - WES_H2O2, WES_ALD, WES_HCHO, WES_OP, WES_HNO2 /) - -contains - -!========================================================== -subroutine Init_GasCoeff() -!========================================================== -!Description: -!calculates: -! 1) DRx - ratio of diffusivities of ozone to gas requried -! 2) Rb_corr - the two-thirds power of the Schmidt to Prandtl -!number ratio values for all 14 gases listed in Wesely_tab2 - -!========================================================== -! -> Calculated Rb_cor - - !Declaration of local variables - - integer :: icmp - real :: Schmidt !.. number - - - GASLOOP: do icmp = 1, NWESELY - DRx (icmp) = Wesely_tab2(1,WES_O3)/Wesely_tab2(1,icmp) - Schmidt = Sc_H20* Wesely_tab2(1,icmp) - Rb_cor(icmp) = (Schmidt/PRANDTL)**(2.0/3.0) - enddo GASLOOP - - end subroutine Init_GasCoeff -end module Wesely_ml diff --git a/YieldModifications_mod.f90 b/YieldModifications_mod.f90 new file mode 100644 index 0000000..5b12a6e --- /dev/null +++ b/YieldModifications_mod.f90 @@ -0,0 +1,262 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program is distributed in the hope that it will be useful, +!* but WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +! +!_____________________________________________________________________________! +! Added March 2017 +! For placement of miscellaneous coefficients and routines which can be +! called from Solver_ml. Currently allows access to various VBS yields +! D. Simpson & R. Bergström March-June 2017 +!_____________________________________________________________________________! +! + module YieldModifications_mod + + use CheckStop_ml, only : StopAll + use ChemFields_ml ! => cell_tinv, NSPEC_TOT, O3, NO2, etc. + use ChemSpecs ! => NSPEC_TOT, O3, NO2, etc. + use emep_Config_mod, only : YieldModifications + use ModelConstants_ml, only : MasterProc, DebugCell, DEBUG, USES + use NumberConstants, only : UNDEF_R, UNDEF_I + use SmallUtils_ml, only : find_index, trims + + implicit none + private + + public :: doYieldModifications + + logical, public, save :: YieldModificationsInUse = .false. + logical, private, save :: dbg + + ! VBS work ---------------------------------------------------------- + + private :: init_VBSyields + private :: update_VBSyields + integer, private, parameter :: NVBS = 5 !Number VOC + real, private, save :: kro2ho2, kro2no, fNO=UNDEF_R ! rate-coeffs and fraction + ! Yield arrays used in CM_Reaction2 are hard coded, with OXY=1, ... see below + real, public, dimension(0:3), save :: & + YCOXY =UNDEF_R, YNOXY =UNDEF_R & ! OXYL carbon and non-carbon yields + ,YCALK =UNDEF_R, YNALK =UNDEF_R & ! ALK carbon and non-carbon yields + ,YCOLE =UNDEF_R, YNOLE =UNDEF_R & ! OLE carbon and non-carbon yields + ,YCISOP=UNDEF_R, YNISOP=UNDEF_R & ! ISOP carbon and non-carbon yields + ,YCTERP=UNDEF_R, YNTERP=UNDEF_R ! TERP carbon and non-carbon yields + + type, private :: vbs_t + character(len=4) :: name + real :: mw + real :: omoc ! OM/OC ratio or C/non-C ratios + real :: ratio ! eg C/non-C ratios + real :: fHO2NO2 ! modifier to kHO2NO2 rate + real, dimension(4) :: highnox, lownox + end type vbs_t + type(vbs_t), private, dimension(NVBS), save :: Yemep + + + real, public, save :: & ! CRUDE, but fix later + YA0APINOH & + ,YG_APINOH, YG_APINO3, YG_APINNO3, YA_APINOH, YA_APINO3, YA_APINNO3 & + ,YG_BPINOH, YG_BPINO3, YG_BPINNO3, YA_BPINOH, YA_BPINO3, YA_BPINNO3 & + ,YG_MTOH, YG_MTO3, YG_MTNO3, YA_MTOH, YA_MTO3, YA_MTNO3 & + ,YA_ISOPOH, YA_ISOPNO3 + + + contains + + ! -------------------------------------------------------------------------- + !> SUBROUTINE doYieldModifications + !! Called once on Solver first_call (which sets YieldModificationsInUse, and some + !! constants yield values), at start of each set of chemical iterations + !! for each grid-cell (to reset yields for this cell), then after each iteration + !! to update the yields based. + + subroutine doYieldModifications(txt) + character(len=*), intent(in) :: txt + character(len=*), parameter :: dtxt='doYieldMods:' + + dbg = ( DEBUG%RUNCHEM .and. DebugCell ) + + if ( YieldModifications(1:3) == 'VBS' ) then + YieldModificationsInUse = .true. + + call init_VBSyields(txt) + + if ( txt == 'lastFastChem' ) then ! VBS only used in slower CM_Reactions2 + call update_VBSyields() + end if + + else !AUG31 deleted other options here. Will re-instate once tested + + call StopAll(dtxt//' Need to set YieldModfications=VBS in config') + + end if + + end subroutine doYieldModifications + ! -------------------------------------------------------------------------- + + subroutine init_VBSyields(txt) + !>-------------------------------------------------------------------------- + character(len=*), intent(in) :: txt + character(len=*), parameter :: dtxt='initVBS:' + logical, save :: first_call = .true. + real :: mwC = 12.0, mwH = 1.0, r1, r2 + integer :: bin, lev, isoa + + !! Yields derived from Tsimpidi et al., ACP, 2010, p529 + !! and Robert's VBS_SOAformation + type(vbs_t), dimension(5), parameter :: vbs = [ & ! vbs_t(& + vbs_t('OXYL', 106.0, 2.1, -999., 0.859, & ! Tsimpidi ... ARO2 + [ 0.002, 0.195, 0.3, 0.435 ], [ 0.075, 0.300, 0.375, 0.525 ])& + ,vbs_t('C4H10', 58.0, 1.7, -999., 0.625, & ! Tsimpidi ... ALK4 + [ 0.000, 0.038, 0.0, 0.0 ], [ 0.000, 0.075, 0.0 , 0.0 ])& + ,vbs_t('C3H6' , 42.0, 1.7, -999., 0.52, & ! Tsimpidi ... OLE1 + [ 0.001, 0.005, 0.038, 0.150 ], [ 0.005, 0.009, 0.060, 0.225 ])& + ,vbs_t('ISOP' , 68.0, 2.0, -999., 0.706, & ! Tsimpidi ... ISOP + [ 0.001, 0.023, 0.015, 0.000 ], [ 0.009, 0.030, 0.015, 0.0 ])& + ,vbs_t('APIN' , 136.0, 1.7, -999., 0.914, & ! Tsimpidi ... TERP + [ 0.012, 0.122, 0.201, 0.500 ], [ 0.107, 0.092, 0.359, 0.6 ])] + + + if ( first_call ) then ! 1st call for this cell and timestep + +!----------------------------------------------------------------------------------- +! Conversions from 'literature' yields to EMEP, based on mail from Robert, +! 2017-06-02. +! The ratio between NON_C_[A,B]SOA_ugN and [A,B]SOC_ugN is set to get +! the OM/OC ratio that we want for the respective type of SOA, e.g. for +! aromatic SOA we have assumed OM/OC = 2.1, which means the mass of +! NON_C_ASOA should be 1.1 × the mass of ASOC (which means that the +! “molar” ratio should be 13.2, since we set M(NON_C)=1). + +! The total NON_C + SOC mass yield in each VBS class is based on the +! yields given by Tsimpidi et al. – in the Aromatics high-NOx case we +! have the mass yields 0.002 VBS_ug1 + 0.195 VBS_ug10 + 0.3 VBS_ug1e2 + +! 0.435 VBS_ug1e3, which means that we have the following molar yields: + +! Y(ASOC_ug1) = 0.002 × M[OXYL] / [OM/OC](ASOA) / M[ASOC_ug1] +! = 0.002 × 106 / 2.1 / 12 +! = 0.008413 +! +! Y(NON_C_ASOA_ug1) = ( 0.002 × M[OXYL] - Y(ASOC_ug1) × M[ASOC_ug1] ) / +! M[NON_C_ASOA_ug1] +! = 0.002 × M[OXYL] × ( 1 - 1 / [OM/OC](ASOA) ) / +! M[NON_C_ASOA_ug1] +! = 0.002 × 106 (1-1/2.1)/1 +! = 0.11105 + +! Y(ASOC_ug10) = 0.195 × 106 / 2.1 / 12 = 0.820238 +! Y(NON_C_ASOA_ug10) = 0.195 × 106 (1-1/2.1)/1 = 10.8271 +! Y(ASOC_ug1e2) = 0.3 × 106 / 2.1 / 12 = 1.261905 +! Y(NON_C_ASOA_ug1e2) = 0.3 × 106 (1-1/2.1)/1 = 16.6571 +! Y(ASOC_ug1e3) = 0.435 × 106 / 2.1 / 12 = 1.82976 +! Y(NON_C_ASOA_ug1e3) = 0.435 × 106 (1-1/2.1)/1 = 24.15286 +! +!DS the yield of NON_C can thus be determined by the yield of ASOC x some +! constants. Below, we have: +! non-carbon would be vbs(isoa)%highnox(:) * vbs(isoa)%mw*r2/mwH ! non-carbon +! non-carbon = Y(ASOC) *mwC/r1 * r2/mwH = + + Yemep = vbs ! initialise names, etc. + + do isoa = 1, NVBS + r1 = 1/vbs(isoa)%omoc ! eg 1/2.1 OC/OM ! CHECK for other VOC + r2 = (1-r1) ! for non-C + + Yemep(isoa)%highnox(:) = vbs(isoa)%highnox(:) * vbs(isoa)%mw*r1/mwC ! carbon + Yemep(isoa)%lownox(:) = vbs(isoa)%lownox(:) * vbs(isoa)%mw*r1/mwC ! carbon + Yemep(isoa)%ratio = r2/mwH * mwC/r1 ! non-carbon to carbon ratio + + if ( MasterProc ) then + write(*,'(a,4f10.4,2x,4f10.2)') Yemep(isoa)%name//',& + YIELD HighNox ASOC, NOC:: ', Yemep(isoa)%highnox, & + Yemep(isoa)%highnox * Yemep(isoa)%ratio + write(*,'(a,4f10.4,2x,4f10.2)') Yemep(isoa)%name//',& + YIELD Low Nox ASOC, NOC:: ', Yemep(isoa)%lownox, & + Yemep(isoa)%lownox * Yemep(isoa)%ratio + end if + end do ! isoa + + first_call = .false. + end if + + end subroutine init_VBSyields + + subroutine update_VBSyields() + character(len=*), parameter :: dtxt='updateVBSY:' + logical, save :: first_call = .true. + real :: kNO, kHO2, fNO + integer :: bin, isoa + + kro2no = 2.54e-12*exp(360*cell_tinv) + kro2ho2 = 2.91e-13*exp(1300*cell_tinv) ! will modify below + + kNO = kro2no*xnew(NO) + kHO2 = kro2ho2*xnew(HO2) + + ! Loop over bins. + isoa=1 ! Oxyl + fNO = kNO/( kNO+kHO2*Yemep(isoa)%fHO2NO2 ) + YCOXY(:) = fno * Yemep(isoa)%highnox(:) + (1-fNO) * Yemep(isoa)%lownox(:) + YNOXY(:) = YCOXY(:) * Yemep(isoa)%ratio + + isoa=2 ! Alkanes + fNO = kNO/( kNO+kHO2*Yemep(isoa)%fHO2NO2 ) + YCALK(:) = fno * Yemep(isoa)%highnox(:) + (1-fNO) * Yemep(isoa)%lownox(:) + YNALK(:) = YCALK(:) * Yemep(isoa)%ratio + + isoa=3 ! Alkenes + fNO = kNO/( kNO+kHO2*Yemep(isoa)%fHO2NO2 ) + YCOLE(:) = fno * Yemep(isoa)%highnox(:) + (1-fNO) * Yemep(isoa)%lownox(:) + YNOLE(:) = YCOLE(:) * Yemep(isoa)%ratio + + isoa=4 ! Isop + fNO = kNO/( kNO+kHO2*Yemep(isoa)%fHO2NO2 ) + YCISOP(:) = fno * Yemep(isoa)%highnox(:) + (1-fNO) * Yemep(isoa)%lownox(:) + YNISOP(:) = YCISOP(:) * Yemep(isoa)%ratio + + isoa=5 ! terp + fNO = kNO/( kNO+kHO2*Yemep(isoa)%fHO2NO2 ) + YCTERP(:) = fno * Yemep(isoa)%highnox(:) + (1-fNO) * Yemep(isoa)%lownox(:) + YNTERP(:) = YCTERP(:) * Yemep(isoa)%ratio + + if ( dbg ) then + write(*,'(a,f8.5,4es12.3)') 'YIELD RUN '//dtxt, fNO, & + kro2no, kro2ho2, xnew(NO), xnew(HO2) + write(*,'(a,es10.2,4f10.4,2x,4f10.2)') Yemep(1)%name//',& + YIELD EMEP ASOC, NOC:: ', fNO, YCOXY(:), YNOXY(:) + end if + + end subroutine update_VBSyields + + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- + + end module YieldModifications_mod diff --git a/config_emep.nml b/config_emep.nml index 4dc9265..46f72de 100644 --- a/config_emep.nml +++ b/config_emep.nml @@ -1,5 +1,5 @@ &INPUT_PARA - GRID = 'EECCA', + GRID = 'EMEP01', iyr_trend = 2015 runlabel1 = 'Base', runlabel2 = 'Opensource_Setup_2017', @@ -50,16 +50,14 @@ INERIS_SNAP1 = F, INERIS_SNAP2 = F, !------------------------------ - EmisDir = 'DataDir/EECCA', - emis_inputlist(1)%name= 'EmisDir/gridPOLL', !example of ASCII type -! IMPORTANT: Specify the keyword "POLL" rather than sox, nox, etc. and the code -! will check against emissions names listed in CM_EmisFiles.inc -! NB: CM_EmisFiles uses lowercase. Renames or link if they are in capital letters. + EmisDir = 'DataDir/EMEP01', + emis_inputlist(1)%name= 'EmisDir/GNFRemis_EMEP01_YYYY.nc', ! fractions emiss format ! One can either include or exclude, not both, as follows ! emis_inputlist(1)%incl(1:) = 'EU15', ! example take only countries from the 'EUMACC2' list -! emis_inputlist(2)%name = 'EmisDir/Emis_GLOB_05.nc', !example of Fractions type - emis_inputlist(2)%name = 'DataDir/OceanicEmissions_GEIA.nc', - emis_inputlist(2)%type = 'DMS', + emis_inputlist(2)%name= 'DataDir/OceanicEmissions_GEIA.nc', + emis_inputlist(2)%type= 'DMS', + emis_inputlist(3)%name= 'DataDir/FMIGlobShip2015mon.nc', + emis_inputlist(3)%type= 'Special_ShipEmis', EMIS_OUT = F, ! Output emissions in separate files (memory demanding) !------------------------------ SELECT_LEVELS_HOURLY = F, ! hourly output flag for 3DPROFILES @@ -71,6 +69,7 @@ SKIP_RCT = -1, ! Will zero-out some rct, for tests. (Use -1 for defaults) !--- 'fake' vegetation for ozone POD calculations FLUX_VEGS = 'IAM_CR','IAM_DF','IAM_MF', + FLUX_IGNORE = 'W', 'D', 'DE', 'ICE', 'BARE' ! Ignore these for FLUX calcs. &end &Fire_config need_poll = F, diff --git a/dependencies b/dependencies index 4ba6d62..d2e851b 100644 --- a/dependencies +++ b/dependencies @@ -1,42 +1,45 @@ AeroFunctions.o : AeroFunctions.f90 PhysicalConstants_ml.o Aero_Vds_ml.o : Aero_Vds_ml.f90 ModelConstants_ml.o PhysicalConstants_ml.o -Ammonium_ml.o : Ammonium_ml.f90 CM_ChemSpecs_tmp.o Setup_1dfields_ml.o ModelConstants_ml.o -AOD_PM_ml.o : AOD_PM_ml.f90 CM_AerExt.inc SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o GridValues_ml.o CheckStop_ml.o CM_ChemGroups_ml.o Chem_ml.o CM_ChemSpecs_tmp.o -Advection_ml.o : Advection_ml.f90 PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o Timing_ml.o MassBudget_ml.o MetFields_ml.o ModelConstants_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o Convection_ml.o CheckStop_ml.o CM_ChemSpecs_tmp.o Chem_ml.o +Ammonium_ml.o : Ammonium_ml.f90 ChemSpecs_wrapper.o Setup_1dfields_ml.o ModelConstants_ml.o +AOD_PM_ml.o : AOD_PM_ml.f90 CM_AerExt.inc SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o GridValues_ml.o CheckStop_ml.o CM_ChemGroups_ml.o ChemFields_ml.o ChemSpecs_wrapper.o +Advection_ml.o : Advection_ml.f90 uEMEP_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o Timing_ml.o MassBudget_ml.o MetFields_ml.o ModelConstants_ml.o Io_Progs_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o Convection_ml.o CheckStop_ml.o ChemSpecs_wrapper.o ChemFields_ml.o AirEmis_ml.o : AirEmis_ml.f90 TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o GridValues_ml.o Io_ml.o AllocInit.o : AllocInit.f90 CheckStop_ml.o -AOTnPOD_ml.o : AOTnPOD_ml.f90 TimeDate_ml.o Par_ml.o OwnDataTypes_ml.o NumberConstants.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o LandDefs_ml.o Io_Progs_ml.o GridValues_ml.o DO3SE_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o -Aqueous_n_WetDep_ml.o : Aqueous_n_WetDep_ml.f90 CM_WetDep.inc Units_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o SOA_ml.o MetFields_ml.o ModelConstants_ml.o MassBudget_ml.o Io_ml.o GridValues_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o My_Derived_ml.o -BLPhysics_ml.o : BLPhysics_ml.f90 PhysicalConstants_ml.o ModelConstants_ml.o Landuse_ml.o -Biogenics_ml.o : Biogenics_ml.f90 CM_EmisBioNat.inc TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o Radiation_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o LandPFT_ml.o LandDefs_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o -BoundaryConditions_ml.o : BoundaryConditions_ml.f90 CM_BoundaryConditions.inc TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o Io_Progs_ml.o GridValues_ml.o Functions_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o -CellMet_ml.o : CellMet_ml.f90 TimeDate_ml.o SubMet_ml.o SoilWater_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MetFields_ml.o MicroMet_ml.o LocalVariables_ml.o Landuse_ml.o GridValues_ml.o CheckStop_ml.o +AOTnPOD_ml.o : AOTnPOD_ml.f90 TimeDate_ml.o Par_ml.o OwnDataTypes_ml.o NumberConstants.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o LandDefs_ml.o Io_Progs_ml.o GridValues_ml.o DO3SE_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o +Aqueous_n_WetDep_ml.o : Aqueous_n_WetDep_ml.f90 CM_WetDep.inc Units_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o SOA_ml.o MetFields_ml.o ModelConstants_ml.o MassBudget_ml.o Io_ml.o GridValues_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o CheckStop_ml.o My_Derived_ml.o +BLPhysics_ml.o : BLPhysics_ml.f90 PhysicalConstants_ml.o ModelConstants_ml.o Landuse_ml.o emep_Config_mod.o +Biogenics_ml.o : Biogenics_ml.f90 CM_EmisBioNat.inc TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o Radiation_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o LandPFT_ml.o LandDefs_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o emep_Config_mod.o ChemSpecs_wrapper.o CheckStop_ml.o +BoundaryConditions_ml.o : BoundaryConditions_ml.f90 CM_BoundaryConditions.inc TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o Io_Progs_ml.o GridValues_ml.o Functions_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o +CellMet_ml.o : CellMet_ml.f90 SubMet_ml.o SoilWater_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MetFields_ml.o MicroMet_ml.o LocalVariables_ml.o Landuse_ml.o GridValues_ml.o CheckStop_ml.o CheckStop_ml.o : CheckStop_ml.f90 MPI_Groups_ml.o -Chem_ml.o : Chem_ml.f90 Setup_1dfields_ml.o Par_ml.o NumberConstants.o ModelConstants_ml.o CM_ChemSpecs_tmp.o AllocInit.o -CoDep_ml.o : CoDep_ml.f90 Par_ml.o ModelConstants_ml.o GridValues_ml.o Chem_ml.o CheckStop_ml.o +ChemFields_ml.o : ChemFields_ml.f90 Setup_1dfields_ml.o Par_ml.o NumberConstants.o ModelConstants_ml.o ChemSpecs_wrapper.o AllocInit.o +ChemSpecs_wrapper.o : ChemSpecs_wrapper.f90 CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o +CoDep_ml.o : CoDep_ml.f90 Par_ml.o ModelConstants_ml.o GridValues_ml.o ChemFields_ml.o CheckStop_ml.o Country_ml.o : Country_ml.f90 -ChemFunctions_ml.o : ChemFunctions_ml.f90 Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o LocalVariables_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o AeroFunctions.o +ChemFunctions_ml.o : ChemFunctions_ml.f90 Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o LocalVariables_ml.o ChemSpecs_wrapper.o CheckStop_ml.o AeroFunctions.o CM_ChemRates_ml.o : CM_ChemRates_ml.f90 ModelConstants_ml.o CM_ChemSpecs_ml.o Setup_1dfields_ml.o AeroFunctions.o ChemFunctions_ml.o -Convection_ml.o : Convection_ml.f90 PhysicalConstants_ml.o Par_ml.o GridValues_ml.o MetFields_ml.o ModelConstants_ml.o CM_ChemSpecs_tmp.o Chem_ml.o -ColumnSource_ml.o : ColumnSource_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o +Convection_ml.o : Convection_ml.f90 PhysicalConstants_ml.o Par_ml.o GridValues_ml.o MetFields_ml.o ModelConstants_ml.o ChemSpecs_wrapper.o ChemFields_ml.o +ColumnSource_ml.o : ColumnSource_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o CheckStop_ml.o CM_ChemGroups_ml.o : CM_ChemGroups_ml.f90 OwnDataTypes_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o : CM_ChemSpecs_ml.f90 -CM_ChemSpecs_tmp.o : CM_ChemSpecs_tmp.f90 CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o DefPhotolysis_ml.o : DefPhotolysis_ml.f90 LocalVariables_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o CheckStop_ml.o -Derived_ml.o : Derived_ml.f90 Units_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NumberConstants.o MosaicOutputs_ml.o AOD_PM_ml.o ModelConstants_ml.o MetFields_ml.o Io_Progs_ml.o GridValues_ml.o Emissions_ml.o EmisGet_ml.o EmisDef_ml.o EcoSystem_ml.o DerivedFields_ml.o CM_ChemSpecs_tmp.o CM_ChemGroups_ml.o Chem_ml.o CheckStop_ml.o Biogenics_ml.o AOTnPOD_ml.o My_Derived_ml.o +Derived_ml.o : Derived_ml.f90 Units_ml.o uEMEP_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NumberConstants.o MosaicOutputs_ml.o AOD_PM_ml.o ModelConstants_ml.o MetFields_ml.o Io_Progs_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o EcoSystem_ml.o DerivedFields_ml.o ChemSpecs_wrapper.o CM_ChemGroups_ml.o ChemFields_ml.o CheckStop_ml.o Biogenics_ml.o AOTnPOD_ml.o My_Derived_ml.o DerivedFields_ml.o : DerivedFields_ml.f90 OwnDataTypes_ml.o DO3SE_ml.o : DO3SE_ml.f90 TimeDate_ml.o SmallUtils_ml.o ModelConstants_ml.o LocalVariables_ml.o LandDefs_ml.o CheckStop_ml.o -DryDep_ml.o : DryDep_ml.f90 CM_DryDep.inc My_ESX_ml.o Wesely_ml.o TimeDate_ml.o SubMet_ml.o StoFlux_ml.o SoilWater_ml.o Sites_ml.o Setup_1dfields_ml.o Rsurface_ml.o Rb_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o MosaicOutputs_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o MassBudget_ml.o LocalVariables_ml.o LandDefs_ml.o Landuse_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EcoSystem_ml.o DO3SE_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o Aero_Vds_ml.o -DustProd_ml.o : DustProd_ml.f90 TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o MicroMet_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o LandDefs_ml.o Landuse_ml.o Io_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o Functions_ml.o CheckStop_ml.o Biogenics_ml.o +DryDep_ml.o : DryDep_ml.f90 CM_DryDep.inc GasParticleCoeffs_ml.o TimeDate_ml.o SubMet_ml.o StoFlux_ml.o SoilWater_ml.o Sites_ml.o Setup_1dfields_ml.o Rsurface_ml.o Rb_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o MosaicOutputs_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o MassBudget_ml.o LocalVariables_ml.o LandDefs_ml.o Landuse_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EcoSystem_ml.o DO3SE_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o Aero_Vds_ml.o +DustProd_ml.o : DustProd_ml.f90 TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o MicroMet_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o LandDefs_ml.o Landuse_ml.o Io_ml.o GridValues_ml.o ChemSpecs_wrapper.o Functions_ml.o CheckStop_ml.o Biogenics_ml.o EcoSystem_ml.o : EcoSystem_ml.f90 Par_ml.o OwnDataTypes_ml.o ModelConstants_ml.o LandDefs_ml.o +emep_Config_mod.o : emep_Config_mod.f90 EmisDef_ml.o : EmisDef_ml.f90 CM_EmisFiles.inc -EmisGet_ml.o : EmisGet_ml.f90 CM_EmisSpecs.inc SmallUtils_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o GridAllocate_ml.o EmisDef_ml.o Country_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o -Emissions_ml.o : Emissions_ml.f90 AirEmis_ml.o Timefactors_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o ReadField_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PointSource_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o Country_ml.o Chem_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o Biogenics_ml.o -ExternalBICs_ml.o : ExternalBICs_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o ModelConstants_ml.o Io_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o +EmisGet_ml.o : EmisGet_ml.f90 CM_EmisSpecs.inc SmallUtils_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o GridAllocate_ml.o EmisDef_ml.o Country_ml.o ChemSpecs_wrapper.o CheckStop_ml.o +Emissions_ml.o : Emissions_ml.f90 AirEmis_ml.o Timefactors_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o ReadField_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PointSource_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o Country_ml.o ChemFields_ml.o ChemSpecs_wrapper.o CheckStop_ml.o Biogenics_ml.o +ExternalBICs_ml.o : ExternalBICs_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o ModelConstants_ml.o Io_ml.o ChemSpecs_wrapper.o CheckStop_ml.o FastJ_ml.o : FastJ_ml.f90 TimeDate_ml.o Radiation_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o Landuse_ml.o LandDefs_ml.o GridValues_ml.o DefPhotolysis_ml.o -ForestFire_ml.o : ForestFire_ml.f90 BiomassBurningMapping.inc TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o +ForestFire_ml.o : ForestFire_ml.f90 BiomassBurningMapping.inc TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o ChemSpecs_wrapper.o CheckStop_ml.o Functions_ml.o : Functions_ml.f90 PhysicalConstants_ml.o +GasParticleCoeffs_ml.o : GasParticleCoeffs_ml.f90 PhysicalConstants_ml.o +Gravset_ml.o : Gravset_ml.f90 SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o GridValues_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o ChemFields_ml.o CheckStop_ml.o GridAllocate_ml.o : GridAllocate_ml.f90 GridValues_ml.o Par_ml.o CheckStop_ml.o GridValues_ml.o : GridValues_ml.f90 InterpolationRoutines_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_Nums_ml.o Functions_ml.o CheckStop_ml.o InterpolationRoutines_ml.o : InterpolationRoutines_ml.f90 @@ -45,62 +48,59 @@ Io_Nums_ml.o : Io_Nums_ml.f90 Io_Progs_ml.o : Io_Progs_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o Par_ml.o KeyValueTypes.o MPI_Groups_ml.o ModelConstants_ml.o Io_Nums_ml.o GridValues_ml.o CheckStop_ml.o KeyValueTypes.o : KeyValueTypes.f90 LandDefs_ml.o : LandDefs_ml.f90 SmallUtils_ml.o ModelConstants_ml.o LandPFT_ml.o KeyValueTypes.o Io_ml.o CheckStop_ml.o -Landuse_ml.o : Landuse_ml.f90 NetCDF_ml.o TimeDate_ml.o SmallUtils_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o LandPFT_ml.o LandDefs_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o GridAllocate_ml.o DO3SE_ml.o CheckStop_ml.o +Landuse_ml.o : Landuse_ml.f90 NetCDF_ml.o TimeDate_ml.o SmallUtils_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o LandPFT_ml.o LandDefs_ml.o KeyValueTypes.o Io_ml.o GridValues_ml.o GridAllocate_ml.o emep_Config_mod.o DO3SE_ml.o CheckStop_ml.o LandPFT_ml.o : LandPFT_ml.f90 SmallUtils_ml.o Par_ml.o NetCDF_ml.o ModelConstants_ml.o GridValues_ml.o CheckStop_ml.o -LocalVariables_ml.o : LocalVariables_ml.f90 Wesely_ml.o +LocalVariables_ml.o : LocalVariables_ml.f90 GasParticleCoeffs_ml.o MARS_ml.o : MARS_ml.f90 Par_ml.o ModelConstants_ml.o MARS_Aero_water_ml.o Io_ml.o CheckStop_ml.o MARS_Aero_water_ml.o : MARS_Aero_water_ml.f90 -MassBudget_ml.o : MassBudget_ml.f90 SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o Chem_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o -Met_ml.o : Met_ml.f90 TimeDate_ExtraUtil_ml.o NetCDF_ml.o TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o Landuse_ml.o Io_ml.o GridValues_ml.o Functions_ml.o FastJ_ml.o CheckStop_ml.o BLPhysics_ml.o OwnDataTypes_ml.o -MetFields_ml.o : MetFields_ml.f90 MPI_Groups_ml.o ModelConstants_ml.o +MassBudget_ml.o : MassBudget_ml.f90 SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o ChemFields_ml.o ChemSpecs_wrapper.o CheckStop_ml.o +Met_ml.o : Met_ml.f90 TimeDate_ExtraUtil_ml.o NetCDF_ml.o TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o Landuse_ml.o Io_ml.o GridValues_ml.o Functions_ml.o FastJ_ml.o CheckStop_ml.o BLPhysics_ml.o emep_Config_mod.o +MetFields_ml.o : MetFields_ml.f90 Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o EQSAM_ml.o : EQSAM_ml.f90 ModelConstants_ml.o MicroMet_ml.o : MicroMet_ml.f90 -ModelConstants_ml.o : ModelConstants_ml.f90 SmallUtils_ml.o Precision_ml.o OwnDataTypes_ml.o Io_Nums_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o AeroFunctions.o -MosaicOutputs_ml.o : MosaicOutputs_ml.f90 Wesely_ml.o Units_ml.o TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o OwnDataTypes_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o LandDefs_ml.o Io_Progs_ml.o EcoSystem_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o AOTnPOD_ml.o +ModelConstants_ml.o : ModelConstants_ml.f90 SmallUtils_ml.o Precision_ml.o OwnDataTypes_ml.o Io_Nums_ml.o emep_Config_mod.o ChemSpecs_wrapper.o CheckStop_ml.o AeroFunctions.o +MosaicOutputs_ml.o : MosaicOutputs_ml.f90 Units_ml.o TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o OwnDataTypes_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o LandDefs_ml.o Io_Progs_ml.o GasParticleCoeffs_ml.o EcoSystem_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o CheckStop_ml.o AOTnPOD_ml.o MPI_Groups_ml.o : MPI_Groups_ml.f90 -AerosolCalls.o : AerosolCalls.f90 Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MARS_ml.o EQSAM_ml.o Chem_ml.o CM_ChemSpecs_tmp.o CM_ChemGroups_ml.o CheckStop_ml.o Ammonium_ml.o -My_Derived_ml.o : My_Derived_ml.f90 SmallUtils_ml.o Par_ml.o OwnDataTypes_ml.o MosaicOutputs_ml.o ModelConstants_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o AOTnPOD_ml.o -SOA_ml.o : SOA_ml.f90 TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o GridValues_ml.o Functions_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o Chem_ml.o CheckStop_ml.o -My_Outputs_ml.o : My_Outputs_ml.f90 Units_ml.o TimeDate_ml.o SmallUtils_ml.o My_Pollen_ml.o Par_ml.o OwnDataTypes_ml.o PhysicalConstants_ml.o ModelConstants_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o -NetCDF_ml.o : NetCDF_ml.f90 SmallUtils_ml.o Functions_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o MPI_Groups_ml.o ModelConstants_ml.o InterpolationRoutines_ml.o GridValues_ml.o Country_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o Chem_ml.o My_Outputs_ml.o -Nest_ml.o : Nest_ml.f90 CM_ChemGroups_ml.o SmallUtils_ml.o Units_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o My_Pollen_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o InterpolationRoutines_ml.o Io_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o ExternalBICs_ml.o +AerosolCalls.o : AerosolCalls.f90 Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MARS_ml.o EQSAM_ml.o ChemFields_ml.o ChemSpecs_wrapper.o CM_ChemGroups_ml.o CheckStop_ml.o Ammonium_ml.o +My_Derived_ml.o : My_Derived_ml.f90 SmallUtils_ml.o Par_ml.o OwnDataTypes_ml.o MosaicOutputs_ml.o ModelConstants_ml.o Io_Progs_ml.o Io_Nums_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o AOTnPOD_ml.o +My_Outputs_ml.o : My_Outputs_ml.f90 Units_ml.o TimeDate_ml.o SmallUtils_ml.o My_Pollen_ml.o Par_ml.o OwnDataTypes_ml.o PhysicalConstants_ml.o ModelConstants_ml.o DerivedFields_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o CheckStop_ml.o +NetCDF_ml.o : NetCDF_ml.f90 SmallUtils_ml.o Functions_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o MPI_Groups_ml.o ModelConstants_ml.o InterpolationRoutines_ml.o GridValues_ml.o Country_ml.o ChemSpecs_wrapper.o CheckStop_ml.o ChemFields_ml.o My_Outputs_ml.o +Nest_ml.o : Nest_ml.f90 CM_ChemGroups_ml.o SmallUtils_ml.o Units_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o My_Pollen_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o InterpolationRoutines_ml.o Io_ml.o GridValues_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o ExternalBICs_ml.o NumberConstants.o : NumberConstants.f90 -Output_hourly.o : Output_hourly.f90 Units_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o My_Pollen_ml.o My_Pollen_ml.o Par_ml.o NetCDF_ml.o MetFields_ml.o ModelConstants_ml.o Io_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o OwnDataTypes_ml.o DerivedFields_ml.o Derived_ml.o CM_ChemGroups_ml.o Chem_ml.o CheckStop_ml.o My_Outputs_ml.o -OutputChem_ml.o : OutputChem_ml.f90 TimeDate_ExtraUtil_ml.o TimeDate_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o Io_ml.o My_Outputs_ml.o GridValues_ml.o DerivedFields_ml.o Derived_ml.o CheckStop_ml.o +Output_hourly.o : Output_hourly.f90 Units_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SmallUtils_ml.o My_Pollen_ml.o My_Pollen_ml.o Par_ml.o NetCDF_ml.o MetFields_ml.o ModelConstants_ml.o Io_ml.o GridValues_ml.o ChemSpecs_wrapper.o OwnDataTypes_ml.o DerivedFields_ml.o Derived_ml.o ChemFields_ml.o CheckStop_ml.o My_Outputs_ml.o +OutputChem_ml.o : OutputChem_ml.f90 uEMEP_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o Io_ml.o My_Outputs_ml.o GridValues_ml.o DerivedFields_ml.o Derived_ml.o CheckStop_ml.o OwnDataTypes_ml.o : OwnDataTypes_ml.f90 NumberConstants.o Par_ml.o : Par_ml.f90 MPI_Groups_ml.o ModelConstants_ml.o Io_Nums_ml.o CheckStop_ml.o PhysicalConstants_ml.o : PhysicalConstants_ml.f90 PlumeRise_ml.o : PlumeRise_ml.f90 -PointSource_ml.o : PointSource_ml.f90 PhysicalConstants_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PlumeRise_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Io_Progs_ml.o GridValues_ml.o Functions_ml.o CM_ChemSpecs_tmp.o CheckStop_ml.o +PointSource_ml.o : PointSource_ml.f90 PhysicalConstants_ml.o TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PlumeRise_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o LocalVariables_ml.o Io_Progs_ml.o GridValues_ml.o Functions_ml.o ChemSpecs_wrapper.o CheckStop_ml.o Precision_ml.o : Precision_ml.f90 Radiation_ml.o : Radiation_ml.f90 TimeDate_ml.o PhysicalConstants_ml.o -Rb_ml.o : Rb_ml.f90 Wesely_ml.o PhysicalConstants_ml.o ModelConstants_ml.o +Rb_ml.o : Rb_ml.f90 GasParticleCoeffs_ml.o PhysicalConstants_ml.o ModelConstants_ml.o ReadField_ml.o : ReadField_ml.f90 Io_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o CheckStop_ml.o -Rsurface_ml.o : Rsurface_ml.f90 Par_ml.o MetFields_ml.o Wesely_ml.o TimeDate_ml.o Radiation_ml.o ModelConstants_ml.o LocalVariables_ml.o Io_Progs_ml.o DO3SE_ml.o CoDep_ml.o CheckStop_ml.o LandDefs_ml.o -Runchem_ml.o : Runchem_ml.f90 TimeDate_ml.o Setup_1dfields_ml.o Setup_1d_ml.o SeaSalt_ml.o PointSource_ml.o Par_ml.o My_Pollen_ml.o SOA_ml.o ModelConstants_ml.o MassBudget_ml.o Io_Progs_ml.o GridValues_ml.o FastJ_ml.o DustProd_ml.o DryDep_ml.o DefPhotolysis_ml.o CM_ChemSpecs_tmp.o Solver.o Chem_ml.o CheckStop_ml.o CellMet_ml.o Biogenics_ml.o Aqueous_n_WetDep_ml.o AOD_PM_ml.o Timing_ml.o AerosolCalls.o -Setup_1d_ml.o : Setup_1d_ml.f90 Units_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Setup_1dfields_ml.o Radiation_ml.o PhysicalConstants_ml.o Par_ml.o Landuse_ml.o My_Derived_ml.o ModelConstants_ml.o MetFields_ml.o MassBudget_ml.o LocalVariables_ml.o Io_Progs_ml.o GridValues_ml.o CM_ChemRates_ml.o CM_ChemSpecs_tmp.o Functions_ml.o ForestFire_ml.o Emissions_ml.o EmisGet_ml.o EmisDef_ml.o DerivedFields_ml.o ColumnSource_ml.o CheckStop_ml.o CM_ChemGroups_ml.o ChemFunctions_ml.o Chem_ml.o Biogenics_ml.o AirEmis_ml.o AeroFunctions.o +Rsurface_ml.o : Rsurface_ml.f90 Par_ml.o MetFields_ml.o GasParticleCoeffs_ml.o TimeDate_ml.o Radiation_ml.o ModelConstants_ml.o LocalVariables_ml.o Io_Progs_ml.o DO3SE_ml.o CoDep_ml.o CheckStop_ml.o LandDefs_ml.o +Runchem_ml.o : Runchem_ml.f90 TimeDate_ml.o Setup_1dfields_ml.o Setup_1d_ml.o SeaSalt_ml.o PointSource_ml.o Par_ml.o My_Pollen_ml.o SOA_ml.o ModelConstants_ml.o MassBudget_ml.o Io_Progs_ml.o GridValues_ml.o FastJ_ml.o DustProd_ml.o DryDep_ml.o DefPhotolysis_ml.o ColumnSource_ml.o ChemSpecs_wrapper.o Solver.o ChemFields_ml.o CheckStop_ml.o CellMet_ml.o Biogenics_ml.o Aqueous_n_WetDep_ml.o AOD_PM_ml.o Timing_ml.o AerosolCalls.o +Setup_1d_ml.o : Setup_1d_ml.f90 Units_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Setup_1dfields_ml.o Radiation_ml.o PhysicalConstants_ml.o Par_ml.o Landuse_ml.o My_Derived_ml.o ModelConstants_ml.o MetFields_ml.o MassBudget_ml.o LocalVariables_ml.o Io_Progs_ml.o GridValues_ml.o CM_ChemRates_ml.o ChemSpecs_wrapper.o Functions_ml.o ForestFire_ml.o EmisGet_ml.o EmisDef_ml.o DerivedFields_ml.o ColumnSource_ml.o CheckStop_ml.o CM_ChemGroups_ml.o ChemFunctions_ml.o ChemFields_ml.o Biogenics_ml.o AirEmis_ml.o AeroFunctions.o Setup_1dfields_ml.o : Setup_1dfields_ml.f90 ModelConstants_ml.o -Sites_ml.o : Sites_ml.f90 KeyValueTypes.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Par_ml.o NetCDF_ml.o PhysicalConstants_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o Io_ml.o GridValues_ml.o Functions_ml.o DerivedFields_ml.o My_Outputs_ml.o CheckStop_ml.o +Sites_ml.o : Sites_ml.f90 KeyValueTypes.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Par_ml.o NetCDF_ml.o PhysicalConstants_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o Io_ml.o GridValues_ml.o Functions_ml.o DerivedFields_ml.o My_Outputs_ml.o CheckStop_ml.o SmallUtils_ml.o : SmallUtils_ml.f90 +SOA_ml.o : SOA_ml.f90 TimeDate_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o GridValues_ml.o Functions_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_ml.o CM_ChemSpecs_ml.o ChemFields_ml.o CheckStop_ml.o SoilWater_ml.o : SoilWater_ml.f90 TimeDate_ml.o Par_ml.o ModelConstants_ml.o MetFields_ml.o Met_ml.o LocalVariables_ml.o Landuse_ml.o Io_Progs_ml.o GridValues_ml.o -Solver.o : Solver.f90 CM_Reactions2.inc CM_Reactions1.inc Setup_1dfields_ml.o Precision_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o Io_ml.o GridValues_ml.o CM_ChemRates_ml.o Chem_ml.o CM_ChemSpecs_tmp.o CM_ChemGroups_ml.o ChemFunctions_ml.o EmisDef_ml.o DefPhotolysis_ml.o CheckStop_ml.o Aqueous_n_WetDep_ml.o -SeaSalt_ml.o : SeaSalt_ml.f90 TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o Io_Progs_ml.o GridValues_ml.o CM_ChemSpecs_tmp.o Biogenics_ml.o AeroFunctions.o -StoFlux_ml.o : StoFlux_ml.f90 Wesely_ml.o SubMet_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o MicroMet_ml.o LocalVariables_ml.o LandDefs_ml.o Io_Progs_ml.o DO3SE_ml.o CheckStop_ml.o +Solver.o : Solver.f90 CM_Reactions2.inc CM_Reactions1.inc YieldModifications_mod.o Setup_1dfields_ml.o Precision_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o Io_ml.o GridValues_ml.o EmisDef_ml.o emep_Config_mod.o DefPhotolysis_ml.o CM_ChemRates_ml.o ChemFields_ml.o ChemSpecs_wrapper.o CM_ChemGroups_ml.o ChemFunctions_ml.o CheckStop_ml.o Aqueous_n_WetDep_ml.o +SeaSalt_ml.o : SeaSalt_ml.f90 TimeDate_ml.o SubMet_ml.o SmallUtils_ml.o Setup_1dfields_ml.o PhysicalConstants_ml.o ModelConstants_ml.o MicroMet_ml.o MetFields_ml.o LocalVariables_ml.o Landuse_ml.o Io_Progs_ml.o GridValues_ml.o ChemSpecs_wrapper.o Biogenics_ml.o AeroFunctions.o +StoFlux_ml.o : StoFlux_ml.f90 GasParticleCoeffs_ml.o SubMet_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o ModelConstants_ml.o MicroMet_ml.o LocalVariables_ml.o LandDefs_ml.o Io_Progs_ml.o DO3SE_ml.o CheckStop_ml.o SubMet_ml.o : SubMet_ml.f90 PhysicalConstants_ml.o ModelConstants_ml.o MicroMet_ml.o LocalVariables_ml.o Landuse_ml.o LandDefs_ml.o BLPhysics_ml.o MetFields_ml.o Functions_ml.o CheckStop_ml.o Tabulations_ml.o : Tabulations_ml.f90 ModelConstants_ml.o PhysicalConstants_ml.o TimeDate_ml.o : TimeDate_ml.f90 TimeDate_ExtraUtil_ml.o : TimeDate_ExtraUtil_ml.f90 TimeDate_ml.o CheckStop_ml.o SmallUtils_ml.o ModelConstants_ml.o Par_ml.o Timefactors_ml.o : Timefactors_ml.f90 TimeDate_ml.o Io_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o NetCDF_ml.o ModelConstants_ml.o Met_ml.o InterpolationRoutines_ml.o GridValues_ml.o EmisDef_ml.o Country_ml.o CheckStop_ml.o Timing_ml.o : Timing_ml.f90 -Trajectory_ml.o : Trajectory_ml.f90 TimeDate_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o Chem_ml.o My_Outputs_ml.o -Units_ml.o : Units_ml.f90 My_Pollen_ml.o SmallUtils_ml.o OwnDataTypes_ml.o PhysicalConstants_ml.o ModelConstants_ml.o CM_ChemSpecs_tmp.o CM_ChemGroups_ml.o CheckStop_ml.o -Unimod.o : Unimod.f90 My_3DVar_ml.o Nest_ml.o Trajectory_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Sites_ml.o PhyChem_ml.o Par_ml.o OutputChem_ml.o NetCDF_ml.o MPI_Groups_ml.o ModelConstants_ml.o Met_ml.o MassBudget_ml.o Landuse_ml.o Io_Progs_ml.o Io_ml.o GridValues_ml.o ForestFire_ml.o Emissions_ml.o EcoSystem_ml.o DerivedFields_ml.o Derived_ml.o DefPhotolysis_ml.o Country_ml.o CM_ChemGroups_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o BoundaryConditions_ml.o Biogenics_ml.o AirEmis_ml.o Aqueous_n_WetDep_ml.o Advection_ml.o Timing_ml.o My_Outputs_ml.o -Wesely_ml.o : Wesely_ml.f90 PhysicalConstants_ml.o -isocom.o : isocom.f90 isrpia.inc -ISOFWD.o : ISOFWD.f90 isrpia.inc -isorev.o : isorev.f90 isrpia.inc +Trajectory_ml.o : Trajectory_ml.f90 TimeDate_ml.o Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o MetFields_ml.o Io_ml.o GridValues_ml.o ChemFields_ml.o My_Outputs_ml.o +uEMEP_ml.o : uEMEP_ml.f90 Timefactors_ml.o TimeDate_ml.o SmallUtils_ml.o PhysicalConstants_ml.o Par_ml.o OwnDataTypes_ml.o NetCDF_ml.o ModelConstants_ml.o MetFields_ml.o GridValues_ml.o EmisGet_ml.o EmisDef_ml.o Country_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o +Units_ml.o : Units_ml.f90 SmallUtils_ml.o OwnDataTypes_ml.o My_Pollen_ml.o PhysicalConstants_ml.o ModelConstants_ml.o ChemSpecs_wrapper.o CM_ChemGroups_ml.o CheckStop_ml.o +Unimod.o : Unimod.f90 uEMEP_ml.o Trajectory_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o Tabulations_ml.o SmallUtils_ml.o Sites_ml.o PhyChem_ml.o Par_ml.o OutputChem_ml.o NetCDF_ml.o Nest_ml.o MPI_Groups_ml.o ModelConstants_ml.o Met_ml.o MassBudget_ml.o Landuse_ml.o Io_Progs_ml.o Io_ml.o GridValues_ml.o ForestFire_ml.o Emissions_ml.o EcoSystem_ml.o Derived_ml.o DefPhotolysis_ml.o My_3DVar_ml.o Country_ml.o CM_ChemGroups_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o BoundaryConditions_ml.o Biogenics_ml.o AirEmis_ml.o Aqueous_n_WetDep_ml.o Advection_ml.o Timing_ml.o My_Outputs_ml.o +YieldModifications_mod.o : YieldModifications_mod.f90 SmallUtils_ml.o NumberConstants.o ModelConstants_ml.o emep_Config_mod.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o global2local.o : global2local.f90 Par_ml.o MPI_Groups_ml.o ModelConstants_ml.o -PhyChem_ml.o : PhyChem_ml.f90 Timefactors_ml.o Sites_ml.o Runchem_ml.o Radiation_ml.o Trajectory_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SoilWater_ml.o My_Pollen_ml.o Par_ml.o Nest_ml.o Timing_ml.o My_Outputs_ml.o OutputChem_ml.o MetFields_ml.o ModelConstants_ml.o GridValues_ml.o Emissions_ml.o EmisDef_ml.o DryDep_ml.o DerivedFields_ml.o Derived_ml.o My_3DVar_ml.o My_3DVar_ml.o CoDep_ml.o CM_ChemSpecs_tmp.o Chem_ml.o CheckStop_ml.o Biogenics_ml.o Advection_ml.o +PhyChem_ml.o : PhyChem_ml.f90 Timefactors_ml.o Sites_ml.o Runchem_ml.o Radiation_ml.o uEMEP_ml.o Trajectory_ml.o TimeDate_ExtraUtil_ml.o TimeDate_ml.o SoilWater_ml.o My_Pollen_ml.o PhysicalConstants_ml.o Par_ml.o Nest_ml.o Timing_ml.o My_Outputs_ml.o OutputChem_ml.o NetCDF_ml.o MetFields_ml.o ModelConstants_ml.o GridValues_ml.o Gravset_ml.o Emissions_ml.o EmisDef_ml.o DryDep_ml.o DerivedFields_ml.o Derived_ml.o My_3DVar_ml.o My_3DVar_ml.o CoDep_ml.o ChemSpecs_wrapper.o ChemFields_ml.o CheckStop_ml.o Biogenics_ml.o Advection_ml.o My_3DVar_ml.o : My_3DVar_ml.f90 ModelConstants_ml.o CheckStop_ml.o -My_Pollen_ml.o : My_Pollen_ml.f90 CheckStop_ml.o CM_ChemSpecs_tmp.o ModelConstants_ml.o PhysicalConstants_ml.o -My_ESX_ml.o : My_ESX_ml.f90 +My_Pollen_ml.o : My_Pollen_ml.f90 CheckStop_ml.o ChemSpecs_wrapper.o ModelConstants_ml.o diff --git a/emep_Config_mod.f90 b/emep_Config_mod.f90 new file mode 100644 index 0000000..0198f8e --- /dev/null +++ b/emep_Config_mod.f90 @@ -0,0 +1,70 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program is distributed in the hope that it will be useful, +!* but WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +module emep_Config_mod + !--------------------------------------------------------------------- + ! A start of a more general module to store variables which + ! can be easily changed though the namelist system. Will + ! take over some of the job of the current ModelConstants; + ! the latter stopped using just constants years ago ;-) + !--------------------------------------------------------------------- + implicit none + private + + type, private :: PBL_t + real :: ZiMIN = 100.0 ! minimum mixing height + real :: ZiMAX = 3000.0 ! maximum mixing height + character(len=10) :: HmixMethod = "JcRb" ! Method used for Hmix + ! JcRb = Jericevic/Richardson number method + ! "SbRb"= Seibert !"TIZi" = Original from Trond Iversen tiphysics + end type PBL_t + type(PBL_t), public, save :: PBL = PBL_t() + + type, private :: EmBio_t + character(len=10) :: GlobBvocMethod = '-' ! can be MEGAN + real :: IsopFac = 1.0 ! for experiments + real :: TerpFac = 1.0 ! for experiments + ! canopy light factor, 1/1.7=0.59, based on Lamb 1993 (cf MEGAN 0.57) + real :: CLF = 1.0 ! canopy factor, leaf vs branch emissions + end type EmBio_t + type(EmBio_t), public, save :: EmBio = EmBio_t() + + ! We allow a flexible string which can switch between different + ! experiments called by e.g. Solver. A but crude, but + ! it makes sure the experiments are recorded in the config + ! system + + character(len=100), save, public :: YieldModifications = 'VBS' ! Default for EmChem16mt + + + type, private :: LandCoverInputs_t + character(len=200), dimension(2) :: MapFile = 'NOTSET' ! Usually PS European + global + character(len=200) :: LandDefs = '-' ! LAI, h, etc (was Inputs_LandDefs + character(len=200) :: Do3seDefs = '-' ! DO3SE inputs + end type LandCoverInputs_t + type(LandCoverInputs_t), public, save :: LandCoverInputs=LandCoverInputs_t() + +end module emep_Config_mod diff --git a/global2local.f90 b/global2local.f90 index d41f852..a22a5e3 100644 --- a/global2local.f90 +++ b/global2local.f90 @@ -34,8 +34,7 @@ subroutine global2local(gloarr,locarr,msnr& ! the input array gloarr may be already restricted or not ! use ModelConstants_ml, only : NPROC ! Actual total number of processors - use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER& - ,MPI_SUM,MPI_COMM_CALC, MPISTATUS,IERROR + use MPI_Groups_ml , only : MPI_BYTE, MPI_COMM_CALC, MPISTATUS,IERROR use PAR_ML , only : & MAXLIMAX& ! Maximum number of local points in longitude& ,MAXLJMAX& ! Maximum number of local points in latitude& @@ -83,13 +82,13 @@ subroutine global2local(gloarr,locarr,msnr& do n0 = 1,dim0 locarr(n0,i,j,nl) = gloarr(n0,tgi0(d)+ibeg-2+i& ,tgj0(d)+jbeg-2+j,nl) - enddo - enddo - enddo - enddo + end do + end do + end do + end do CALL MPI_SEND(locarr,8*dim0*MAXLIMAX*MAXLJMAX*diml, MPI_BYTE, & d, msnr, MPI_COMM_CALC, IERROR) - enddo + end do ! ! now assign processor 0 itself ! @@ -98,12 +97,12 @@ subroutine global2local(gloarr,locarr,msnr& do i = 1, tlimax(0) do n0 = 1,dim0 locarr(n0,i,j,nl) = gloarr(n0,i+ibeg-1,j+jbeg-1,nl) - enddo - enddo - enddo - enddo + end do + end do + end do + end do ! - endif ! me=? + end if ! me=? ! return end @@ -162,12 +161,12 @@ subroutine global2local_int(gloarr,locarr,msnr& do i = 1, tlimax(d) locarr(i,j,nl)=gloarr(tgi0(d)+ibeg-2+i& ,tgj0(d)+jbeg-2+j,nl) - enddo - enddo - enddo + end do + end do + end do CALL MPI_SEND( locarr, 4*MAXLIMAX*MAXLJMAX*diml, & MPI_BYTE, d, msnr, MPI_COMM_CALC, IERROR) - enddo + end do ! ! now assign processor 0 itself ! @@ -175,11 +174,11 @@ subroutine global2local_int(gloarr,locarr,msnr& do j = 1, tljmax(0) do i = 1, tlimax(0) locarr(i,j,nl) = gloarr(i+ibeg-1,j+jbeg-1,nl) - enddo - enddo - enddo + end do + end do + end do ! - endif ! me = ? + end if ! me = ? ! return end @@ -194,8 +193,7 @@ subroutine global2local_short(gloarr,locarr,msnr& ! use ModelConstants_ml, only : NPROC ! Actual total number of processors - use MPI_Groups_ml , only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER,& - MPISTATUS, MPI_SUM,MPI_COMM_CALC, IERROR + use MPI_Groups_ml , only : MPI_BYTE, MPISTATUS, MPI_COMM_CALC, IERROR use PAR_ML , only : & MAXLIMAX& ! Maximum number of local points in longitude& ,MAXLJMAX& ! Maximum number of local points in latitude& @@ -240,14 +238,14 @@ subroutine global2local_short(gloarr,locarr,msnr& do i = 1, tlimax(d) locarr(i,j,nl)=gloarr(tgi0(d)+ibeg-2+i& ,tgj0(d)+jbeg-2+j,nl) - enddo - enddo - enddo + end do + end do + end do CALL MPI_SEND(locarr, MAXLIMAX*MAXLJMAX*diml*2, MPI_BYTE, & d, msnr,MPI_COMM_CALC, IERROR) - enddo + end do ! ! now assign processor 0 itself ! @@ -255,12 +253,11 @@ subroutine global2local_short(gloarr,locarr,msnr& do j = 1, tljmax(0) do i = 1, tlimax(0) locarr(i,j,nl) = gloarr(i+ibeg-1,j+jbeg-1,nl) - enddo - enddo - enddo + end do + end do + end do ! - endif ! me = ? + end if ! me = ? ! return end - diff --git a/isocom.f90 b/isocom.f90 deleted file mode 100644 index f10f7ae..0000000 --- a/isocom.f90 +++ /dev/null @@ -1,16696 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program is distributed in the hope that it will be useful, -!* but WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -! ====================================================================== - -! *** ISORROPIA CODE II -! *** SUBROUTINE ISOROPIA -! *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA -! THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSION 1.1 and above) - -! ======================== ARGUMENTS / USAGE =========================== - -! INPUT: -! 1. [WI] -! real array of length [8]. -! Concentrations, expressed in moles/m3. Depending on the type of -! problem solved (specified in CNTRL(1)), WI contains either -! GAS+AEROSOL or AEROSOL only concentratios. -! WI(1) - sodium -! WI(2) - sulfate -! WI(3) - ammonium -! WI(4) - nitrate -! WI(5) - chloride -! WI(6) - calcium -! WI(7) - potassium -! WI(8) - magnesium - -! 2. [RHI] -! real variable. -! Ambient relative humidity expressed on a (0,1) scale. - -! 3. [TEMPI] -! real variable. -! Ambient temperature expressed in Kelvins. - -! 4. [CNTRL] -! real array of length [2]. -! Parameters that control the type of problem solved. - -! CNTRL(1): Defines the type of problem solved. -! 0 - Forward problem is solved. In this case, array WI contains -! GAS and AEROSOL concentrations together. -! 1 - Reverse problem is solved. In this case, array WI contains -! AEROSOL concentrations only. - -! CNTRL(2): Defines the state of the aerosol -! 0 - The aerosol can have both solid+liquid phases (deliquescent) -! 1 - The aerosol is in only liquid state (metastable aerosol) - -! OUTPUT: -! 1. [WT] -! real array of length [8]. -! Total concentrations (GAS+AEROSOL) of species, expressed in moles/m3. -! If the foreward probelm is solved (CNTRL(1)=0), array WT is -! identical to array WI. -! WT(1) - total sodium -! WT(2) - total sulfate -! WT(3) - total ammonium -! WT(4) - total nitrate -! WT(5) - total chloride -! WT(6) - total calcium -! WT(7) - total potassium -! WT(8) - total magnesium - -! 2. [GAS] -! real array of length [03]. -! Gaseous species concentrations, expressed in moles/m3. -! GAS(1) - NH3 -! GAS(2) - HNO3 -! GAS(3) - HCl - -! 3. [AERLIQ] -! real array of length [15]. -! Liquid aerosol species concentrations, expressed in moles/m3. -! AERLIQ(01) - H+(aq) -! AERLIQ(02) - Na+(aq) -! AERLIQ(03) - NH4+(aq) -! AERLIQ(04) - Cl-(aq) -! AERLIQ(05) - SO4--(aq) -! AERLIQ(06) - HSO4-(aq) -! AERLIQ(07) - NO3-(aq) -! AERLIQ(08) - H2O -! AERLIQ(09) - NH3(aq) (undissociated) -! AERLIQ(10) - HNCl(aq) (undissociated) -! AERLIQ(11) - HNO3(aq) (undissociated) -! AERLIQ(12) - OH-(aq) -! AERLIQ(13) - Ca2+(aq) -! AERLIQ(14) - K+(aq) -! AERLIQ(15) - Mg2+(aq) - -! 4. [AERSLD] -! real array of length [19]. -! Solid aerosol species concentrations, expressed in moles/m3. -! AERSLD(01) - NaNO3(s) -! AERSLD(02) - NH4NO3(s) -! AERSLD(03) - NaCl(s) -! AERSLD(04) - NH4Cl(s) -! AERSLD(05) - Na2SO4(s) -! AERSLD(06) - (NH4)2SO4(s) -! AERSLD(07) - NaHSO4(s) -! AERSLD(08) - NH4HSO4(s) -! AERSLD(09) - (NH4)4H(SO4)2(s) -! AERSLD(10) - CaSO4(s) -! AERSLD(11) - Ca(NO3)2(s) -! AERSLD(12) - CaCl2(s) -! AERSLD(13) - K2SO4(s) -! AERSLD(14) - KHSO4(s) -! AERSLD(15) - KNO3(s) -! AERSLD(16) - KCl(s) -! AERSLD(17) - MgSO4(s) -! AERSLD(18) - Mg(NO3)2(s) -! AERSLD(19) - MgCl2(s) - -! 5. [SCASI] -! CHARACTER*15 variable. -! Returns the subcase which the input corresponds to. - -! 6. [OTHER] -! real array of length [9]. -! Returns solution information. - -! OTHER(1): Shows if aerosol water exists. -! 0 - Aerosol is WET -! 1 - Aerosol is DRY - -! OTHER(2): Aerosol Sulfate ratio, defined as (in moles/m3) : -! (total ammonia + total Na) / (total sulfate) - -! OTHER(3): Sulfate ratio based on aerosol properties that defines -! a sulfate poor system: -! (aerosol ammonia + aerosol Na) / (aerosol sulfate) - -! OTHER(4): Aerosol sodium ratio, defined as (in moles/m3) : -! (total Na) / (total sulfate) - -! OTHER(5): Ionic strength of the aqueous aerosol (if it exists). - -! OTHER(6): Total number of calls to the activity coefficient -! calculation subroutine. - -! OTHER(7): Sulfate ratio with crustal species, defined as (in moles/m3) : -! (total ammonia + total crustal species + total Na) / (total sulfate) - -! OTHER(8): Crustal species + sodium ratio, defined as (in moles/m3) : -! (total crustal species + total Na) / (total sulfate) - -! OTHER(9): Crustal species ratio, defined as (in moles/m3) : -! (total crustal species) / (total sulfate) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL, & - WT, GAS, AERLIQ, AERSLD, SCASI, OTHER) - INCLUDE 'isrpia.inc' - PARAMETER (NCTRL=2,NOTHER=9) - CHARACTER SCASI*15 - DIMENSION WI(NCOMP), WT(NCOMP), GAS(NGASAQ), AERSLD(NSLDS), & - AERLIQ(NIONS+NGASAQ+2), CNTRL(NCTRL), OTHER(NOTHER) - -! *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ****************************** - - IPROB = NINT(CNTRL(1)) - -! *** AEROSOL STATE (0=SOLID+LIQUID, 1=METASTABLE) ********************** - - METSTBL = NINT(CNTRL(2)) - -! *** SOLVE FOREWARD PROBLEM ******************************************** - - 50 IF (IPROB == 0) THEN - IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) & - THEN !Everything=0 - CALL INIT1 (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL ISRP1F (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL ISRP2F (WI, RHI, TEMPI) - ELSE IF (WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg=0 - CALL ISRP3F (WI, RHI, TEMPI) - ELSE - CALL ISRP4F (WI, RHI, TEMPI) - ENDIF - - ! *** SOLVE REVERSE PROBLEM ********************************************* - - ELSE - IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) & - THEN !Everything=0 - CALL INIT1 (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(4)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL ISRP1R (WI, RHI, TEMPI) - ELSE IF (WI(1)+WI(5)+WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL ISRP2R (WI, RHI, TEMPI) - ELSE IF (WI(6)+WI(7)+WI(8) <= TINY) THEN !Ca,K,Mg=0 - CALL ISRP3R (WI, RHI, TEMPI) - ELSE - CALL ISRP4R (WI, RHI, TEMPI) - ENDIF - ENDIF - -! *** ADJUST MASS BALANCE *********************************************** - - IF (NADJ == 1) CALL ADJUST (WI) -! C -! C *** IF METASTABLE AND NO WATER - RESOLVE AS NORMAL ******************** -! C -!c IF (WATER.LE.TINY .AND. METSTBL.EQ.1) THEN -!c METSTBL = 0 -!c GOTO 50 -!c ENDIF - - -! *** SAVE RESULTS TO ARRAYS (units = mole/m3) **************************** - - GAS(1) = GNH3 ! Gaseous aerosol species - GAS(2) = GHNO3 - GAS(3) = GHCL - - DO 10 I=1,7 ! Liquid aerosol species - AERLIQ(I) = MOLAL(I) - 10 END DO - DO 20 I=1,NGASAQ - AERLIQ(7+1+I) = GASAQ(I) - 20 END DO - AERLIQ(7+1) = WATER*1.0D3/18.0D0 - AERLIQ(7+NGASAQ+2) = COH - - DO 250 I=8,10 ! Liquid aerosol species - AERLIQ(I+5) = MOLAL(I) - 250 END DO - - AERSLD(1) = CNANO3 ! Solid aerosol species - AERSLD(2) = CNH4NO3 - AERSLD(3) = CNACL - AERSLD(4) = CNH4CL - AERSLD(5) = CNA2SO4 - AERSLD(6) = CNH42S4 - AERSLD(7) = CNAHSO4 - AERSLD(8) = CNH4HS4 - AERSLD(9) = CLC - AERSLD(10) = CCASO4 - AERSLD(11) = CCANO32 - AERSLD(12) = CCACL2 - AERSLD(13) = CK2SO4 - AERSLD(14) = CKHSO4 - AERSLD(15) = CKNO3 - AERSLD(16) = CKCL - AERSLD(17) = CMGSO4 - AERSLD(18) = CMGNO32 - AERSLD(19) = CMGCL2 - - IF(WATER <= TINY) THEN ! Dry flag - OTHER(1) = 1.d0 - ELSE - OTHER(1) = 0.d0 - ENDIF - - OTHER(2) = SULRAT ! Other stuff - OTHER(3) = SULRATW - OTHER(4) = SODRAT - OTHER(5) = IONIC - OTHER(6) = ICLACT - OTHER(7) = SO4RAT - OTHER(8) = CRNARAT - OTHER(9) = CRRAT - - SCASI = SCASE - - WT(1) = WI(1) ! Total gas+aerosol phase - WT(2) = WI(2) - WT(3) = WI(3) - WT(4) = WI(4) - WT(5) = WI(5) - WT(6) = WI(6) - WT(7) = WI(7) - WT(8) = WI(8) - - - IF (IPROB > 0 .AND. WATER > TINY) THEN - WT(3) = WT(3) + GNH3 - WT(4) = WT(4) + GHNO3 - WT(5) = WT(5) + GHCL - ENDIF - - RETURN - -! *** END OF SUBROUTINE ISOROPIA ****************************************** - - END SUBROUTINE ISOROPIA -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE SETPARM -! *** THIS SUBROUTINE REDEFINES THE SOLUTION PARAMETERS OF ISORROPIA - -! ======================== ARGUMENTS / USAGE =========================== - -! *** NOTE: IF NEGATIVE VALUES ARE GIVEN FOR A PARAMETER, IT IS -! IGNORED AND THE CURRENT VALUE IS USED INSTEAD. - -! INPUT: -! 1. [WFTYPI] -! INTEGER variable. -! Defines the type of weighting algorithm for the solution in Mutual -! Deliquescence Regions (MDR's): -! 0 - MDR's are assumed dry. This is equivalent to the approach -! used by SEQUILIB. -! 1 - The solution is assumed "half" dry and "half" wet throughout -! the MDR. -! 2 - The solution is a relative-humidity weighted mean of the -! dry and wet solutions (as defined in Nenes et al., 1998) - -! 2. [IACALCI] -! INTEGER variable. -! Method of activity coefficient calculation: -! 0 - Calculate coefficients during runtime -! 1 - Use precalculated tables - -! 3. [EPSI] -! DOUBLE PRECITION variable. -! Defines the convergence criterion for all iterative processes -! in ISORROPIA, except those for activity coefficient calculations -! (EPSACTI controls that). - -! 4. [MAXITI] -! INTEGER variable. -! Defines the maximum number of iterations for all iterative -! processes in ISORROPIA, except for activity coefficient calculations -! (NSWEEPI controls that). - -! 5. [NSWEEPI] -! INTEGER variable. -! Defines the maximum number of iterations for activity coefficient -! calculations. - -! 6. [EPSACTI] -! real variable. -! Defines the convergence criterion for activity coefficient -! calculations. - -! 7. [NDIV] -! INTEGER variable. -! Defines the number of subdivisions needed for the initial root -! tracking for the bisection method. Usually this parameter should -! not be altered, but is included for completeness. - -! 8. [NADJ] -! INTEGER variable. -! Forces the solution obtained to satisfy total mass balance -! to machine precision -! 0 - No adjustment done (default) -! 1 - Do adjustment - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE SETPARM (WFTYPI, IACALCI, EPSI, MAXITI, NSWEEPI, & - EPSACTI, NDIVI, NADJI) - INCLUDE 'isrpia.inc' - INTEGER :: WFTYPI - -! *** SETUP SOLUTION PARAMETERS ***************************************** - - IF (WFTYPI >= 0) WFTYP = WFTYPI - IF (IACALCI >= 0) IACALC = IACALCI - IF (EPSI >= ZERO) EPS = EPSI - IF (MAXITI > 0) MAXIT = MAXITI - IF (NSWEEPI > 0) NSWEEP = NSWEEPI - IF (EPSACTI >= ZERO) EPSACT = EPSACTI - IF (NDIVI > 0) NDIV = NDIVI - IF (NADJI >= 0) NADJ = NADJI - -! *** END OF SUBROUTINE SETPARM ***************************************** - - RETURN - END SUBROUTINE SETPARM - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE GETPARM -! *** THIS SUBROUTINE OBTAINS THE CURRENT VAULES OF THE SOLUTION -! PARAMETERS OF ISORROPIA - -! ======================== ARGUMENTS / USAGE =========================== - -! *** THE PARAMETERS ARE THOSE OF SUBROUTINE SETPARM - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE GETPARM (WFTYPI, IACALCI, EPSI, MAXITI, NSWEEPI, & - EPSACTI, NDIVI, NADJI) - INCLUDE 'isrpia.inc' - INTEGER :: WFTYPI - -! *** GET SOLUTION PARAMETERS ******************************************* - - WFTYPI = WFTYP - IACALCI = IACALC - EPSI = EPS - MAXITI = MAXIT - NSWEEPI = NSWEEP - EPSACTI = EPSACT - NDIVI = NDIV - NADJI = NADJ - -! *** END OF SUBROUTINE GETPARM ***************************************** - - RETURN - END SUBROUTINE GETPARM - -!======================================================================= - -! *** ISORROPIA CODE -! *** BLOCK DATA BLKISO -! *** THIS SUBROUTINE PROVIDES INITIAL (DEFAULT) VALUES TO PROGRAM -! PARAMETERS VIA DATA STATEMENTS - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -! *** ZSR RELATIONSHIP PARAMETERS MODIFIED BY DOUGLAS WALDRON -! *** OCTOBER 2003 -! *** BASED ON AIM MODEL III (http://mae.ucdavis.edu/wexler/aim) - -!======================================================================= - - BLOCK DATA BLKISO - INCLUDE 'isrpia.inc' - -! *** DEFAULT VALUES ************************************************* - - DATA TEMP/298.0/, R/82.0567D-6/, RH/0.9D0/, EPS/1D-6/, MAXIT/100/, & - TINY/1D-20/, GREAT/1D10/, ZERO/0.0D0/, ONE/1.0D0/,NSWEEP/4/, & - TINY2/1D-11/,NDIV/5/ - - DATA MOLAL/NIONS*0.0D0/, MOLALR/NPAIR*0.0D0/, GAMA/NPAIR*0.1D0/, & - GAMOU/NPAIR*1D10/, GAMIN/NPAIR*1D10/, CALAIN/ .TRUE. /, & - CALAOU/ .TRUE. /, EPSACT/5D-2/, ICLACT/0/, & - IACALC/1/, NADJ/0/, WFTYP/2/ - - DATA ERRSTK/NERRMX*0/, ERRMSG/NERRMX*' '/, NOFER/0/, & - STKOFL/ .FALSE. / - - DATA IPROB/0/, METSTBL/0/ - - DATA VERSION /'2.1 (07/19/09)'/ - -! *** OTHER PARAMETERS *********************************************** - - DATA SMW/58.5,142.,85.0,132.,80.0,53.5,98.0,98.0,115.,63.0, & - & 36.5,120.,247.,136.1,164.,111.,174.2,136.1,101.1,74.5, & - & 120.3,148.3,95.2/ & - IMW/ 1.0,23.0,18.0,35.5,96.0,97.0,62.0,40.1,39.1,24.3/ & - WMW/23.0,98.0,17.0,63.0,36.5,40.1,39.1,24.3/ - - DATA ZZ /1,2,1,2,1,1,2,1,1,1,1,1,2,4,2,2,2,1,1,1,4,2,2/ & - Z /1,1,1,1,2,1,1,2,1,2/ - -! *** ZSR RELATIONSHIP PARAMETERS ************************************** - -! awas= ammonium sulfate - - DATA AWAS/10*187.72, & - & 158.13,134.41,115.37,100.10, 87.86, 78.00, 70.00, 63.45, 58.02, & - & 53.46, & - & 49.59, 46.26, 43.37, 40.84, 38.59, 36.59, 34.79, 33.16, 31.67, & - & 30.31, & - & 29.07, 27.91, 26.84, 25.84, 24.91, 24.03, 23.21, 22.44, 21.70, & - & 21.01, & - & 20.34, 19.71, 19.11, 18.54, 17.99, 17.46, 16.95, 16.46, 15.99, & - & 15.54, & - & 15.10, 14.67, 14.26, 13.86, 13.47, 13.09, 12.72, 12.36, 12.01, & - & 11.67, & - & 11.33, 11.00, 10.68, 10.37, 10.06, 9.75, 9.45, 9.15, 8.86, & - & 8.57, & - & 8.29, 8.01, 7.73, 7.45, 7.18, 6.91, 6.64, 6.37, 6.10, & - & 5.83, & - & 5.56, 5.29, 5.02, 4.74, 4.47, 4.19, 3.91, 3.63, 3.34, & - & 3.05, & - & 2.75, 2.45, 2.14, 1.83, 1.51, 1.19, 0.87, 0.56, 0.26, & - & 0.1/ - -! awsn= sodium nitrate - - DATA AWSN/10*394.54, & - & 338.91,293.01,254.73,222.61,195.56,172.76,153.53,137.32,123.65, & - & 112.08, & - & 102.26, 93.88, 86.68, 80.45, 75.02, 70.24, 66.02, 62.26, 58.89, & - & 55.85, & - & 53.09, 50.57, 48.26, 46.14, 44.17, 42.35, 40.65, 39.06, 37.57, & - & 36.17, & - & 34.85, 33.60, 32.42, 31.29, 30.22, 29.20, 28.22, 27.28, 26.39, & - & 25.52, & - & 24.69, 23.89, 23.12, 22.37, 21.65, 20.94, 20.26, 19.60, 18.96, & - & 18.33, & - & 17.72, 17.12, 16.53, 15.96, 15.40, 14.85, 14.31, 13.78, 13.26, & - & 12.75, & - & 12.25, 11.75, 11.26, 10.77, 10.29, 9.82, 9.35, 8.88, 8.42, & - & 7.97, & - & 7.52, 7.07, 6.62, 6.18, 5.75, 5.32, 4.89, 4.47, 4.05, & - & 3.64, & - & 3.24, 2.84, 2.45, 2.07, 1.70, 1.34, 0.99, 0.65, 0.31, & - & 0.1/ - -! awsc= sodium chloride - - DATA AWSC/10*28.16, & - & 27.17, 26.27, 25.45, 24.69, 23.98, 23.33, 22.72, 22.14, 21.59, & - & 21.08, & - & 20.58, 20.12, 19.67, 19.24, 18.82, 18.43, 18.04, 17.67, 17.32, & - & 16.97, & - & 16.63, 16.31, 15.99, 15.68, 15.38, 15.08, 14.79, 14.51, 14.24, & - & 13.97, & - & 13.70, 13.44, 13.18, 12.93, 12.68, 12.44, 12.20, 11.96, 11.73, & - & 11.50, & - & 11.27, 11.05, 10.82, 10.60, 10.38, 10.16, 9.95, 9.74, 9.52, & - & 9.31, & - & 9.10, 8.89, 8.69, 8.48, 8.27, 8.07, 7.86, 7.65, 7.45, & - & 7.24, & - & 7.04, 6.83, 6.62, 6.42, 6.21, 6.00, 5.79, 5.58, 5.36, & - & 5.15, & - & 4.93, 4.71, 4.48, 4.26, 4.03, 3.80, 3.56, 3.32, 3.07, & - & 2.82, & - & 2.57, 2.30, 2.04, 1.76, 1.48, 1.20, 0.91, 0.61, 0.30, & - & 0.1/ - -! awac= ammonium chloride - - DATA AWAC/10*1209.00, & - & 1067.60,949.27,848.62,761.82,686.04,619.16,559.55,505.92,457.25, & - & 412.69, & - & 371.55,333.21,297.13,262.81,229.78,197.59,165.98,135.49,108.57, & - & 88.29, & - & 74.40, 64.75, 57.69, 52.25, 47.90, 44.30, 41.27, 38.65, 36.36, & - & 34.34, & - & 32.52, 30.88, 29.39, 28.02, 26.76, 25.60, 24.51, 23.50, 22.55, & - & 21.65, & - & 20.80, 20.00, 19.24, 18.52, 17.83, 17.17, 16.54, 15.93, 15.35, & - & 14.79, & - & 14.25, 13.73, 13.22, 12.73, 12.26, 11.80, 11.35, 10.92, 10.49, & - & 10.08, & - & 9.67, 9.28, 8.89, 8.51, 8.14, 7.77, 7.42, 7.06, 6.72, & - & 6.37, & - & 6.03, 5.70, 5.37, 5.05, 4.72, 4.40, 4.08, 3.77, 3.45, & - & 3.14, & - & 2.82, 2.51, 2.20, 1.89, 1.57, 1.26, 0.94, 0.62, 0.31, & - & 0.1/ - -! awss= sodium sulfate - - DATA AWSS/10*24.10, & - & 23.17, 22.34, 21.58, 20.90, 20.27, 19.69, 19.15, 18.64, 18.17, & - & 17.72, & - & 17.30, 16.90, 16.52, 16.16, 15.81, 15.48, 15.16, 14.85, 14.55, & - & 14.27, & - & 13.99, 13.73, 13.47, 13.21, 12.97, 12.73, 12.50, 12.27, 12.05, & - & 11.84, & - & 11.62, 11.42, 11.21, 11.01, 10.82, 10.63, 10.44, 10.25, 10.07, & - & 9.89, & - & 9.71, 9.53, 9.36, 9.19, 9.02, 8.85, 8.68, 8.51, 8.35, & - & 8.19, & - & 8.02, 7.86, 7.70, 7.54, 7.38, 7.22, 7.06, 6.90, 6.74, & - & 6.58, & - & 6.42, 6.26, 6.10, 5.94, 5.78, 5.61, 5.45, 5.28, 5.11, & - & 4.93, & - & 4.76, 4.58, 4.39, 4.20, 4.01, 3.81, 3.60, 3.39, 3.16, & - & 2.93, & - & 2.68, 2.41, 2.13, 1.83, 1.52, 1.19, 0.86, 0.54, 0.25, & - & 0.1/ - -! awab= ammonium bisulfate - - DATA AWAB/10*312.84, & - & 271.43,237.19,208.52,184.28,163.64,145.97,130.79,117.72,106.42, & - & 96.64, & - & 88.16, 80.77, 74.33, 68.67, 63.70, 59.30, 55.39, 51.89, 48.76, & - & 45.93, & - & 43.38, 41.05, 38.92, 36.97, 35.18, 33.52, 31.98, 30.55, 29.22, & - & 27.98, & - & 26.81, 25.71, 24.67, 23.70, 22.77, 21.90, 21.06, 20.27, 19.52, & - & 18.80, & - & 18.11, 17.45, 16.82, 16.21, 15.63, 15.07, 14.53, 14.01, 13.51, & - & 13.02, & - & 12.56, 12.10, 11.66, 11.24, 10.82, 10.42, 10.04, 9.66, 9.29, & - & 8.93, & - & 8.58, 8.24, 7.91, 7.58, 7.26, 6.95, 6.65, 6.35, 6.05, & - & 5.76, & - & 5.48, 5.20, 4.92, 4.64, 4.37, 4.09, 3.82, 3.54, 3.27, & - & 2.99, & - & 2.70, 2.42, 2.12, 1.83, 1.52, 1.22, 0.90, 0.59, 0.28, & - & 0.1/ - -! awsa= sulfuric acid - - DATA AWSA/34.00, 33.56, 29.22, 26.55, 24.61, 23.11, 21.89, 20.87, & - & 19.99, 18.45, & - & 17.83, 17.26, 16.73, 16.25, 15.80, 15.38, 14.98, 14.61, 14.26, & - & 13.93, & - & 13.61, 13.30, 13.01, 12.73, 12.47, 12.21, 11.96, 11.72, 11.49, & - & 11.26, & - & 11.04, 10.83, 10.62, 10.42, 10.23, 10.03, 9.85, 9.67, 9.49, & - & 9.31, & - & 9.14, 8.97, 8.81, 8.65, 8.49, 8.33, 8.18, 8.02, 7.87, & - & 7.73, & - & 7.58, 7.44, 7.29, 7.15, 7.01, 6.88, 6.74, 6.61, 6.47, & - & 6.34, & - & 6.21, 6.07, 5.94, 5.81, 5.68, 5.55, 5.43, 5.30, 5.17, & - & 5.04, & - & 4.91, 4.78, 4.65, 4.52, 4.39, 4.26, 4.13, 4.00, 3.86, & - & 3.73, & - & 3.59, 3.45, 3.31, 3.17, 3.02, 2.87, 2.71, 2.56, 2.39, & - & 2.22, & - & 2.05, 1.87, 1.68, 1.48, 1.27, 1.04, 0.80, 0.55, 0.28, & - & 0.1/ - -! awlc= (NH4)3H(SO4)2 - - DATA AWLC/10*125.37, & - & 110.10, 97.50, 86.98, 78.08, 70.49, 63.97, 58.33, 53.43, 49.14, & - & 45.36, & - & 42.03, 39.07, 36.44, 34.08, 31.97, 30.06, 28.33, 26.76, 25.32, & - & 24.01, & - & 22.81, 21.70, 20.67, 19.71, 18.83, 18.00, 17.23, 16.50, 15.82, & - & 15.18, & - & 14.58, 14.01, 13.46, 12.95, 12.46, 11.99, 11.55, 11.13, 10.72, & - & 10.33, & - & 9.96, 9.60, 9.26, 8.93, 8.61, 8.30, 8.00, 7.72, 7.44, & - & 7.17, & - & 6.91, 6.66, 6.42, 6.19, 5.96, 5.74, 5.52, 5.31, 5.11, & - & 4.91, & - & 4.71, 4.53, 4.34, 4.16, 3.99, 3.81, 3.64, 3.48, 3.31, & - & 3.15, & - & 2.99, 2.84, 2.68, 2.53, 2.37, 2.22, 2.06, 1.91, 1.75, & - & 1.60, & - & 1.44, 1.28, 1.12, 0.95, 0.79, 0.62, 0.45, 0.29, 0.14, & - & 0.1/ - -! awan= ammonium nitrate - - DATA AWAN/10*960.19, & - & 853.15,763.85,688.20,623.27,566.92,517.54,473.91,435.06,400.26, & - & 368.89, & - & 340.48,314.63,291.01,269.36,249.46,231.11,214.17,198.50,184.00, & - & 170.58, & - & 158.15,146.66,136.04,126.25,117.24,108.97,101.39, 94.45, 88.11, & - & 82.33, & - & 77.06, 72.25, 67.85, 63.84, 60.16, 56.78, 53.68, 50.81, 48.17, & - & 45.71, & - & 43.43, 41.31, 39.32, 37.46, 35.71, 34.06, 32.50, 31.03, 29.63, & - & 28.30, & - & 27.03, 25.82, 24.67, 23.56, 22.49, 21.47, 20.48, 19.53, 18.61, & - & 17.72, & - & 16.86, 16.02, 15.20, 14.41, 13.64, 12.89, 12.15, 11.43, 10.73, & - & 10.05, & - & 9.38, 8.73, 8.09, 7.47, 6.86, 6.27, 5.70, 5.15, 4.61, & - & 4.09, & - & 3.60, 3.12, 2.66, 2.23, 1.81, 1.41, 1.03, 0.67, 0.32, & - & 0.1/ - -! awsb= sodium bisulfate - - DATA AWSB/10*55.99, & - & 53.79, 51.81, 49.99, 48.31, 46.75, 45.28, 43.91, 42.62, 41.39, & - & 40.22, & - & 39.10, 38.02, 36.99, 36.00, 35.04, 34.11, 33.21, 32.34, 31.49, & - & 30.65, & - & 29.84, 29.04, 28.27, 27.50, 26.75, 26.01, 25.29, 24.57, 23.87, & - & 23.17, & - & 22.49, 21.81, 21.15, 20.49, 19.84, 19.21, 18.58, 17.97, 17.37, & - & 16.77, & - & 16.19, 15.63, 15.08, 14.54, 14.01, 13.51, 13.01, 12.53, 12.07, & - & 11.62, & - & 11.19, 10.77, 10.36, 9.97, 9.59, 9.23, 8.87, 8.53, 8.20, & - & 7.88, & - & 7.57, 7.27, 6.97, 6.69, 6.41, 6.14, 5.88, 5.62, 5.36, & - & 5.11, & - & 4.87, 4.63, 4.39, 4.15, 3.92, 3.68, 3.45, 3.21, 2.98, & - & 2.74, & - & 2.49, 2.24, 1.98, 1.72, 1.44, 1.16, 0.87, 0.57, 0.28, & - & 0.1/ - -! awpc= potassium chloride - - DATA AWPC/172.62, 165.75, 159.10, 152.67, 146.46, 140.45, 134.64, & - & 129.03, 123.61, 118.38, 113.34, 108.48, 103.79, 99.27, & - & 94.93, 90.74, 86.71, 82.84, 79.11, 75.53, 72.09, 68.79, & - & 65.63, 62.59, 59.68, 56.90, 54.23, 51.68, 49.24, 46.91, & - & 44.68, 42.56, 40.53, 38.60, 36.76, 35.00, 33.33, 31.75, & - & 30.24, 28.81, 27.45, 26.16, 24.94, 23.78, 22.68, 21.64, & - & 20.66, 19.74, 18.86, 18.03, 17.25, 16.51, 15.82, 15.16, & - & 14.54, 13.96, 13.41, 12.89, 12.40, 11.94, 11.50, 11.08, & - & 10.69, 10.32, 9.96, 9.62, 9.30, 8.99, 8.69, 8.40, 8.12, & - & 7.85, 7.59, 7.33, 7.08, 6.83, 6.58, 6.33, 6.08, 5.84, & - & 5.59, 5.34, 5.09, 4.83, 4.57, 4.31, 4.04, 3.76, 3.48, & - & 3.19, 2.90, 2.60, 2.29, 1.98, 1.66, 1.33, 0.99, 0.65, & - & 0.30, 0.1/ - -! awps= potassium sulfate - - DATA AWPS/1014.82, 969.72, 926.16, 884.11, 843.54, 804.41, 766.68, & - & 730.32, 695.30, 661.58, 629.14, 597.93, 567.92, 539.09, & - & 511.41, 484.83, 459.34, 434.89, 411.47, 389.04, 367.58, & - & 347.05, 327.43, 308.69, 290.80, 273.73, 257.47, 241.98, & - & 227.24, 213.22, 199.90, 187.26, 175.27, 163.91, 153.15, & - & 142.97, 133.36, 124.28, 115.73, 107.66, 100.08, 92.95, & - & 86.26, 79.99, 74.12, 68.63, 63.50, 58.73, 54.27, 50.14, & - & 46.30, 42.74, 39.44, 36.40, 33.59, 31.00, 28.63, 26.45, & - & 24.45, 22.62, 20.95, 19.43, 18.05, 16.79, 15.64, 14.61, & - & 13.66, 12.81, 12.03, 11.33, 10.68, 10.09, 9.55, 9.06, & - & 8.60, 8.17, 7.76, 7.38, 7.02, 6.66, 6.32, 5.98, 5.65, & - & 5.31, 4.98, 4.64, 4.31, 3.96, 3.62, 3.27, 2.92, 2.57, & - & 2.22, 1.87, 1.53, 1.20, 0.87, 0.57, 0.28, 0.1/ - -! awpn= potassium nitrate - - DATA AWPN/44*1000.00, 953.05, 881.09, 813.39, & - & 749.78, 690.09, 634.14, 581.77, 532.83, 487.16, 444.61, & - & 405.02, 368.26, 334.18, 302.64, 273.51, 246.67, 221.97, & - & 199.31, 178.56, 159.60, 142.33, 126.63, 112.40, 99.54, & - & 87.96, 77.55, 68.24, 59.92, 52.53, 45.98, 40.2, 35.11, & - & 30.65, 26.75, 23.35, 20.40, 17.85, 15.63, 13.72, 12.06, & - & 10.61, 9.35, 8.24, 7.25, 6.37, 5.56, 4.82, 4.12, 3.47, & - & 2.86, 2.28, 1.74, 1.24, 0.79, 0.40, 0.1/ - -! awpb= potassium bisulfate - - DATA AWPB/10*55.99, & - & 53.79, 51.81, 49.99, 48.31, 46.75, 45.28, 43.91, 42.62, 41.39, & - & 40.22, & - & 39.10, 38.02, 36.99, 36.00, 35.04, 34.11, 33.21, 32.34, 31.49, & - & 30.65, & - & 29.84, 29.04, 28.27, 27.50, 26.75, 26.01, 25.29, 24.57, 23.87, & - & 23.17, & - & 22.49, 21.81, 21.15, 20.49, 19.84, 19.21, 18.58, 17.97, 17.37, & - & 16.77, & - & 16.19, 15.63, 15.08, 14.54, 14.01, 13.51, 13.01, 12.53, 12.07, & - & 11.62, & - & 11.19, 10.77, 10.36, 9.97, 9.59, 9.23, 8.87, 8.53, 8.20, & - & 7.88, & - & 7.57, 7.27, 6.97, 6.69, 6.41, 6.14, 5.88, 5.62, 5.36, & - & 5.11, & - & 4.87, 4.63, 4.39, 4.15, 3.92, 3.68, 3.45, 3.21, 2.98, & - & 2.74, & - & 2.49, 2.24, 1.98, 1.72, 1.44, 1.16, 0.87, 0.57, 0.28, & - & 0.1/ - -! awcc= calcium chloride - - DATA AWCC/19.9, 19.0, 18.15, 17.35, 16.6, 15.89, 15.22, 14.58, & - & 13.99, 13.43, 12.90, 12.41, 11.94, 11.50, 11.09, 10.7, & - & 10.34, 9.99, 9.67, 9.37, 9.09, 8.83, 8.57, 8.34, 8.12, & - & 7.91, 7.71, 7.53, 7.35, 7.19, 7.03, 6.88, 6.74, 6.6, & - & 6.47, 6.35, 6.23, 6.12, 6.01, 5.90, 5.80, 5.70, 5.61, & - & 5.51, 5.42, 5.33, 5.24, 5.16, 5.07, 4.99, 4.91, 4.82, & - & 4.74, 4.66, 4.58, 4.50, 4.42, 4.34, 4.26, 4.19, 4.11, & - & 4.03, 3.95, 3.87, 3.79, 3.72, 3.64, 3.56, 3.48, 3.41, & - & 3.33, 3.25, 3.17, 3.09, 3.01, 2.93, 2.85, 2.76, 2.68, & - & 2.59, 2.50, 2.41, 2.32, 2.23, 2.13, 2.03, 1.93, 1.82, & - & 1.71, 1.59, 1.47, 1.35, 1.22, 1.07, 0.93, 0.77, 0.61, & - & 0.44, 0.25, 0.1/ - -! awcn= calcium nitrate - - DATA AWCN/32.89, 31.46, 30.12, 28.84, 27.64, 26.51, 25.44, 24.44, & - & 23.49, 22.59, 21.75, 20.96, 20.22, 19.51, 18.85, 18.23, & - & 17.64, 17.09, 16.56, 16.07, 15.61, 15.17, 14.75, 14.36, & - & 13.99, 13.63, 13.3, 12.98, 12.68, 12.39, 12.11, 11.84, & - & 11.59, 11.35, 11.11, 10.88, 10.66, 10.45, 10.24, 10.04, & - & 9.84, 9.65, 9.46, 9.28, 9.1, 8.92, 8.74, 8.57, 8.4, & - & 8.23, 8.06, 7.9, 7.73, 7.57, 7.41, 7.25, 7.1,6.94, 6.79, & - & 6.63, 6.48, 6.33, 6.18, 6.03, 5.89, 5.74, 5.60, 5.46, & - & 5.32, 5.17, 5.04, 4.9, 4.76, 4.62, 4.49, 4.35, 4.22, & - & 4.08, 3.94, 3.80, 3.66, 3.52, 3.38, 3.23, 3.08, 2.93, & - & 2.77, 2.60, 2.43, 2.25, 2.07, 1.87, 1.67, 1.45, 1.22, & - & 0.97, 0.72, 0.44, 0.14, 0.1/ - -! awmc= magnesium chloride - - DATA AWMC/11.24, 10.99, 10.74, 10.5, 10.26, 10.03, 9.81, 9.59, & - & 9.38, 9.18, 8.98, 8.79, 8.60, 8.42, 8.25, 8.07, 7.91, & - & 7.75, 7.59, 7.44, 7.29, 7.15, 7.01, 6.88, 6.75, 6.62, & - & 6.5, 6.38, 6.27, 6.16, 6.05, 5.94, 5.85, 5.75, 5.65, & - & 5.56, 5.47, 5.38, 5.30, 5.22, 5.14, 5.06, 4.98, 4.91, & - & 4.84, 4.77, 4.7, 4.63, 4.57, 4.5, 4.44, 4.37, 4.31, & - & 4.25, 4.19, 4.13, 4.07, 4.01, 3.95, 3.89, 3.83, 3.77, & - & 3.71, 3.65, 3.58, 3.52, 3.46, 3.39, 3.33, 3.26, 3.19, & - & 3.12, 3.05, 2.98, 2.9, 2.82, 2.75, 2.67, 2.58, 2.49, & - & 2.41, 2.32, 2.22, 2.13, 2.03, 1.92, 1.82, 1.71, 1.60, & - & 1.48, 1.36, 1.24, 1.11, 0.98, 0.84, 0.70, 0.56, 0.41, & - & 0.25, 0.1/ - -! awmn= magnesium nitrate - - DATA AWMN/12.00, 11.84, 11.68, 11.52, 11.36, 11.2, 11.04, 10.88, & - & 10.72, 10.56, 10.40, 10.25, 10.09, 9.93, 9.78, 9.63, & - & 9.47, 9.32, 9.17, 9.02, 8.87, 8.72, 8.58, 8.43, 8.29, & - & 8.15, 8.01, 7.87, 7.73, 7.59, 7.46, 7.33, 7.2, 7.07, & - & 6.94, 6.82, 6.69, 6.57, 6.45, 6.33, 6.21, 6.01, 5.98, & - & 5.87, 5.76, 5.65, 5.55, 5.44, 5.34, 5.24, 5.14, 5.04, & - & 4.94, 4.84, 4.75, 4.66, 4.56, 4.47, 4.38, 4.29, 4.21, & - & 4.12, 4.03, 3.95, 3.86, 3.78, 3.69, 3.61, 3.53, 3.45, & - & 3.36, 3.28, 3.19, 3.11, 3.03, 2.94, 2.85, 2.76, 2.67, & - & 2.58, 2.49, 2.39, 2.3, 2.2, 2.1, 1.99, 1.88, 1.77, 1.66, & - & 1.54, 1.42, 1.29, 1.16, 1.02, 0.88, 0.73, 0.58, 0.42, & - & 0.25, 0.1/ - -! awmn= magnesium sulfate - - DATA AWMS/0.93, 2.5, 3.94, 5.25, 6.45, 7.54, 8.52, 9.40, 10.19, & - & 10.89, 11.50, 12.04, 12.51, 12.90, 13.23, 13.50, 13.72, & - & 13.88, 13.99, 14.07, 14.1, 14.09, 14.05, 13.98, 13.88, & - & 13.75, 13.6, 13.43, 13.25, 13.05, 12.83, 12.61, 12.37, & - & 12.13, 11.88, 11.63, 11.37, 11.12, 10.86, 10.60, 10.35, & - & 10.09, 9.85, 9.6, 9.36, 9.13, 8.9, 8.68, 8.47, 8.26, & - & 8.07, 7.87, 7.69, 7.52, 7.35, 7.19, 7.03, 6.89, 6.75, & - & 6.62, 6.49, 6.37, 6.26, 6.15, 6.04, 5.94, 5.84, 5.75, & - & 5.65, 5.56, 5.47, 5.38, 5.29, 5.20, 5.11, 5.01, 4.92, & - & 4.82, 4.71, 4.60, 4.49, 4.36, 4.24, 4.10, 3.96, 3.81, & - & 3.65, 3.48, 3.30, 3.11, 2.92, 2.71, 2.49, 2.26, 2.02, & - & 1.76, 1.50, 1.22, 0.94, 0.64/ - -! *** ZSR RELATIONSHIP PARAMETERS ************************************** - -! awas= ammonium sulfate - -! DATA AWAS/33*100.,30,30,30,29.54,28.25,27.06,25.94, -! & 24.89,23.90,22.97,22.10,21.27,20.48,19.73,19.02,18.34,17.69, -! & 17.07,16.48,15.91,15.37,14.85,14.34,13.86,13.39,12.94,12.50, -! & 12.08,11.67,11.27,10.88,10.51,10.14, 9.79, 9.44, 9.10, 8.78, -! & 8.45, 8.14, 7.83, 7.53, 7.23, 6.94, 6.65, 6.36, 6.08, 5.81, -! & 5.53, 5.26, 4.99, 4.72, 4.46, 4.19, 3.92, 3.65, 3.38, 3.11, -! & 2.83, 2.54, 2.25, 1.95, 1.63, 1.31, 0.97, 0.63, 0.30, 0.001/ - -! awsn= sodium nitrate - -! DATA AWSN/ 9*1.e5,685.59, -! & 451.00,336.46,268.48,223.41,191.28, -! & 167.20,148.46,133.44,121.12,110.83, -! & 102.09,94.57,88.03,82.29,77.20,72.65,68.56,64.87,61.51,58.44, -! & 55.62,53.03,50.63,48.40,46.32,44.39,42.57,40.87,39.27,37.76, -! & 36.33,34.98,33.70,32.48,31.32,30.21,29.16,28.14,27.18,26.25, -! & 25.35,24.50,23.67,22.87,22.11,21.36,20.65,19.95,19.28,18.62, -! & 17.99,17.37,16.77,16.18,15.61,15.05,14.51,13.98,13.45,12.94, -! & 12.44,11.94,11.46,10.98,10.51,10.04, 9.58, 9.12, 8.67, 8.22, -! & 7.77, 7.32, 6.88, 6.43, 5.98, 5.53, 5.07, 4.61, 4.15, 3.69, -! & 3.22, 2.76, 2.31, 1.87, 1.47, 1.10, 0.77, 0.48, 0.23, 0.001/ - -! awsc= sodium chloride - -! DATA AWSC/ -! & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100., -! & 100., 100., 100., 100., 100., 100., 100., 100., 100.,16.34, -! & 16.28,16.22,16.15,16.09,16.02,15.95,15.88,15.80,15.72,15.64, -! & 15.55,15.45,15.36,15.25,15.14,15.02,14.89,14.75,14.60,14.43, -! & 14.25,14.04,13.81,13.55,13.25,12.92,12.56,12.19,11.82,11.47, -! & 11.13,10.82,10.53,10.26,10.00, 9.76, 9.53, 9.30, 9.09, 8.88, -! & 8.67, 8.48, 8.28, 8.09, 7.90, 7.72, 7.54, 7.36, 7.17, 6.99, -! & 6.81, 6.63, 6.45, 6.27, 6.09, 5.91, 5.72, 5.53, 5.34, 5.14, -! & 4.94, 4.74, 4.53, 4.31, 4.09, 3.86, 3.62, 3.37, 3.12, 2.85, -! & 2.58, 2.30, 2.01, 1.72, 1.44, 1.16, 0.89, 0.64, 0.40, 0.18/ - -! awac= ammonium chloride - -! DATA AWAC/ -! & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100., -! & 100., 100., 100., 100., 100., 100., 100., 100., 100.,31.45, -! & 31.30,31.14,30.98,30.82,30.65,30.48,30.30,30.11,29.92,29.71, -! & 29.50,29.29,29.06,28.82,28.57,28.30,28.03,27.78,27.78,27.77, -! & 27.77,27.43,27.07,26.67,26.21,25.73,25.18,24.56,23.84,23.01, -! & 22.05,20.97,19.85,18.77,17.78,16.89,16.10,15.39,14.74,14.14, -! & 13.59,13.06,12.56,12.09,11.65,11.22,10.81,10.42,10.03, 9.66, -! & 9.30, 8.94, 8.59, 8.25, 7.92, 7.59, 7.27, 6.95, 6.63, 6.32, -! & 6.01, 5.70, 5.39, 5.08, 4.78, 4.47, 4.17, 3.86, 3.56, 3.25, -! & 2.94, 2.62, 2.30, 1.98, 1.65, 1.32, 0.97, 0.62, 0.26, 0.13/ - -! awss= sodium sulfate - -! DATA AWSS/34*1.e5,23*14.30,14.21,12.53,11.47, -! & 10.66,10.01, 9.46, 8.99, 8.57, 8.19, 7.85, 7.54, 7.25, 6.98, -! & 6.74, 6.50, 6.29, 6.08, 5.88, 5.70, 5.52, 5.36, 5.20, 5.04, -! & 4.90, 4.75, 4.54, 4.34, 4.14, 3.93, 3.71, 3.49, 3.26, 3.02, -! & 2.76, 2.49, 2.20, 1.89, 1.55, 1.18, 0.82, 0.49, 0.22, 0.001/ - -! awab= ammonium bisulfate - -! DATA AWAB/356.45,296.51,253.21,220.47,194.85, -! & 174.24,157.31,143.16,131.15,120.82, -! & 111.86,103.99,97.04,90.86,85.31,80.31,75.78,71.66,67.90,64.44, -! & 61.25,58.31,55.58,53.04,50.68,48.47,46.40,44.46,42.63,40.91, -! & 39.29,37.75,36.30,34.92,33.61,32.36,31.18,30.04,28.96,27.93, -! & 26.94,25.99,25.08,24.21,23.37,22.57,21.79,21.05,20.32,19.63, -! & 18.96,18.31,17.68,17.07,16.49,15.92,15.36,14.83,14.31,13.80, -! & 13.31,12.83,12.36,11.91,11.46,11.03,10.61,10.20, 9.80, 9.41, -! & 9.02, 8.64, 8.28, 7.91, 7.56, 7.21, 6.87, 6.54, 6.21, 5.88, -! & 5.56, 5.25, 4.94, 4.63, 4.33, 4.03, 3.73, 3.44, 3.14, 2.85, -! & 2.57, 2.28, 1.99, 1.71, 1.42, 1.14, 0.86, 0.57, 0.29, 0.001/ - -! awsa= sulfuric acid - -! DATA AWSA/ -! & 34.0,33.56,29.22,26.55,24.61,23.11,21.89,20.87,19.99, -! & 19.21,18.51,17.87,17.29,16.76,16.26,15.8,15.37,14.95,14.56, -! & 14.20,13.85,13.53,13.22,12.93,12.66,12.40,12.14,11.90,11.67, -! & 11.44,11.22,11.01,10.8,10.60,10.4,10.2,10.01,9.83,9.65,9.47, -! & 9.3,9.13,8.96,8.81,8.64,8.48,8.33,8.17,8.02,7.87,7.72,7.58, -! & 7.44,7.30,7.16,7.02,6.88,6.75,6.61,6.48,6.35,6.21,6.08,5.95, -! & 5.82,5.69,5.56,5.44,5.31,5.18,5.05,4.92,4.79,4.66,4.53,4.40, -! & 4.27,4.14,4.,3.87,3.73,3.6,3.46,3.31,3.17,3.02,2.87,2.72, -! & 2.56,2.4,2.23,2.05,1.87,1.68,1.48,1.27,1.05,0.807,0.552,0.281/ - -! awlc= (NH4)3H(SO4)2 - -! DATA AWLC/34*1.e5,17.0,16.5,15.94,15.31,14.71,14.14, -! & 13.60,13.08,12.59,12.12,11.68,11.25,10.84,10.44,10.07, 9.71, -! & 9.36, 9.02, 8.70, 8.39, 8.09, 7.80, 7.52, 7.25, 6.99, 6.73, -! & 6.49, 6.25, 6.02, 5.79, 5.57, 5.36, 5.15, 4.95, 4.76, 4.56, -! & 4.38, 4.20, 4.02, 3.84, 3.67, 3.51, 3.34, 3.18, 3.02, 2.87, -! & 2.72, 2.57, 2.42, 2.28, 2.13, 1.99, 1.85, 1.71, 1.57, 1.43, -! & 1.30, 1.16, 1.02, 0.89, 0.75, 0.61, 0.46, 0.32, 0.16, 0.001/ - -! awan= ammonium nitrate - -! DATA AWAN/31*1.e5, -! & 97.17,92.28,87.66,83.15,78.87,74.84,70.98,67.46,64.11, -! & 60.98,58.07,55.37,52.85,50.43,48.24,46.19,44.26,42.40,40.70, -! & 39.10,37.54,36.10,34.69,33.35,32.11,30.89,29.71,28.58,27.46, -! & 26.42,25.37,24.33,23.89,22.42,21.48,20.56,19.65,18.76,17.91, -! & 17.05,16.23,15.40,14.61,13.82,13.03,12.30,11.55,10.83,10.14, -! & 9.44, 8.79, 8.13, 7.51, 6.91, 6.32, 5.75, 5.18, 4.65, 4.14, -! & 3.65, 3.16, 2.71, 2.26, 1.83, 1.42, 1.03, 0.66, 0.30, 0.001/ - -! awsb= sodium bisulfate - -! DATA AWSB/173.72,156.88,142.80,130.85,120.57, -! & 111.64,103.80,96.88,90.71,85.18, -! & 80.20,75.69,71.58,67.82,64.37,61.19,58.26,55.53,53.00,50.64, -! & 48.44,46.37,44.44,42.61,40.90,39.27,37.74,36.29,34.91,33.61, -! & 32.36,31.18,30.05,28.97,27.94,26.95,26.00,25.10,24.23,23.39, -! & 22.59,21.81,21.07,20.35,19.65,18.98,18.34,17.71,17.11,16.52, -! & 15.95,15.40,14.87,14.35,13.85,13.36,12.88,12.42,11.97,11.53, -! & 11.10,10.69,10.28, 9.88, 9.49, 9.12, 8.75, 8.38, 8.03, 7.68, -! & 7.34, 7.01, 6.69, 6.37, 6.06, 5.75, 5.45, 5.15, 4.86, 4.58, -! & 4.30, 4.02, 3.76, 3.49, 3.23, 2.98, 2.73, 2.48, 2.24, 2.01, -! & 1.78, 1.56, 1.34, 1.13, 0.92, 0.73, 0.53, 0.35, 0.17, 0.001/ - -! *** END OF BLOCK DATA SUBPROGRAM ************************************* - - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE INIT1 -! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM -! SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP1) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE INIT1 (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - REAL :: IC,GII,GI0,XX,LN10 - PARAMETER (LN10=2.3025851) - -! *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** - - IF (IPROB == 0) THEN ! FORWARD CALCULATION - DO 10 I=1,NCOMP - W(I) = MAX(WI(I), TINY) - 10 END DO - ELSE - DO 15 I=1,NCOMP ! REVERSE CALCULATION - WAER(I) = MAX(WI(I), TINY) - W(I) = ZERO - 15 END DO - ENDIF - RH = RHI - TEMP = TEMPI - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - XK1 = 1.015e-2 ! HSO4(aq) <==> H(aq) + SO4(aq) - XK21 = 57.639 ! NH3(g) <==> NH3(aq) - XK22 = 1.805e-5 ! NH3(aq) <==> NH4(aq) + OH(aq) - XK7 = 1.817 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) - XK12 = 1.382e2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) - XK13 = 29.268 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) - XKW = 1.010e-14 ! H2O <==> H(aq) + OH(aq) - - IF (INT(TEMP) /= 298) THEN ! FOR T != 298K or 298.15K - T0 = 298.15 - T0T = T0/TEMP - COEF= 1.0+LOG(T0T)-T0T - XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) - XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) - XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) - XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) - XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) - XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) - XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) - ENDIF - XK2 = XK21*XK22 - -! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** - - DRH2SO4 = 0.0000D0 - DRNH42S4 = 0.7997D0 - DRNH4HS4 = 0.4000D0 - DRLC = 0.6900D0 - IF (INT(TEMP) /= 298) THEN - T0 = 298.15d0 - TCF = 1.0/TEMP - 1.0/T0 - DRNH42S4 = DRNH42S4*EXP( 80.*TCF) - DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) - DRLC = DRLC *EXP(186.*TCF) - ENDIF - -! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** - - DRMLCAB = 0.3780D0 ! (NH4)3H(SO4)2 & NH4HSO4 - DRMLCAS = 0.6900D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 -! C IF (INT(TEMP) .NE. 298) THEN ! For the time being. -! C T0 = 298.15d0 -! C TCF = 1.0/TEMP - 1.0/T0 -! C DRMLCAB = DRMLCAB*EXP(507.506*TCF) -! C DRMLCAS = DRMLCAS*EXP(133.865*TCF) -! C ENDIF - -! *** LIQUID PHASE ****************************************************** - - CHNO3 = ZERO - CHCL = ZERO - CH2SO4 = ZERO - COH = ZERO - WATER = TINY - - DO 20 I=1,NPAIR - MOLALR(I)=ZERO - GAMA(I) =0.1 - GAMIN(I) =GREAT - GAMOU(I) =GREAT - M0(I) =1d5 - 20 END DO - - DO 30 I=1,NPAIR - GAMA(I) = 0.1d0 - 30 END DO - - DO 40 I=1,NIONS - MOLAL(I)=ZERO - 40 END DO - COH = ZERO - - DO 50 I=1,NGASAQ - GASAQ(I)=ZERO - 50 END DO - -! *** SOLID PHASE ******************************************************* - - CNH42S4= ZERO - CNH4HS4= ZERO - CNACL = ZERO - CNA2SO4= ZERO - CNANO3 = ZERO - CNH4NO3= ZERO - CNH4CL = ZERO - CNAHSO4= ZERO - CLC = ZERO - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = ZERO - -! *** GAS PHASE ********************************************************* - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - -! *** CALCULATE ZSR PARAMETERS ****************************************** - - IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays - IRH = MAX (IRH, 1) - -! M0(01) = AWSC(IRH) ! NACl -! IF (M0(01) .LT. 100.0) THEN -! IC = M0(01) -! CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -! ENDIF -!C -! M0(02) = AWSS(IRH) ! (NA)2SO4 -! IF (M0(02) .LT. 100.0) THEN -! IC = 3.0*M0(02) -! CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -! ENDIF -!C -! M0(03) = AWSN(IRH) ! NANO3 -! IF (M0(03) .LT. 100.0) THEN -! IC = M0(03) -! CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -! ENDIF -!C - M0(04) = AWAS(IRH) ! (NH4)2SO4 -!C IF (M0(04) .LT. 100.0) THEN -!C IC = 3.0*M0(04) -! C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -!C ENDIF - -! M0(05) = AWAN(IRH) ! NH4NO3 -! IF (M0(05) .LT. 100.0) THEN -! IC = M0(05) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -! ENDIF -!C -! M0(06) = AWAC(IRH) ! NH4CL -! IF (M0(06) .LT. 100.0) THEN -! IC = M0(06) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(07) = AWSA(IRH) ! 2H-SO4 -!C IF (M0(07) .LT. 100.0) THEN -!C IC = 3.0*M0(07) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(08) = AWSA(IRH) ! H-HSO4 -! C IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used -! C IC = M0(08) -! C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! CCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) -! C M0(08) = M0(08)*EXP(LN10*(GI0-GII)) -! C ENDIF - - M0(09) = AWAB(IRH) ! NH4HSO4 -!C IF (M0(09) .LT. 100.0) THEN -!C IC = M0(09) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -!C ENDIF - -! M0(12) = AWSB(IRH) ! NAHSO4 -! IF (M0(12) .LT. 100.0) THEN -! IC = M0(12) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -!C IF (M0(13) .LT. 100.0) THEN -!C IC = 4.0*M0(13) -!C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C G130 = 0.2*(3.0*GI0+2.0*GII) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C G13I = 0.2*(3.0*GI0+2.0*GII) -!C M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -!C ENDIF - -! *** OTHER INITIALIZATIONS ********************************************* - - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SODRAT = ZERO - CRNARAT = ZERO - CRRAT = ZERO - NOFER = 0 - STKOFL = .FALSE. - DO 60 I=1,NERRMX - ERRSTK(I) =-999 - ERRMSG(I) = 'MESSAGE N/A' - 60 END DO - -! *** END OF SUBROUTINE INIT1 ******************************************* - - END SUBROUTINE INIT1 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE INIT2 -! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, -! NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP2) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE INIT2 (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - REAL :: IC,GII,GI0,XX,LN10 - PARAMETER (LN10=2.3025851) - -! *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** - - IF (IPROB == 0) THEN ! FORWARD CALCULATION - DO 10 I=1,NCOMP - W(I) = MAX(WI(I), TINY) - 10 END DO - ELSE - DO 15 I=1,NCOMP ! REVERSE CALCULATION - WAER(I) = MAX(WI(I), TINY) - W(I) = ZERO - 15 END DO - ENDIF - RH = RHI - TEMP = TEMPI - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - XK1 = 1.015e-2 ! HSO4(aq) <==> H(aq) + SO4(aq) - XK21 = 57.639 ! NH3(g) <==> NH3(aq) - XK22 = 1.805e-5 ! NH3(aq) <==> NH4(aq) + OH(aq) - XK4 = 2.511e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! ISORR -! C XK4 = 3.638e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! SEQUIL - XK41 = 2.100e5 ! HNO3(g) <==> HNO3(aq) - XK7 = 1.817 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) - XK10 = 5.746e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR -! C XK10 = 2.985e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! SEQUIL - XK12 = 1.382e2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) - XK13 = 29.268 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) - XKW = 1.010e-14 ! H2O <==> H(aq) + OH(aq) - - IF (INT(TEMP) /= 298) THEN ! FOR T != 298K or 298.15K - T0 = 298.15D0 - T0T = T0/TEMP - COEF= 1.0+LOG(T0T)-T0T - XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) - XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) - XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) - XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR - ! C XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL - XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF) - XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) - XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR - ! C XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL - XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) - XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) - XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) - ENDIF - XK2 = XK21*XK22 - XK42 = XK4/XK41 - -! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** - - DRH2SO4 = ZERO - DRNH42S4 = 0.7997D0 - DRNH4HS4 = 0.4000D0 - DRNH4NO3 = 0.6183D0 - DRLC = 0.6900D0 - IF (INT(TEMP) /= 298) THEN - T0 = 298.15D0 - TCF = 1.0/TEMP - 1.0/T0 - DRNH4NO3 = DRNH4NO3*EXP(852.*TCF) - DRNH42S4 = DRNH42S4*EXP( 80.*TCF) - DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) - DRLC = DRLC *EXP(186.*TCF) - DRNH4NO3 = MIN (DRNH4NO3,DRNH42S4) ! ADJUST FOR DRH CROSSOVER AT T<271K - ENDIF - -! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** - - DRMLCAB = 0.3780D0 ! (NH4)3H(SO4)2 & NH4HSO4 - DRMLCAS = 0.6900D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 - DRMASAN = 0.6000D0 ! (NH4)2SO4 & NH4NO3 -! C IF (INT(TEMP) .NE. 298) THEN ! For the time being -! C T0 = 298.15d0 -! C TCF = 1.0/TEMP - 1.0/T0 -! C DRMLCAB = DRMLCAB*EXP( 507.506*TCF) -! C DRMLCAS = DRMLCAS*EXP( 133.865*TCF) -! C DRMASAN = DRMASAN*EXP(1269.068*TCF) -! C ENDIF - -! *** LIQUID PHASE ****************************************************** - - CHNO3 = ZERO - CHCL = ZERO - CH2SO4 = ZERO - COH = ZERO - WATER = TINY - - DO 20 I=1,NPAIR - MOLALR(I)=ZERO - GAMA(I) =0.1 - GAMIN(I) =GREAT - GAMOU(I) =GREAT - M0(I) =1d5 - 20 END DO - - DO 30 I=1,NPAIR - GAMA(I) = 0.1d0 - 30 END DO - - DO 40 I=1,NIONS - MOLAL(I)=ZERO - 40 END DO - COH = ZERO - - DO 50 I=1,NGASAQ - GASAQ(I)=ZERO - 50 END DO - -! *** SOLID PHASE ****************************************************** - - CNH42S4= ZERO - CNH4HS4= ZERO - CNACL = ZERO - CNA2SO4= ZERO - CNANO3 = ZERO - CNH4NO3= ZERO - CNH4CL = ZERO - CNAHSO4= ZERO - CLC = ZERO - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = ZERO - -! *** GAS PHASE ******************************************************** - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - -! *** CALCULATE ZSR PARAMETERS ***************************************** - - IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays - IRH = MAX (IRH, 1) - -! M0(01) = AWSC(IRH) ! NACl -! IF (M0(01) .LT. 100.0) THEN -! IC = M0(01) -! CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -! ENDIF -!C -! M0(02) = AWSS(IRH) ! (NA)2SO4 -! IF (M0(02) .LT. 100.0) THEN -! IC = 3.0*M0(02) -! CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -! ENDIF -! C -! M0(03) = AWSN(IRH) ! NANO3 -! IF (M0(03) .LT. 100.0) THEN -! IC = M0(03) -! CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(04) = AWAS(IRH) ! (NH4)2SO4 -!C IF (M0(04) .LT. 100.0) THEN -!C IC = 3.0*M0(04) -!C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(05) = AWAN(IRH) ! NH4NO3 -!C IF (M0(05) .LT. 100.0) THEN -!C IC = M0(05) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -!C ENDIF - -! M0(06) = AWAC(IRH) ! NH4CL -! IF (M0(06) .LT. 100.0) THEN -! IC = M0(06) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -! ENDIF -!C - M0(07) = AWSA(IRH) ! 2H-SO4 -!C IF (M0(07) .LT. 100.0) THEN -!C IC = 3.0*M0(07) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(08) = AWSA(IRH) ! H-HSO4 -! C IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used -! C IC = M0(08) -! C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! CCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) -! C M0(08) = M0(08)*EXP(LN10*(GI0-GII)) -! C ENDIF - - M0(09) = AWAB(IRH) ! NH4HSO4 -!C IF (M0(09) .LT. 100.0) THEN -!C IC = M0(09) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -!C ENDIF - -! M0(12) = AWSB(IRH) ! NAHSO4 -! IF (M0(12) .LT. 100.0) THEN -! IC = M0(12) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -! IF (M0(13) .LT. 100.0) THEN -! IC = 4.0*M0(13) -! CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! G130 = 0.2*(3.0*GI0+2.0*GII) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! G13I = 0.2*(3.0*GI0+2.0*GII) -! M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -! ENDIF - -! *** OTHER INITIALIZATIONS ********************************************* - - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SODRAT = ZERO - CRNARAT = ZERO - CRRAT = ZERO - NOFER = 0 - STKOFL = .FALSE. - DO 60 I=1,NERRMX - ERRSTK(I) =-999 - ERRMSG(I) = 'MESSAGE N/A' - 60 END DO - -! *** END OF SUBROUTINE INIT2 ******************************************* - - END SUBROUTINE INIT2 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISOINIT3 -! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, -! SODIUM, CHLORIDE, NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE -! ISRP3) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISOINIT3 (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - REAL :: IC,GII,GI0,XX,LN10 - PARAMETER (LN10=2.3025851) - -! *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** - - IF (IPROB == 0) THEN ! FORWARD CALCULATION - DO 10 I=1,NCOMP - W(I) = MAX(WI(I), TINY) - 10 END DO - ELSE - DO 15 I=1,NCOMP ! REVERSE CALCULATION - WAER(I) = MAX(WI(I), TINY) - W(I) = ZERO - 15 END DO - ENDIF - RH = RHI - TEMP = TEMPI - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - XK1 = 1.015D-2 ! HSO4(aq) <==> H(aq) + SO4(aq) - XK21 = 57.639D0 ! NH3(g) <==> NH3(aq) - XK22 = 1.805D-5 ! NH3(aq) <==> NH4(aq) + OH(aq) - XK3 = 1.971D6 ! HCL(g) <==> H(aq) + CL(aq) - XK31 = 2.500e3 ! HCL(g) <==> HCL(aq) - XK4 = 2.511e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! ISORR -! C XK4 = 3.638e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! SEQUIL - XK41 = 2.100e5 ! HNO3(g) <==> HNO3(aq) - XK5 = 0.4799D0 ! NA2SO4(s) <==> 2*NA(aq) + SO4(aq) - XK6 = 1.086D-16 ! NH4CL(s) <==> NH3(g) + HCL(g) - XK7 = 1.817D0 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) - XK8 = 37.661D0 ! NACL(s) <==> NA(aq) + CL(aq) - XK10 = 5.746D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR -! C XK10 = 2.985e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! SEQUIL - XK11 = 2.413D4 ! NAHSO4(s) <==> NA(aq) + HSO4(aq) - XK12 = 1.382D2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) - XK13 = 29.268D0 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) - XK14 = 22.05D0 ! NH4CL(s) <==> NH4(aq) + CL(aq) - XKW = 1.010D-14 ! H2O <==> H(aq) + OH(aq) - XK9 = 11.977D0 ! NANO3(s) <==> NA(aq) + NO3(aq) - - IF (INT(TEMP) /= 298) THEN ! FOR T != 298K or 298.15K - T0 = 298.15D0 - T0T = T0/TEMP - COEF= 1.0+LOG(T0T)-T0T - XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) - XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) - XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) - XK3 = XK3 *EXP( 30.20*(T0T-1.0) + 19.910*COEF) - XK31= XK31*EXP( 30.20*(T0T-1.0) + 19.910*COEF) - XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR - ! C XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL - XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF) - XK5 = XK5 *EXP( 0.98*(T0T-1.0) + 39.500*COEF) - XK6 = XK6 *EXP(-71.00*(T0T-1.0) + 2.400*COEF) - XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) - XK8 = XK8 *EXP( -1.56*(T0T-1.0) + 16.900*COEF) - XK9 = XK9 *EXP( -8.22*(T0T-1.0) + 16.010*COEF) - XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR - ! C XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL - XK11= XK11*EXP( 0.79*(T0T-1.0) + 14.746*COEF) - XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) - XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) - XK14= XK14*EXP( 24.55*(T0T-1.0) + 16.900*COEF) - XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) - ENDIF - XK2 = XK21*XK22 - XK42 = XK4/XK41 - XK32 = XK3/XK31 - -! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** - - DRH2SO4 = ZERO - DRNH42S4 = 0.7997D0 - DRNH4HS4 = 0.4000D0 - DRLC = 0.6900D0 - DRNACL = 0.7528D0 - DRNANO3 = 0.7379D0 - DRNH4CL = 0.7710D0 - DRNH4NO3 = 0.6183D0 - DRNA2SO4 = 0.9300D0 - DRNAHSO4 = 0.5200D0 - IF (INT(TEMP) /= 298) THEN - T0 = 298.15D0 - TCF = 1.0/TEMP - 1.0/T0 - DRNACL = DRNACL *EXP( 25.*TCF) - DRNANO3 = DRNANO3 *EXP(304.*TCF) - DRNA2SO4 = DRNA2SO4*EXP( 80.*TCF) - DRNH4NO3 = DRNH4NO3*EXP(852.*TCF) - DRNH42S4 = DRNH42S4*EXP( 80.*TCF) - DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) - DRLC = DRLC *EXP(186.*TCF) - DRNH4CL = DRNH4Cl *EXP(239.*TCF) - DRNAHSO4 = DRNAHSO4*EXP(-45.*TCF) - - ! *** ADJUST FOR DRH "CROSSOVER" AT LOW TEMPERATURES - - DRNH4NO3 = MIN (DRNH4NO3, DRNH4CL, DRNH42S4, DRNANO3, DRNACL) - DRNANO3 = MIN (DRNANO3, DRNACL) - DRNH4CL = MIN (DRNH4Cl, DRNH42S4) - - ENDIF - -! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** - - DRMLCAB = 0.378D0 ! (NH4)3H(SO4)2 & NH4HSO4 - DRMLCAS = 0.690D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 - DRMASAN = 0.600D0 ! (NH4)2SO4 & NH4NO3 - DRMG1 = 0.460D0 ! (NH4)2SO4, NH4NO3, NA2SO4, NH4CL - DRMG2 = 0.691D0 ! (NH4)2SO4, NA2SO4, NH4CL - DRMG3 = 0.697D0 ! (NH4)2SO4, NA2SO4 - DRMH1 = 0.240D0 ! NA2SO4, NANO3, NACL, NH4NO3, NH4CL - DRMH2 = 0.596D0 ! NA2SO4, NANO3, NACL, NH4CL - DRMI1 = 0.240D0 ! LC, NAHSO4, NH4HSO4, NA2SO4, (NH4)2SO4 - DRMI2 = 0.363D0 ! LC, NAHSO4, NA2SO4, (NH4)2SO4 - NO DATA - - DRMI3 = 0.610D0 ! LC, NA2SO4, (NH4)2SO4 - DRMQ1 = 0.494D0 ! (NH4)2SO4, NH4NO3, NA2SO4 - DRMR1 = 0.663D0 ! NA2SO4, NANO3, NACL - DRMR2 = 0.735D0 ! NA2SO4, NACL - DRMR3 = 0.673D0 ! NANO3, NACL - DRMR4 = 0.694D0 ! NA2SO4, NACL, NH4CL - DRMR5 = 0.731D0 ! NA2SO4, NH4CL - DRMR6 = 0.596D0 ! NA2SO4, NANO3, NH4CL - DRMR7 = 0.380D0 ! NA2SO4, NANO3, NACL, NH4NO3 - DRMR8 = 0.380D0 ! NA2SO4, NACL, NH4NO3 - DRMR9 = 0.494D0 ! NA2SO4, NH4NO3 - DRMR10 = 0.476D0 ! NA2SO4, NANO3, NH4NO3 - DRMR11 = 0.340D0 ! NA2SO4, NACL, NH4NO3, NH4CL - DRMR12 = 0.460D0 ! NA2SO4, NH4NO3, NH4CL - DRMR13 = 0.438D0 ! NA2SO4, NANO3, NH4NO3, NH4CL -! C IF (INT(TEMP) .NE. 298) THEN -! C T0 = 298.15d0 -! C TCF = 1.0/TEMP - 1.0/T0 -! C DRMLCAB = DRMLCAB*EXP( 507.506*TCF) -! C DRMLCAS = DRMLCAS*EXP( 133.865*TCF) -! C DRMASAN = DRMASAN*EXP(1269.068*TCF) -! C DRMG1 = DRMG1 *EXP( 572.207*TCF) -! C DRMG2 = DRMG2 *EXP( 58.166*TCF) -! C DRMG3 = DRMG3 *EXP( 22.253*TCF) -! C DRMH1 = DRMH1 *EXP(2116.542*TCF) -! C DRMH2 = DRMH2 *EXP( 650.549*TCF) -! C DRMI1 = DRMI1 *EXP( 565.743*TCF) -! C DRMI2 = DRMI2 *EXP( 91.745*TCF) -! C DRMI3 = DRMI3 *EXP( 161.272*TCF) -! C DRMQ1 = DRMQ1 *EXP(1616.621*TCF) -! C DRMR1 = DRMR1 *EXP( 292.564*TCF) -! C DRMR2 = DRMR2 *EXP( 14.587*TCF) -! C DRMR3 = DRMR3 *EXP( 307.907*TCF) -! C DRMR4 = DRMR4 *EXP( 97.605*TCF) -! C DRMR5 = DRMR5 *EXP( 98.523*TCF) -! C DRMR6 = DRMR6 *EXP( 465.500*TCF) -! C DRMR7 = DRMR7 *EXP( 324.425*TCF) -! C DRMR8 = DRMR8 *EXP(2660.184*TCF) -! C DRMR9 = DRMR9 *EXP(1617.178*TCF) -! C DRMR10 = DRMR10 *EXP(1745.226*TCF) -! C DRMR11 = DRMR11 *EXP(3691.328*TCF) -! C DRMR12 = DRMR12 *EXP(1836.842*TCF) -! C DRMR13 = DRMR13 *EXP(1967.938*TCF) -! C ENDIF - -! *** LIQUID PHASE ****************************************************** - - CHNO3 = ZERO - CHCL = ZERO - CH2SO4 = ZERO - COH = ZERO - WATER = TINY - - DO 20 I=1,NPAIR - MOLALR(I)=ZERO - GAMA(I) =0.1 - GAMIN(I) =GREAT - GAMOU(I) =GREAT - M0(I) =1d5 - 20 END DO - - DO 30 I=1,NPAIR - GAMA(I) = 0.1d0 - 30 END DO - - DO 40 I=1,NIONS - MOLAL(I)=ZERO - 40 END DO - COH = ZERO - - DO 50 I=1,NGASAQ - GASAQ(I)=ZERO - 50 END DO - -! *** SOLID PHASE ******************************************************* - - CNH42S4= ZERO - CNH4HS4= ZERO - CNACL = ZERO - CNA2SO4= ZERO - CNANO3 = ZERO - CNH4NO3= ZERO - CNH4CL = ZERO - CNAHSO4= ZERO - CLC = ZERO - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = ZERO - -! *** GAS PHASE ********************************************************* - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - -! *** CALCULATE ZSR PARAMETERS ****************************************** - - IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays - IRH = MAX (IRH, 1) - - M0(01) = AWSC(IRH) ! NACl -!C IF (M0(01) .LT. 100.0) THEN -!C IC = M0(01) -!C CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(02) = AWSS(IRH) ! (NA)2SO4 -!C IF (M0(02) .LT. 100.0) THEN -!C IC = 3.0*M0(02) -!C CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(03) = AWSN(IRH) ! NANO3 -!C IF (M0(03) .LT. 100.0) THEN -!C IC = M0(03) -!C CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! C M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(04) = AWAS(IRH) ! (NH4)2SO4 -!C IF (M0(04) .LT. 100.0) THEN -!C IC = 3.0*M0(04) -!C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(05) = AWAN(IRH) ! NH4NO3 -!C IF (M0(05) .LT. 100.0) THEN -!C IC = M0(05) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(06) = AWAC(IRH) ! NH4CL -!C IF (M0(06) .LT. 100.0) THEN -!C IC = M0(06) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(07) = AWSA(IRH) ! 2H-SO4 -!C IF (M0(07) .LT. 100.0) THEN -!C IC = 3.0*M0(07) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(08) = AWSA(IRH) ! H-HSO4 -! C IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used -! C IC = M0(08) -! C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! CCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) -! C M0(08) = M0(08)*EXP(LN10*(GI0-GII)) -! C ENDIF - - M0(09) = AWAB(IRH) ! NH4HSO4 -!C IF (M0(09) .LT. 100.0) THEN -!C IC = M0(09) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(12) = AWSB(IRH) ! NAHSO4 -!C IF (M0(12) .LT. 100.0) THEN -!C IC = M0(12) -!C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -!C ENDIF - - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -!C IF (M0(13) .LT. 100.0) THEN -!C IC = 4.0*M0(13) -!C CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C G130 = 0.2*(3.0*GI0+2.0*GII) -!C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -!C & XX,XX,XX,XX,XX,XX,XX,XX,XX) -!C G13I = 0.2*(3.0*GI0+2.0*GII) -!C M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -!C ENDIF - -! *** OTHER INITIALIZATIONS ********************************************* - - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - CRNARAT = ZERO - CRRAT = ZERO - NOFER = 0 - STKOFL = .FALSE. - DO 60 I=1,NERRMX - ERRSTK(I) =-999 - ERRMSG(I) = 'MESSAGE N/A' - 60 END DO - -! *** END OF SUBROUTINE ISOINIT3 ******************************************* - - END SUBROUTINE ISOINIT3 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE INIT4 -! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, -! SODIUM, CHLORIDE, NITRATE, SULFATE, CALCIUM, POTASSIUM, MAGNESIUM -! AEROSOL SYSTEMS (SUBROUTINE ISRP4) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE INIT4 (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - REAL :: IC,GII,GI0,XX,LN10 - PARAMETER (LN10=2.3025851) - -! *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** - - IF (IPROB == 0) THEN ! FORWARD CALCULATION - DO 10 I=1,NCOMP - W(I) = MAX(WI(I), TINY) - 10 END DO - ELSE - DO 15 I=1,NCOMP ! REVERSE CALCULATION - WAER(I) = MAX(WI(I), TINY) - W(I) = ZERO - 15 END DO - ENDIF - RH = RHI - TEMP = TEMPI - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - XK1 = 1.015D-2 ! HSO4(aq) <==> H(aq) + SO4(aq) - XK21 = 57.639D0 ! NH3(g) <==> NH3(aq) - XK22 = 1.805D-5 ! NH3(aq) <==> NH4(aq) + OH(aq) - XK3 = 1.971D6 ! HCL(g) <==> H(aq) + CL(aq) - XK31 = 2.500e3 ! HCL(g) <==> HCL(aq) - XK4 = 2.511e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! ISORR -! XK4 = 3.638e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! SEQUIL - XK41 = 2.100e5 ! HNO3(g) <==> HNO3(aq) - XK5 = 0.4799D0 ! NA2SO4(s) <==> 2*NA(aq) + SO4(aq) - XK6 = 1.086D-16 ! NH4CL(s) <==> NH3(g) + HCL(g) - XK7 = 1.817D0 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) - XK8 = 37.661D0 ! NACL(s) <==> NA(aq) + CL(aq) -! XK10 = 5.746D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR - XK10 = 4.199D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! (Mozurkewich, 1993) -! XK10 = 2.985e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! SEQUIL - XK11 = 2.413D4 ! NAHSO4(s) <==> NA(aq) + HSO4(aq) - XK12 = 1.382D2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) - XK13 = 29.268D0 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) - XK14 = 22.05D0 ! NH4CL(s) <==> NH4(aq) + CL(aq) - XKW = 1.010D-14 ! H2O <==> H(aq) + OH(aq) - XK9 = 11.977D0 ! NANO3(s) <==> NA(aq) + NO3(aq) -! C - XK15 = 6.067D5 ! CA(NO3)2(s) <==> CA(aq) + 2NO3(aq) - XK16 = 7.974D11 ! CACL2(s) <==> CA(aq) + 2CL(aq) - XK17 = 1.569D-2 ! K2SO4(s) <==> 2K(aq) + SO4(aq) - XK18 = 24.016 ! KHSO4(s) <==> K(aq) + HSO4(aq) - XK19 = 0.872 ! KNO3(s) <==> K(aq) + NO3(aq) - XK20 = 8.680 ! KCL(s) <==> K(aq) + CL(aq) - XK23 = 1.079D5 ! MGS04(s) <==> MG(aq) + SO4(aq) - XK24 = 2.507D15 ! MG(NO3)2(s) <==> MG(aq) + 2NO3(aq) - XK25 = 9.557D21 ! MGCL2(s) <==> MG(aq) + 2CL(aq) -! XK26 = 4.299D-7 ! CO2(aq) + H2O <==> HCO3(aq) + H(aq) -! XK27 = 4.678D-11 ! HCO3(aq) <==> CO3(aq) + H(aq) - - - IF (INT(TEMP) /= 298) THEN ! FOR T != 298K or 298.15K - T0 = 298.15D0 - T0T = T0/TEMP - COEF= 1.0+LOG(T0T)-T0T - XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) - XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) - XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) - XK3 = XK3 *EXP( 30.20*(T0T-1.0) + 19.910*COEF) - XK31= XK31*EXP( 30.20*(T0T-1.0) + 19.910*COEF) - XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR - ! XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL - XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF) - XK5 = XK5 *EXP( 0.98*(T0T-1.0) + 39.500*COEF) - XK6 = XK6 *EXP(-71.00*(T0T-1.0) + 2.400*COEF) - XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) - XK8 = XK8 *EXP( -1.56*(T0T-1.0) + 16.900*COEF) - XK9 = XK9 *EXP( -8.22*(T0T-1.0) + 16.010*COEF) - ! XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR - XK10= XK10*EXP(-74.7351*(T0T-1.0) + 6.025*COEF) ! (Mozurkewich, 1993) - ! XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL - XK11= XK11*EXP( 0.79*(T0T-1.0) + 14.746*COEF) - XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) - XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) - XK14= XK14*EXP( 24.55*(T0T-1.0) + 16.900*COEF) - XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) - ! C - ! XK15= XK15 *EXP( .0*(T0T-1.0) + .0*COEF) - ! XK16= XK16 *EXP( .0*(T0T-1.0) + .0*COEF) - XK17= XK17 *EXP(-9.585*(T0T-1.0) + 45.81*COEF) - XK18= XK18 *EXP(-8.423*(T0T-1.0) + 17.96*COEF) - XK19= XK19 *EXP(-14.08*(T0T-1.0) + 19.39*COEF) - XK20= XK20 *EXP(-6.902*(T0T-1.0) + 19.95*COEF) - ! XK23= XK23 *EXP( .0*(T0T-1.0) + .0*COEF) - ! XK24= XK24 *EXP( .0*(T0T-1.0) + .0*COEF) - ! XK25= XK25 *EXP( .0*(T0T-1.0) + .0*COEF) - ! XK26= XK26 *EXP(-3.0821*(T0T-1.0) + 31.8139*COEF) - ! XK27= XK27 *EXP(-5.9908*(T0T-1.0) + 38.844*COEF) - - ENDIF - XK2 = XK21*XK22 - XK42 = XK4/XK41 - XK32 = XK3/XK31 - -! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** - - DRH2SO4 = ZERO - DRNH42S4 = 0.7997D0 - DRNH4HS4 = 0.4000D0 - DRLC = 0.6900D0 - DRNACL = 0.7528D0 - DRNANO3 = 0.7379D0 - DRNH4CL = 0.7710D0 - DRNH4NO3 = 0.6183D0 - DRNA2SO4 = 0.9300D0 - DRNAHSO4 = 0.5200D0 - DRCANO32 = 0.4906D0 - DRCACL2 = 0.2830D0 - DRK2SO4 = 0.9750D0 - DRKHSO4 = 0.8600D0 - DRKNO3 = 0.9248D0 - DRKCL = 0.8426D0 - DRMGSO4 = 0.8613D0 - DRMGNO32 = 0.5400D0 - DRMGCL2 = 0.3284D0 - IF (INT(TEMP) /= 298) THEN - T0 = 298.15D0 - TCF = 1.0/TEMP - 1.0/T0 - DRNACL = DRNACL *EXP( 25.*TCF) - DRNANO3 = DRNANO3 *EXP(304.*TCF) - DRNA2SO4 = DRNA2SO4*EXP( 80.*TCF) - DRNH4NO3 = DRNH4NO3*EXP(852.*TCF) - DRNH42S4 = DRNH42S4*EXP( 80.*TCF) - DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) - DRLC = DRLC *EXP(186.*TCF) - DRNH4CL = DRNH4Cl *EXP(239.*TCF) - DRNAHSO4 = DRNAHSO4*EXP(-45.*TCF) - ! DRCANO32 = DRCANO32*EXP(-430.5*TCF) - DRCANO32 = DRCANO32*EXP(509.4*TCF) ! KELLY & WEXLER (2005) FOR CANO32.4H20 - ! DRCACL2 = DRCACL2 *EXP(-1121.*TCF) - DRCACL2 = DRCACL2 *EXP(551.1*TCF) ! KELLY & WEXLER (2005) FOR CACL2.6H20 - DRK2SO4 = DRK2SO4 *EXP(35.6*TCF) - ! DRKHSO4 = DRKHSO4 *EXP( 0.*TCF) - ! DRKNO3 = DRKNO3 *EXP( 0.*TCF) - DRKCL = DRKCL *EXP(159.*TCF) - DRMGSO4 = DRMGSO4 *EXP(-714.45*TCF) - DRMGNO32 = DRMGNO32*EXP(230.2*TCF) ! KELLY & WEXLER (2005) FOR MGNO32.6H20 - ! DRMGCL2 = DRMGCL2 *EXP(-1860.*TCF) - DRMGCL2 = DRMGCL2 *EXP(42.23*TCF) ! KELLY & WEXLER (2005) FOR MGCL2.6H20 - - ENDIF - -! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** - - DRMLCAB = 0.378D0 ! (NH4)3H(SO4)2 & NH4HSO4 - DRMLCAS = 0.690D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 - DRMASAN = 0.600D0 ! (NH4)2SO4 & NH4NO3 - DRMG1 = 0.460D0 ! (NH4)2SO4, NH4NO3, NA2SO4, NH4CL - DRMG2 = 0.691D0 ! (NH4)2SO4, NA2SO4, NH4CL - DRMG3 = 0.697D0 ! (NH4)2SO4, NA2SO4 - DRMH1 = 0.240D0 ! NA2SO4, NANO3, NACL, NH4NO3, NH4CL - DRMH2 = 0.596D0 ! NA2SO4, NANO3, NACL, NH4CL - DRMI1 = 0.240D0 ! LC, NAHSO4, NH4HSO4, NA2SO4, (NH4)2SO4 - DRMI2 = 0.363D0 ! LC, NAHSO4, NA2SO4, (NH4)2SO4 - NO DATA - - DRMI3 = 0.610D0 ! LC, NA2SO4, (NH4)2SO4 - DRMQ1 = 0.494D0 ! (NH4)2SO4, NH4NO3, NA2SO4 - DRMR1 = 0.663D0 ! NA2SO4, NANO3, NACL - DRMR2 = 0.735D0 ! NA2SO4, NACL - DRMR3 = 0.673D0 ! NANO3, NACL - DRMR4 = 0.694D0 ! NA2SO4, NACL, NH4CL - DRMR5 = 0.731D0 ! NA2SO4, NH4CL - DRMR6 = 0.596D0 ! NA2SO4, NANO3, NH4CL - DRMR7 = 0.380D0 ! NA2SO4, NANO3, NACL, NH4NO3 - DRMR8 = 0.380D0 ! NA2SO4, NACL, NH4NO3 - DRMR9 = 0.494D0 ! NA2SO4, NH4NO3 - DRMR10 = 0.476D0 ! NA2SO4, NANO3, NH4NO3 - DRMR11 = 0.340D0 ! NA2SO4, NACL, NH4NO3, NH4CL - DRMR12 = 0.460D0 ! NA2SO4, NH4NO3, NH4CL - DRMR13 = 0.438D0 ! NA2SO4, NANO3, NH4NO3, NH4CL - - DRMO1 = 0.460D0 ! (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4 - DRMO2 = 0.691D0 ! (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4 - DRMO3 = 0.697D0 ! (NH4)2SO4, NA2SO4, K2SO4, MGSO4 - DRML1 = 0.240D0 ! K2SO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - DRML2 = 0.363D0 ! K2SO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC - DRML3 = 0.610D0 ! K2SO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC - DRMM1 = 0.240D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 - DRMM2 = 0.596D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 - DRMP1 = 0.200D0 ! CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - DRMP2 = 0.240D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - DRMP3 = 0.240D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - DRMP4 = 0.240D0 ! K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - DRMP5 = 0.240D0 ! K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4NO3, NH4CL -!C - DRMV1 = 0.494D0 ! (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4 -!C -!C -! DRMO1 = 0.1D0 ! (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4 -! DRMO2 = 0.1D0 ! (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4 -! DRMO3 = 0.1D0 ! (NH4)2SO4, NA2SO4, K2SO4, MGSO4 -! DRML1 = 0.1D0 ! K2SO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -! DRML2 = 0.1D0 ! K2SO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC -! DRML3 = 0.1D0 ! K2SO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC -! DRMM1 = 0.1D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3 -! DRMM2 = 0.1D0 ! K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -! DRMP1 = 0.1D0 ! CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -! DRMP2 = 0.1D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL -! DRMP3 = 0.1D0 ! CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -! DRMP4 = 0.1D0 ! K2SO4, KNO3, KCL, MGSO4, MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL -! DRMP5 = 0.1D0 ! K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4NO3, NH4CL -!C -! DRMV1 = 0.1D0 ! (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4 - -! C IF (INT(TEMP) .NE. 298) THEN -! C T0 = 298.15d0 -! C TCF = 1.0/TEMP - 1.0/T0 -! C DRMLCAB = DRMLCAB*EXP( 507.506*TCF) -! C DRMLCAS = DRMLCAS*EXP( 133.865*TCF) -! C DRMASAN = DRMASAN*EXP(1269.068*TCF) -! C DRMG1 = DRMG1 *EXP( 572.207*TCF) -! C DRMG2 = DRMG2 *EXP( 58.166*TCF) -! C DRMG3 = DRMG3 *EXP( 22.253*TCF) -! C DRMH1 = DRMH1 *EXP(2116.542*TCF) -! C DRMH2 = DRMH2 *EXP( 650.549*TCF) -! C DRMI1 = DRMI1 *EXP( 565.743*TCF) -! C DRMI2 = DRMI2 *EXP( 91.745*TCF) -! C DRMI3 = DRMI3 *EXP( 161.272*TCF) -! C DRMQ1 = DRMQ1 *EXP(1616.621*TCF) -! C DRMR1 = DRMR1 *EXP( 292.564*TCF) -! C DRMR2 = DRMR2 *EXP( 14.587*TCF) -! C DRMR3 = DRMR3 *EXP( 307.907*TCF) -! C DRMR4 = DRMR4 *EXP( 97.605*TCF) -! C DRMR5 = DRMR5 *EXP( 98.523*TCF) -! C DRMR6 = DRMR6 *EXP( 465.500*TCF) -! C DRMR7 = DRMR7 *EXP( 324.425*TCF) -! C DRMR8 = DRMR8 *EXP(2660.184*TCF) -! C DRMR9 = DRMR9 *EXP(1617.178*TCF) -! C DRMR10 = DRMR10 *EXP(1745.226*TCF) -! C DRMR11 = DRMR11 *EXP(3691.328*TCF) -! C DRMR12 = DRMR12 *EXP(1836.842*TCF) -! C DRMR13 = DRMR13 *EXP(1967.938*TCF) -! C ENDIF - -! *** LIQUID PHASE ****************************************************** - - CHNO3 = ZERO - CHCL = ZERO - CH2SO4 = ZERO - COH = ZERO - WATER = TINY - - DO 20 I=1,NPAIR - MOLALR(I)=ZERO - GAMA(I) =0.1 - GAMIN(I) =GREAT - GAMOU(I) =GREAT - M0(I) =1d5 - 20 END DO - - DO 30 I=1,NPAIR - GAMA(I) = 0.1d0 - 30 END DO - - DO 40 I=1,NIONS - MOLAL(I)=ZERO - 40 END DO - COH = ZERO - - DO 50 I=1,NGASAQ - GASAQ(I)=ZERO - 50 END DO - -! *** SOLID PHASE ******************************************************* - - CNH42S4= ZERO - CNH4HS4= ZERO - CNACL = ZERO - CNA2SO4= ZERO - CNANO3 = ZERO - CNH4NO3= ZERO - CNH4CL = ZERO - CNAHSO4= ZERO - CLC = ZERO - CCASO4 = ZERO - CCANO32= ZERO - CCACL2 = ZERO - CK2SO4 = ZERO - CKHSO4 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGSO4 = ZERO - CMGNO32= ZERO - CMGCL2 = ZERO - -! *** GAS PHASE ********************************************************* - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - -! *** CALCULATE ZSR PARAMETERS ****************************************** - - IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays - IRH = MAX (IRH, 1) - - M0(01) = AWSC(IRH) ! NACl -! IF (M0(01) .LT. 100.0) THEN -! IC = M0(01) -! CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(01) = M0(01)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(02) = AWSS(IRH) ! (NA)2SO4 -! IF (M0(02) .LT. 100.0) THEN -! IC = 3.0*M0(02) -! CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(02) = M0(02)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(03) = AWSN(IRH) ! NANO3 -! IF (M0(03) .LT. 100.0) THEN -! IC = M0(03) -! CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(03) = M0(03)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(04) = AWAS(IRH) ! (NH4)2SO4 -! IF (M0(04) .LT. 100.0) THEN -! IC = 3.0*M0(04) -! CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(04) = M0(04)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(05) = AWAN(IRH) ! NH4NO3 -! IF (M0(05) .LT. 100.0) THEN -! IC = M0(05) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(05) = M0(05)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(06) = AWAC(IRH) ! NH4CL -! IF (M0(06) .LT. 100.0) THEN -! IC = M0(06) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(06) = M0(06)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(07) = AWSA(IRH) ! 2H-SO4 -! IF (M0(07) .LT. 100.0) THEN -! IC = 3.0*M0(07) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(07) = M0(07)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(08) = AWSA(IRH) ! H-HSO4 -! C IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used -! C IC = M0(08) -! C CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! C CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! CCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) -! C M0(08) = M0(08)*EXP(LN10*(GI0-GII)) -! C ENDIF - - M0(09) = AWAB(IRH) ! NH4HSO4 -! IF (M0(09) .LT. 100.0) THEN -! IC = M0(09) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(09) = M0(09)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(12) = AWSB(IRH) ! NAHSO4 -! IF (M0(12) .LT. 100.0) THEN -! IC = M0(12) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(12) = M0(12)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 -! IF (M0(13) .LT. 100.0) THEN -! IC = 4.0*M0(13) -! CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! G130 = 0.2*(3.0*GI0+2.0*GII) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,XX) -! G13I = 0.2*(3.0*GI0+2.0*GII) -! M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) -! ENDIF - - M0(15) = AWCN(IRH) ! CA(NO3)2 -! IF (M0(15) .LT. 100.0) THEN -! IC = M0(15) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & GI0,XX,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & GII,XX,XX,XX,XX,XX,XX,XX,XX) -! M0(15) = M0(15)*EXP(LN10*(GI0-GII)) -! ENDIF -!C - M0(16) = AWCC(IRH) ! CACl2 -! IF (M0(16) .LT. 100.0) THEN -! IC = M0(16) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,GI0,XX,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,GII,XX,XX,XX,XX,XX,XX,XX) -! M0(16) = M0(16)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(17) = AWPS(IRH) ! K2SO4 -! IF (M0(17) .LT. 100.0) THEN -! IC = M0(17) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,GI0,XX,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,GII,XX,XX,XX,XX,XX,XX) -! M0(17) = M0(17)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(18) = AWPB(IRH) ! KHSO4 -! IF (M0(18) .LT. 100.0) THEN -! IC = M0(18) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,GI0,XX,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,GII,XX,XX,XX,XX,XX) -! M0(18) = M0(18)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(19) = AWPN(IRH) ! KNO3 -! IF (M0(19) .LT. 100.0) THEN -! IC = M0(19) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,GI0,XX,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,GII,XX,XX,XX,XX) -! M0(19) = M0(19)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(20) = AWPC(IRH) ! KCl -! IF (M0(20) .LT. 100.0) THEN -! IC = M0(20) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,GI0,XX,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,GII,XX,XX,XX) -! M0(20) = M0(20)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(21) = AWMS(IRH) ! MGSO4 -! IF (M0(21) .LT. 100.0) THEN -! IC = M0(21) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,GI0,XX,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,GII,XX,XX) -! M0(21) = M0(21)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(22) = AWMN(IRH) ! MG(NO3)2 -! IF (M0(22) .LT. 100.0) THEN -! IC = M0(22) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,GI0,XX) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,GII,XX) -! M0(22) = M0(22)*EXP(LN10*(GI0-GII)) -! ENDIF - - M0(23) = AWMC(IRH) ! MGCL2 -! IF (M0(23) .LT. 100.0) THEN -! IC = M0(23) -! CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,GI0) -! CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX, -! & XX,XX,XX,XX,XX,XX,XX,XX,GII) -! M0(23) = M0(23)*EXP(LN10*(GI0-GII)) -! ENDIF - -! *** OTHER INITIALIZATIONS ********************************************* - - ICLACT = 0 - CALAOU = .TRUE. - CALAIN = .TRUE. - FRST = .TRUE. - SCASE = '??' - SULRATW = 2.D0 - SO4RAT = 2.D0 - CRNARAT = 2.D0 - CRRAT = 2.D0 - NOFER = 0 - STKOFL = .FALSE. - DO 60 I=1,NERRMX - ERRSTK(I) =-999 - ERRMSG(I) = 'MESSAGE N/A' - 60 END DO - -! *** END OF SUBROUTINE INIT4 ******************************************* - - END SUBROUTINE INIT4 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ADJUST -! *** ADJUSTS FOR MASS BALANCE BETWEEN VOLATILE SPECIES AND SULFATE -! FIRST CALCULATE THE EXCESS OF EACH PRECURSOR, AND IF IT EXISTS, THEN -! ADJUST SEQUENTIALY AEROSOL PHASE SPECIES WHICH CONTAIN THE EXCESS -! PRECURSOR. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ADJUST (WI) - INCLUDE 'isrpia.inc' - real :: WI(*) - -! *** FOR AMMONIUM ***************************************************** - - IF (IPROB == 0) THEN ! Calculate excess (solution - input) - EXNH4 = GNH3 + MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 & - + 2D0*CNH42S4 + 3D0*CLC & - -WI(3) - ELSE - EXNH4 = MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 + 2D0*CNH42S4 & - + 3D0*CLC & - -WI(3) - - ENDIF - EXNH4 = MAX(EXNH4,ZERO) - IF (EXNH4 < TINY) GOTO 20 ! No excess NH4, go to next precursor - - IF (MOLAL(3) > EXNH4) THEN ! Adjust aqueous phase NH4 - MOLAL(3) = MOLAL(3) - EXNH4 - GOTO 20 - ELSE - EXNH4 = EXNH4 - MOLAL(3) - MOLAL(3) = ZERO - ENDIF - - IF (CNH4CL > EXNH4) THEN ! Adjust NH4Cl(s) - CNH4CL = CNH4CL - EXNH4 ! more solid than excess - GHCL = GHCL + EXNH4 ! evaporate Cl to gas phase - GOTO 20 - ELSE ! less solid than excess - GHCL = GHCL + CNH4CL ! evaporate into gas phase - EXNH4 = EXNH4 - CNH4CL ! reduce excess - CNH4CL = ZERO ! zero salt concentration - ENDIF - - IF (CNH4NO3 > EXNH4) THEN ! Adjust NH4NO3(s) - CNH4NO3 = CNH4NO3- EXNH4 ! more solid than excess - GHNO3 = GHNO3 + EXNH4 ! evaporate NO3 to gas phase - GOTO 20 - ELSE ! less solid than excess - GHNO3 = GHNO3 + CNH4NO3! evaporate into gas phase - EXNH4 = EXNH4 - CNH4NO3! reduce excess - CNH4NO3 = ZERO ! zero salt concentration - ENDIF - - IF (CLC > 3d0*EXNH4) THEN ! Adjust (NH4)3H(SO4)2(s) - CLC = CLC - EXNH4/3d0 ! more solid than excess - GOTO 20 - ELSE ! less solid than excess - EXNH4 = EXNH4 - 3d0*CLC ! reduce excess - CLC = ZERO ! zero salt concentration - ENDIF - - IF (CNH4HS4 > EXNH4) THEN ! Adjust NH4HSO4(s) - CNH4HS4 = CNH4HS4- EXNH4 ! more solid than excess - GOTO 20 - ELSE ! less solid than excess - EXNH4 = EXNH4 - CNH4HS4! reduce excess - CNH4HS4 = ZERO ! zero salt concentration - ENDIF - - IF (CNH42S4 > EXNH4) THEN ! Adjust (NH4)2SO4(s) - CNH42S4 = CNH42S4- EXNH4 ! more solid than excess - GOTO 20 - ELSE ! less solid than excess - EXNH4 = EXNH4 - CNH42S4! reduce excess - CNH42S4 = ZERO ! zero salt concentration - ENDIF - -! *** FOR NITRATE ****************************************************** - - 20 IF (IPROB == 0) THEN ! Calculate excess (solution - input) - EXNO3 = GHNO3 + MOLAL(7) + CNH4NO3 & - -WI(4) - ELSE - EXNO3 = MOLAL(7) + CNH4NO3 & - -WI(4) - ENDIF - EXNO3 = MAX(EXNO3,ZERO) - IF (EXNO3 < TINY) GOTO 30 ! No excess NO3, go to next precursor - - IF (MOLAL(7) > EXNO3) THEN ! Adjust aqueous phase NO3 - MOLAL(7) = MOLAL(7) - EXNO3 - GOTO 30 - ELSE - EXNO3 = EXNO3 - MOLAL(7) - MOLAL(7) = ZERO - ENDIF - - IF (CNH4NO3 > EXNO3) THEN ! Adjust NH4NO3(s) - CNH4NO3 = CNH4NO3- EXNO3 ! more solid than excess - GNH3 = GNH3 + EXNO3 ! evaporate NO3 to gas phase - GOTO 30 - ELSE ! less solid than excess - GNH3 = GNH3 + CNH4NO3! evaporate into gas phase - EXNO3 = EXNO3 - CNH4NO3! reduce excess - CNH4NO3 = ZERO ! zero salt concentration - ENDIF - -! *** FOR CHLORIDE ***************************************************** - - 30 IF (IPROB == 0) THEN ! Calculate excess (solution - input) - EXCl = GHCL + MOLAL(4) + CNH4CL & - -WI(5) - ELSE - EXCl = MOLAL(4) + CNH4CL & - -WI(5) - ENDIF - EXCl = MAX(EXCl,ZERO) - IF (EXCl < TINY) GOTO 40 ! No excess Cl, go to next precursor - - IF (MOLAL(4) > EXCL) THEN ! Adjust aqueous phase Cl - MOLAL(4) = MOLAL(4) - EXCL - GOTO 40 - ELSE - EXCL = EXCL - MOLAL(4) - MOLAL(4) = ZERO - ENDIF - - IF (CNH4CL > EXCL) THEN ! Adjust NH4Cl(s) - CNH4CL = CNH4CL - EXCL ! more solid than excess - GHCL = GHCL + EXCL ! evaporate Cl to gas phase - GOTO 40 - ELSE ! less solid than excess - GHCL = GHCL + CNH4CL ! evaporate into gas phase - EXCL = EXCL - CNH4CL ! reduce excess - CNH4CL = ZERO ! zero salt concentration - ENDIF - -! *** FOR SULFATE ****************************************************** - - 40 EXS4 = MOLAL(5) + MOLAL(6) + 2.d0*CLC + CNH42S4 + CNH4HS4 + & - CNA2SO4 + CNAHSO4 - WI(2) - EXS4 = MAX(EXS4,ZERO) ! Calculate excess (solution - input) - IF (EXS4 < TINY) GOTO 50 ! No excess SO4, return - - IF (MOLAL(6) > EXS4) THEN ! Adjust aqueous phase HSO4 - MOLAL(6) = MOLAL(6) - EXS4 - GOTO 50 - ELSE - EXS4 = EXS4 - MOLAL(6) - MOLAL(6) = ZERO - ENDIF - - IF (MOLAL(5) > EXS4) THEN ! Adjust aqueous phase SO4 - MOLAL(5) = MOLAL(5) - EXS4 - GOTO 50 - ELSE - EXS4 = EXS4 - MOLAL(5) - MOLAL(5) = ZERO - ENDIF - - IF (CLC > 2d0*EXS4) THEN ! Adjust (NH4)3H(SO4)2(s) - CLC = CLC - EXS4/2d0 ! more solid than excess - GNH3 = GNH3 +1.5d0*EXS4! evaporate NH3 to gas phase - GOTO 50 - ELSE ! less solid than excess - GNH3 = GNH3 + 1.5d0*CLC! evaporate NH3 to gas phase - EXS4 = EXS4 - 2d0*CLC ! reduce excess - CLC = ZERO ! zero salt concentration - ENDIF - - IF (CNH4HS4 > EXS4) THEN ! Adjust NH4HSO4(s) - CNH4HS4 = CNH4HS4 - EXS4 ! more solid than excess - GNH3 = GNH3 + EXS4 ! evaporate NH3 to gas phase - GOTO 50 - ELSE ! less solid than excess - GNH3 = GNH3 + CNH4HS4 ! evaporate NH3 to gas phase - EXS4 = EXS4 - CNH4HS4 ! reduce excess - CNH4HS4 = ZERO ! zero salt concentration - ENDIF - - IF (CNH42S4 > EXS4) THEN ! Adjust (NH4)2SO4(s) - CNH42S4 = CNH42S4- EXS4 ! more solid than excess - GNH3 = GNH3 + 2.d0*EXS4! evaporate NH3 to gas phase - GOTO 50 - ELSE ! less solid than excess - GNH3 = GNH3+2.d0*CNH42S4 ! evaporate NH3 to gas phase - EXS4 = EXS4 - CNH42S4 ! reduce excess - CNH42S4 = ZERO ! zero salt concentration - ENDIF - -! *** RETURN ********************************************************** - - 50 RETURN - END SUBROUTINE ADJUST - -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION GETASR -! *** CALCULATES THE LIMITING NH4+/SO4 RATIO OF A SULFATE POOR SYSTEM -! (i.e. SULFATE RATIO = 2.0) FOR GIVEN SO4 LEVEL AND RH - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - real FUNCTION GETASR (SO4I, RHI) - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS) - COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S) - real :: SO4I, RHI -! C -! C *** SOLVE USING FULL COMPUTATIONS, NOT LOOK-UP TABLES ************** -! C -! C W(2) = WAER(2) -! C W(3) = WAER(2)*2.0001D0 -! C CALL CALCA2 -! C SULRATW = MOLAL(3)/WAER(2) -! C CALL INIT1 (WI, RHI, TEMPI) ! Re-initialize COMMON BLOCK - -! *** CALCULATE INDICES ************************************************ - - RAT = SO4I/1.E-9 - A1 = INT(ALOG10(RAT)) ! Magnitude of RAT - IA1 = INT(RAT/2.5/10.0**A1) - - INDS = 4.0*A1 + MIN(IA1,4) - INDS = MIN(MAX(0, INDS), NSO4S-1) + 1 ! SO4 component of IPOS - - INDR = INT(99.0-RHI*100.0) + 1 - INDR = MIN(MAX(1, INDR), NRHS) ! RH component of IPOS - -! *** GET VALUE AND RETURN ********************************************* - - INDSL = INDS - INDSH = MIN(INDSL+1, NSO4S) - IPOSL = (INDSL-1)*NRHS + INDR ! Low position in array - IPOSH = (INDSH-1)*NRHS + INDR ! High position in array - - WF = (SO4I-ASSO4(INDSL))/(ASSO4(INDSH)-ASSO4(INDSL) + 1e-7) - WF = MIN(MAX(WF, 0.0), 1.0) - - GETASR = WF*ASRAT(IPOSH) + (1.0-WF)*ASRAT(IPOSL) - -! *** END OF FUNCTION GETASR ******************************************* - - RETURN - END FUNCTION GETASR - -!======================================================================= - -! *** ISORROPIA CODE -! *** BLOCK DATA AERSR -! *** CONTAINS DATA FOR AEROSOL SULFATE RATIO ARRAY NEEDED IN FUNCTION -! GETASR - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - BLOCK DATA AERSR - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS) - COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S) - - DATA ASSO4/1.0E-9, 2.5E-9, 5.0E-9, 7.5E-9, 1.0E-8, & - & 2.5E-8, 5.0E-8, 7.5E-8, 1.0E-7, 2.5E-7, & - & 5.0E-7, 7.5E-7, 1.0E-6, 5.0E-6/ - - DATA (ASRAT(I), I=1,100)/ & - & 1.020464, 0.9998130, 0.9960167, 0.9984423, 1.004004, & - & 1.010885, 1.018356, 1.026726, 1.034268, 1.043846, & - & 1.052933, 1.062230, 1.062213, 1.080050, 1.088350, & - & 1.096603, 1.104289, 1.111745, 1.094662, 1.121594, & - & 1.268909, 1.242444, 1.233815, 1.232088, 1.234020, & - & 1.238068, 1.243455, 1.250636, 1.258734, 1.267543, & - & 1.276948, 1.286642, 1.293337, 1.305592, 1.314726, & - & 1.323463, 1.333258, 1.343604, 1.344793, 1.355571, & - & 1.431463, 1.405204, 1.395791, 1.393190, 1.394403, & - & 1.398107, 1.403811, 1.411744, 1.420560, 1.429990, & - & 1.439742, 1.449507, 1.458986, 1.468403, 1.477394, & - & 1.487373, 1.495385, 1.503854, 1.512281, 1.520394, & - & 1.514464, 1.489699, 1.480686, 1.478187, 1.479446, & - & 1.483310, 1.489316, 1.497517, 1.506501, 1.515816, & - & 1.524724, 1.533950, 1.542758, 1.551730, 1.559587, & - & 1.568343, 1.575610, 1.583140, 1.590440, 1.596481, & - & 1.567743, 1.544426, 1.535928, 1.533645, 1.535016, & - & 1.539003, 1.545124, 1.553283, 1.561886, 1.570530, & - & 1.579234, 1.587813, 1.595956, 1.603901, 1.611349, & - & 1.618833, 1.625819, 1.632543, 1.639032, 1.645276/ - - DATA (ASRAT(I), I=101,200)/ & - & 1.707390, 1.689553, 1.683198, 1.681810, 1.683490, & - & 1.687477, 1.693148, 1.700084, 1.706917, 1.713507, & - & 1.719952, 1.726190, 1.731985, 1.737544, 1.742673, & - & 1.747756, 1.752431, 1.756890, 1.761141, 1.765190, & - & 1.785657, 1.771851, 1.767063, 1.766229, 1.767901, & - & 1.771455, 1.776223, 1.781769, 1.787065, 1.792081, & - & 1.796922, 1.801561, 1.805832, 1.809896, 1.813622, & - & 1.817292, 1.820651, 1.823841, 1.826871, 1.829745, & - & 1.822215, 1.810497, 1.806496, 1.805898, 1.807480, & - & 1.810684, 1.814860, 1.819613, 1.824093, 1.828306, & - & 1.832352, 1.836209, 1.839748, 1.843105, 1.846175, & - & 1.849192, 1.851948, 1.854574, 1.857038, 1.859387, & - & 1.844588, 1.834208, 1.830701, 1.830233, 1.831727, & - & 1.834665, 1.838429, 1.842658, 1.846615, 1.850321, & - & 1.853869, 1.857243, 1.860332, 1.863257, 1.865928, & - & 1.868550, 1.870942, 1.873208, 1.875355, 1.877389, & - & 1.899556, 1.892637, 1.890367, 1.890165, 1.891317, & - & 1.893436, 1.896036, 1.898872, 1.901485, 1.903908, & - & 1.906212, 1.908391, 1.910375, 1.912248, 1.913952, & - & 1.915621, 1.917140, 1.918576, 1.919934, 1.921220/ - - DATA (ASRAT(I), I=201,280)/ & - & 1.928264, 1.923245, 1.921625, 1.921523, 1.922421, & - & 1.924016, 1.925931, 1.927991, 1.929875, 1.931614, & - & 1.933262, 1.934816, 1.936229, 1.937560, 1.938769, & - & 1.939951, 1.941026, 1.942042, 1.943003, 1.943911, & - & 1.941205, 1.937060, 1.935734, 1.935666, 1.936430, & - & 1.937769, 1.939359, 1.941061, 1.942612, 1.944041, & - & 1.945393, 1.946666, 1.947823, 1.948911, 1.949900, & - & 1.950866, 1.951744, 1.952574, 1.953358, 1.954099, & - & 1.948985, 1.945372, 1.944221, 1.944171, 1.944850, & - & 1.946027, 1.947419, 1.948902, 1.950251, 1.951494, & - & 1.952668, 1.953773, 1.954776, 1.955719, 1.956576, & - & 1.957413, 1.958174, 1.958892, 1.959571, 1.960213, & - & 1.977193, 1.975540, 1.975023, 1.975015, 1.975346, & - & 1.975903, 1.976547, 1.977225, 1.977838, 1.978401, & - & 1.978930, 1.979428, 1.979879, 1.980302, 1.980686, & - & 1.981060, 1.981401, 1.981722, 1.982025, 1.982312/ - -! *** END OF BLOCK DATA AERSR ****************************************** - - END BLOCK DATA - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCHA -! *** CALCULATES CHLORIDES SPECIATION - -! HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, -! AND DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE -! HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE -! HCL(G) <-> (H+) + (CL-) -! EQUILIBRIUM, USING THE (H+) FROM THE SULFATES. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCHA - INCLUDE 'isrpia.inc' - real :: KAPA -!C CHARACTER ERRINF*40 - -! *** CALCULATE HCL DISSOLUTION ***************************************** - - X = W(5) - DELT = 0.0d0 - IF (WATER > TINY) THEN - KAPA = MOLAL(1) - ALFA = XK3*R*TEMP*(WATER/GAMA(11))**2.0 - DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X) - DELT = 0.5*(-(KAPA+ALFA) + DIAK) - !C IF (DELT/KAPA.GT.0.1d0) THEN - !C WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0 - !C CALL PUSHERR (0033, ERRINF) - !C ENDIF - ENDIF - -! *** CALCULATE HCL SPECIATION IN THE GAS PHASE ************************* - - GHCL = MAX(X-DELT, 0.0d0) ! GAS HCL - -! *** CALCULATE HCL SPECIATION IN THE LIQUID PHASE ********************** - - MOLAL(4) = DELT ! CL- - MOLAL(1) = MOLAL(1) + DELT ! H+ - - RETURN - -! *** END OF SUBROUTINE CALCHA ****************************************** - - END SUBROUTINE CALCHA - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCHAP -! *** CALCULATES CHLORIDES SPECIATION - -! HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, -! THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. -! THE HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE -! HCL(G) -> HCL(AQ) AND HCL(AQ) -> (H+) + (CL-) -! EQUILIBRIA, USING (H+) FROM THE SULFATES. - -! THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCHAP - INCLUDE 'isrpia.inc' - -! *** IS THERE A LIQUID PHASE? ****************************************** - - IF (WATER <= TINY) RETURN - -! *** CALCULATE HCL SPECIATION IN THE GAS PHASE ************************* - - CALL CALCCLAQ (MOLAL(4), MOLAL(1), DELT) - ALFA = XK3*R*TEMP*(WATER/GAMA(11))**2.0 - GASAQ(3) = DELT - MOLAL(1) = MOLAL(1) - DELT - MOLAL(4) = MOLAL(4) - DELT - GHCL = MOLAL(1)*MOLAL(4)/ALFA - - RETURN - -! *** END OF SUBROUTINE CALCHAP ***************************************** - - END SUBROUTINE CALCHAP - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNA -! *** CALCULATES NITRATES SPECIATION - -! NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT -! DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC -! ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> (H+) + (NO3-) -! EQUILIBRIUM, USING THE (H+) FROM THE SULFATES. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNA - INCLUDE 'isrpia.inc' - real :: KAPA -!C CHARACTER ERRINF*40 - -! *** CALCULATE HNO3 DISSOLUTION **************************************** - - X = W(4) - DELT = 0.0d0 - IF (WATER > TINY) THEN - KAPA = MOLAL(1) - ALFA = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X) - DELT = 0.5*(-(KAPA+ALFA) + DIAK) - !C IF (DELT/KAPA.GT.0.1d0) THEN - !C WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0 - !C CALL PUSHERR (0019, ERRINF) ! WARNING ERROR: NO SOLUTION - !C ENDIF - ENDIF - -! *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************ - - GHNO3 = MAX(X-DELT, 0.0d0) ! GAS HNO3 - -! *** CALCULATE HNO3 SPECIATION IN THE LIQUID PHASE ********************* - - MOLAL(7) = DELT ! NO3- - MOLAL(1) = MOLAL(1) + DELT ! H+ - - RETURN - -! *** END OF SUBROUTINE CALCNA ****************************************** - - END SUBROUTINE CALCNA - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNAP -! *** CALCULATES NITRATES SPECIATION - -! NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT -! DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC -! ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> HNO3(AQ) AND -! HNO3(AQ) -> (H+) + (CL-) EQUILIBRIA, USING (H+) FROM THE SULFATES. - -! THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNAP - INCLUDE 'isrpia.inc' - -! *** IS THERE A LIQUID PHASE? ****************************************** - - IF (WATER <= TINY) RETURN - -! *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************ - - CALL CALCNIAQ (MOLAL(7), MOLAL(1), DELT) - ALFA = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - GASAQ(3) = DELT - MOLAL(1) = MOLAL(1) - DELT - MOLAL(7) = MOLAL(7) - DELT - GHNO3 = MOLAL(1)*MOLAL(7)/ALFA - - write (*,*) ALFA, MOLAL(1), MOLAL(7), GHNO3, DELT - - RETURN - -! *** END OF SUBROUTINE CALCNAP ***************************************** - - END SUBROUTINE CALCNAP - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNH3 -! *** CALCULATES AMMONIA IN GAS PHASE - -! AMMONIA IN THE GAS PHASE IS ASSUMED A MINOR SPECIES, THAT -! DOES NOT SIGNIFICANTLY PERTURB THE AEROSOL EQUILIBRIUM. -! AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l) -! EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION. - -! THIS IS THE VERSION USED BY THE DIRECT PROBLEM - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNH3 - INCLUDE 'isrpia.inc' - -! *** IS THERE A LIQUID PHASE? ****************************************** - - IF (WATER <= TINY) RETURN - -! *** CALCULATE NH3 SUBLIMATION ***************************************** - - A1 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - CHI1 = MOLAL(3) - CHI2 = MOLAL(1) - - BB =(CHI2 + ONE/A1) ! a=1; b!=1; c!=1 - CC =-CHI1/A1 - DIAK = SQRT(BB*BB - 4.D0*CC) ! Always > 0 - PSI = 0.5*(-BB + DIAK) ! One positive root - PSI = MAX(TINY, MIN(PSI,CHI1))! Constrict in acceptible range - -! *** CALCULATE NH3 SPECIATION IN THE GAS PHASE ************************* - - GNH3 = PSI ! GAS HNO3 - -! *** CALCULATE NH3 AFFECT IN THE LIQUID PHASE ************************** - - MOLAL(3) = CHI1 - PSI ! NH4+ - MOLAL(1) = CHI2 + PSI ! H+ - - RETURN - -! *** END OF SUBROUTINE CALCNH3 ***************************************** - - END SUBROUTINE CALCNH3 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNH3P -! *** CALCULATES AMMONIA IN GAS PHASE - -! AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l) -! EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION. - -! THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNH3P - INCLUDE 'isrpia.inc' - -! *** IS THERE A LIQUID PHASE? ****************************************** - - IF (WATER <= TINY) RETURN - -! *** CALCULATE NH3 GAS PHASE CONCENTRATION ***************************** - - A1 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 - GNH3 = MOLAL(3)/MOLAL(1)/A1 - - RETURN - -! *** END OF SUBROUTINE CALCNH3P **************************************** - - END SUBROUTINE CALCNH3P - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNHA - -! THIS SUBROUTINE CALCULATES THE DISSOLUTION OF HCL, HNO3 AT -! THE PRESENCE OF (H,SO4). HCL, HNO3 ARE CONSIDERED MINOR SPECIES, -! THAT DO NOT SIGNIFICANTLY AFFECT THE EQUILIBRIUM POINT. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNHA - INCLUDE 'isrpia.inc' - real :: M1, M2, M3 - CHARACTER ERRINF*40 - -! *** SPECIAL CASE; WATER=ZERO ****************************************** - - IF (WATER <= TINY) THEN - GOTO 55 - - ! *** SPECIAL CASE; HCL=HNO3=ZERO *************************************** - - ELSEIF (W(5) <= TINY .AND. W(4) <= TINY) THEN - GOTO 60 - - ! *** SPECIAL CASE; HCL=ZERO ******************************************** - - ELSE IF (W(5) <= TINY) THEN - CALL CALCNA ! CALL HNO3 DISSOLUTION ROUTINE - GOTO 60 - - ! *** SPECIAL CASE; HNO3=ZERO ******************************************* - - ELSE IF (W(4) <= TINY) THEN - CALL CALCHA ! CALL HCL DISSOLUTION ROUTINE - GOTO 60 - ENDIF - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 ! HNO3 - A4 = XK3*R*TEMP*(WATER/GAMA(11))**2.0 ! HCL - -! *** CALCULATE CUBIC EQUATION COEFFICIENTS ***************************** - - DELCL = ZERO - DELNO = ZERO - - OMEGA = MOLAL(1) ! H+ - CHI3 = W(4) ! HNO3 - CHI4 = W(5) ! HCL - - C1 = A3*CHI3 - C2 = A4*CHI4 - C3 = A3 - A4 - - M1 = (C1 + C2 + (OMEGA+A4)*C3)/C3 - M2 = ((OMEGA+A4)*C2 - A4*C3*CHI4)/C3 - M3 =-A4*C2*CHI4/C3 - -! *** CALCULATE ROOTS *************************************************** - - CALL POLY3 (M1, M2, M3, DELCL, ISLV) ! HCL DISSOLUTION - IF (ISLV /= 0) THEN - DELCL = TINY ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT - WRITE (ERRINF,'(1PE7.1)') TINY - CALL PUSHERR (0022, ERRINF) ! WARNING ERROR: NO SOLUTION - ENDIF - DELCL = MIN(DELCL, CHI4) - - DELNO = C1*DELCL/(C2 + C3*DELCL) - DELNO = MIN(DELNO, CHI3) - - IF (DELCL < ZERO .OR. DELNO < ZERO .OR. & - DELCL > CHI4 .OR. DELNO > CHI3 ) THEN - DELCL = TINY ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT - DELNO = TINY - WRITE (ERRINF,'(1PE7.1)') TINY - CALL PUSHERR (0022, ERRINF) ! WARNING ERROR: NO SOLUTION - ENDIF -! C -! C *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT TO HSO4 *************** -! C -!C IF ((DELCL+DELNO)/MOLAL(1).GT.0.1d0) THEN -!C WRITE (ERRINF,'(1PE10.3)') (DELCL+DELNO)/MOLAL(1)*100.0 -!C CALL PUSHERR (0021, ERRINF) -!C ENDIF - -! *** EFFECT ON LIQUID PHASE ******************************************** - - 50 MOLAL(1) = MOLAL(1) + (DELNO+DELCL) ! H+ CHANGE - MOLAL(4) = MOLAL(4) + DELCL ! CL- CHANGE - MOLAL(7) = MOLAL(7) + DELNO ! NO3- CHANGE - -! *** EFFECT ON GAS PHASE *********************************************** - - 55 GHCL = MAX(W(5) - MOLAL(4), TINY) - GHNO3 = MAX(W(4) - MOLAL(7), TINY) - - 60 RETURN - -! *** END OF SUBROUTINE CALCNHA ***************************************** - - END SUBROUTINE CALCNHA - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNHP - -! THIS SUBROUTINE CALCULATES THE GAS PHASE NITRIC AND HYDROCHLORIC -! ACID. CONCENTRATIONS ARE CALCULATED FROM THE DISSOLUTION -! EQUILIBRIA, USING (H+), (Cl-), (NO3-) IN THE AEROSOL PHASE. - -! THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNHP - INCLUDE 'isrpia.inc' - -! *** IS THERE A LIQUID PHASE? ****************************************** - - IF (WATER <= TINY) RETURN - -! *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** - - A3 = XK3*R*TEMP*(WATER/GAMA(11))**2.0 - A4 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - MOLAL(1) = MOLAL(1) + WAER(4) + WAER(5) ! H+ increases because NO3, Cl are added. - -! *** CALCULATE CONCENTRATIONS ****************************************** -! *** ASSUME THAT 'DELT' FROM HNO3 >> 'DELT' FROM HCL - - CALL CALCNIAQ (WAER(4), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT) - MOLAL(1) = MOLAL(1) - DELT - MOLAL(7) = WAER(4) - DELT ! NO3- = Waer(4) minus any turned into (HNO3aq) - GASAQ(3) = DELT - - CALL CALCCLAQ (WAER(5), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT) - MOLAL(1) = MOLAL(1) - DELT - MOLAL(4) = WAER(5) - DELT ! Cl- = Waer(4) minus any turned into (HNO3aq) - GASAQ(2) = DELT - - GHNO3 = MOLAL(1)*MOLAL(7)/A4 - GHCL = MOLAL(1)*MOLAL(4)/A3 - - RETURN - -! *** END OF SUBROUTINE CALCNHP ***************************************** - - END SUBROUTINE CALCNHP - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCHCO3 -! *** CORRECTS FOR H+ WHEN CRUSTALS ARE IN EXCESS - -! CARBONATES ARE IN EXCESS, HCO3- IS ASSUMED A MINOR SPECIES, -! THE H+ CONCENTRATION IS CALCULATED FROM THE -! CO2(aq) + H2O <-> (HCO3-) + (H+) -! HCO3- <-> (H+) + (CO3--) EQUILIBRIUM. -! THE CO3-- CONCENTRATION IS ASSUMED NEGLIGIBLE WITH RESPECT TO HCO3- - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - -! SUBROUTINE CALCHCO3 -! INCLUDE 'isrpia.inc' -! real KAPA -! C CHARACTER ERRINF*40 -!C -!C *** SPECIAL CASE; WATER=ZERO ****************************************** -!C -! IF (WATER.LE.TINY) THEN -! GOTO 521 -! ENDIF -!C -!C *** CALCULATE CO2 DISSOLUTION ***************************************** -!C -! REST = 2.D0*W(2) + W(4) + W(5) -!C -! DELT = 0.0d0 -!C DELT2 = 0.0d0 -! IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN -! KAPA = MOLAL(1) -!C -!C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** -!C -! ALFA = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O -!C ALFA2 = XK27*(WATER/1.0) ! HCO3- -!C -!C *** CALCULATE CUBIC EQUATION COEFFICIENTS ***************************** -!C -! X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS HCO3- -!C -! BB =-(KAPA + X + ALFA) -! CC = KAPA*X -! DD = BB*BB - 4.D0*CC -!C -! IF (DD.GE.ZERO) THEN -! SQDD = SQRT(DD) -! DELT = 0.5*(-BB - SQDD) -! ELSE -! DELT = ZERO -! ENDIF - -! ENDIF -!C -!C *** CALCULATE H+ ***************************************************** -!C -! MOLAL(1) = KAPA - DELT ! H+ -!C -! 21 RETURN -!C -!C *** END OF SUBROUTINE CALCHCO3 *************************************** -!C -! END -!C -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCAMAQ -! *** THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCAMAQ (NH4I, OHI, DELT) - INCLUDE 'isrpia.inc' - real :: NH4I -!C CHARACTER ERRINF*40 - -! *** EQUILIBRIUM CONSTANTS - - A22 = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1 - AKW = XKW *RH*WATER*WATER - -! *** FIND ROOT - - OM1 = NH4I - OM2 = OHI - BB =-(OM1+OM2+A22*AKW) - CC = OM1*OM2 - DD = SQRT(BB*BB-4.D0*CC) - - DEL1 = 0.5D0*(-BB - DD) - DEL2 = 0.5D0*(-BB + DD) - -! *** GET APPROPRIATE ROOT. - - IF (DEL1 < ZERO) THEN - IF (DEL2 > NH4I .OR. DEL2 > OHI) THEN - DELT = ZERO - ELSE - DELT = DEL2 - ENDIF - ELSE - DELT = DEL1 - ENDIF -!C -!C *** COMPARE DELTA TO TOTAL NH4+ ; ESTIMATE EFFECT ********************* -!C -!C IF (DELTA/HYD.GT.0.1d0) THEN -!C WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0 -!C CALL PUSHERR (0020, ERRINF) -!C ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCAMAQ **************************************** - - END SUBROUTINE CALCAMAQ - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCAMAQ2 - -! THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCAMAQ2 (GGNH3, NH4I, OHI, NH3AQ) - INCLUDE 'isrpia.inc' - real :: NH4I, NH3AQ - -! *** EQUILIBRIUM CONSTANTS - - A22 = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1 - AKW = XKW *RH*WATER*WATER - -! *** FIND ROOT - - ALF1 = NH4I - GGNH3 - ALF2 = GGNH3 - BB = ALF1 + A22*AKW - CC =-A22*AKW*ALF2 - DEL = 0.5D0*(-BB + SQRT(BB*BB-4.D0*CC)) - -! *** ADJUST CONCENTRATIONS - - NH4I = ALF1 + DEL - OHI = DEL - IF (OHI <= TINY) OHI = SQRT(AKW) ! If solution is neutral. - NH3AQ = ALF2 - DEL - - RETURN - -! *** END OF SUBROUTINE CALCAMAQ2 **************************************** - - END SUBROUTINE CALCAMAQ2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCCLAQ - -! THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCCLAQ (CLI, HI, DELT) - INCLUDE 'isrpia.inc' - real :: CLI - -! *** EQUILIBRIUM CONSTANTS - - A32 = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1 - -! *** FIND ROOT - - OM1 = CLI - OM2 = HI - BB =-(OM1+OM2+A32) - CC = OM1*OM2 - DD = SQRT(BB*BB-4.D0*CC) - - DEL1 = 0.5D0*(-BB - DD) - DEL2 = 0.5D0*(-BB + DD) - -! *** GET APPROPRIATE ROOT. - - IF (DEL1 < ZERO) THEN - IF (DEL2 < ZERO .OR. DEL2 > CLI .OR. DEL2 > HI) THEN - DELT = ZERO - ELSE - DELT = DEL2 - ENDIF - ELSE - DELT = DEL1 - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCCLAQ **************************************** - - END SUBROUTINE CALCCLAQ - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCCLAQ2 - -! THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCCLAQ2 (GGCL, CLI, HI, CLAQ) - INCLUDE 'isrpia.inc' - real :: CLI - -! *** EQUILIBRIUM CONSTANTS - - A32 = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1 - AKW = XKW *RH*WATER*WATER - -! *** FIND ROOT - - ALF1 = CLI - GGCL - ALF2 = GGCL - COEF = (ALF1+A32) - DEL1 = 0.5*(-COEF + SQRT(COEF*COEF+4.D0*A32*ALF2)) - -! *** CORRECT CONCENTRATIONS - - CLI = ALF1 + DEL1 - HI = DEL1 - IF (HI <= TINY) HI = SQRT(AKW) ! If solution is neutral. - CLAQ = ALF2 - DEL1 - - RETURN - -! *** END OF SUBROUTINE CALCCLAQ2 **************************************** - - END SUBROUTINE CALCCLAQ2 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNIAQ - -! THIS SUBROUTINE CALCULATES THE HNO3(aq) GENERATED FROM (H,NO3-). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNIAQ (NO3I, HI, DELT) - INCLUDE 'isrpia.inc' - real :: NO3I, HI, DELT - -! *** EQUILIBRIUM CONSTANTS - - A42 = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1 - -! *** FIND ROOT - - OM1 = NO3I - OM2 = HI - BB =-(OM1+OM2+A42) - CC = OM1*OM2 - DD = SQRT(BB*BB-4.D0*CC) - - DEL1 = 0.5D0*(-BB - DD) - DEL2 = 0.5D0*(-BB + DD) - -! *** GET APPROPRIATE ROOT. - - IF (DEL1 < ZERO .OR. DEL1 > HI .OR. DEL1 > NO3I) THEN - print *, DELT - DELT = ZERO - ELSE - DELT = DEL1 - RETURN - ENDIF - - IF (DEL2 < ZERO .OR. DEL2 > NO3I .OR. DEL2 > HI) THEN - DELT = ZERO - ELSE - DELT = DEL2 - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCNIAQ **************************************** - - END SUBROUTINE CALCNIAQ - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCNIAQ2 - -! THIS SUBROUTINE CALCULATES THE UNDISSOCIATED HNO3(aq) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) - INCLUDE 'isrpia.inc' - real :: NO3I, NO3AQ - -! *** EQUILIBRIUM CONSTANTS - - A42 = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1 - AKW = XKW *RH*WATER*WATER - -! *** FIND ROOT - - ALF1 = NO3I - GGNO3 - ALF2 = GGNO3 - ALF3 = HI - - BB = ALF3 + ALF1 + A42 - CC = ALF3*ALF1 - A42*ALF2 - DEL1 = 0.5*(-BB + SQRT(BB*BB-4.D0*CC)) - -! *** CORRECT CONCENTRATIONS - - NO3I = ALF1 + DEL1 - HI = ALF3 + DEL1 - IF (HI <= TINY) HI = SQRT(AKW) ! If solution is neutral. - NO3AQ = ALF2 - DEL1 - - RETURN - -! *** END OF SUBROUTINE CALCNIAQ2 **************************************** - - END SUBROUTINE CALCNIAQ2 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCMR -! *** THIS SUBROUTINE CALCULATES: -! 1. ION PAIR CONCENTRATIONS (FROM [MOLAR] ARRAY) -! 2. WATER CONTENT OF LIQUID AEROSOL PHASE (FROM ZSR CORRELATION) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCMR - INCLUDE 'isrpia.inc' - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - - CHARACTER SC*1 - -! *** CALCULATE ION PAIR CONCENTRATIONS ACCORDING TO SPECIFIC CASE **** - - SC =SCASE(1:1) ! SULRAT & SODRAT case - -! *** NH4-SO4 SYSTEM ; SULFATE POOR CASE - - IF (SC == 'A') THEN - MOLALR(4) = MOLAL(5)+MOLAL(6) ! (NH4)2SO4 - CORRECT FOR SO4 TO HSO4 - - ! *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID - - ELSE IF (SC == 'B') THEN - SO4I = MOLAL(5)-MOLAL(1) ! CORRECT FOR HSO4 DISSOCIATION - HSO4I = MOLAL(6)+MOLAL(1) - IF (SO4I < HSO4I) THEN - MOLALR(13) = SO4I ! [LC] = [SO4] - MOLALR(9) = MAX(HSO4I-SO4I, ZERO) ! NH4HSO4 - ELSE - MOLALR(13) = HSO4I ! [LC] = [HSO4] - MOLALR(4) = MAX(SO4I-HSO4I, ZERO) ! (NH4)2SO4 - ENDIF - - ! *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; FREE ACID - - ELSE IF (SC == 'C') THEN - MOLALR(4) = MOLAL(3) ! NH4HSO4 - MOLALR(7) = MAX(W(2)-W(3), ZERO) ! H2SO4 - - ! *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE - - ELSE IF (SC == 'D') THEN - MOLALR(4) = MOLAL(5) + MOLAL(6) ! (NH4)2SO4 - AML5 = MOLAL(3)-2.D0*MOLALR(4) ! "free" NH4 - MOLALR(5) = MAX(MIN(AML5,MOLAL(7)), ZERO)! NH4NO3 = MIN("free", NO3) - - ! *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID - - ELSE IF (SC == 'E') THEN - SO4I = MAX(MOLAL(5)-MOLAL(1),ZERO) ! FROM HSO4 DISSOCIATION - HSO4I = MOLAL(6)+MOLAL(1) - IF (SO4I < HSO4I) THEN - MOLALR(13) = SO4I ! [LC] = [SO4] - MOLALR(9) = MAX(HSO4I-SO4I, ZERO) ! NH4HSO4 - ELSE - MOLALR(13) = HSO4I ! [LC] = [HSO4] - MOLALR(4) = MAX(SO4I-HSO4I, ZERO) ! (NH4)2SO4 - ENDIF - - ! *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; FREE ACID - - ELSE IF (SC == 'F') THEN - MOLALR(4) = MOLAL(3) ! NH4HSO4 - MOLALR(7) = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3),ZERO) ! H2SO4 - - ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM POOR CASE - - ELSE IF (SC == 'G') THEN - MOLALR(2) = 0.5D0*MOLAL(2) ! NA2SO4 - TOTS4 = MOLAL(5)+MOLAL(6) ! Total SO4 - MOLALR(4) = MAX(TOTS4 - MOLALR(2), ZERO) ! (NH4)2SO4 - FRNH4 = MAX(MOLAL(3) - 2.D0*MOLALR(4), ZERO) - MOLALR(5) = MIN(MOLAL(7),FRNH4) ! NH4NO3 - FRNH4 = MAX(FRNH4 - MOLALR(5), ZERO) - MOLALR(6) = MIN(MOLAL(4), FRNH4) ! NH4CL - - ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM RICH CASE - ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ - - ELSE IF (SC == 'H') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(3) = PSI8 ! NANO3 - MOLALR(4) = ZERO ! (NH4)2SO4 - FRNO3 = MAX(MOLAL(7) - MOLALR(3), ZERO) ! "FREE" NO3 - FRCL = MAX(MOLAL(4) - MOLALR(1), ZERO) ! "FREE" CL - MOLALR(5) = MIN(MOLAL(3),FRNO3) ! NH4NO3 - FRNH4 = MAX(MOLAL(3) - MOLALR(5), ZERO) ! "FREE" NH3 - MOLALR(6) = MIN(FRCL, FRNH4) ! NH4CL - - ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; NO FREE ACID - ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ - - ELSE IF (SC == 'I') THEN - MOLALR(04) = PSI5 ! (NH4)2SO4 - MOLALR(02) = PSI4 ! NA2SO4 - MOLALR(09) = PSI1 ! NH4HSO4 - MOLALR(12) = PSI3 ! NAHSO4 - MOLALR(13) = PSI2 ! LC - - ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; FREE ACID - - ELSE IF (SC == 'J') THEN - MOLALR(09) = MOLAL(3) ! NH4HSO4 - MOLALR(12) = MOLAL(2) ! NAHSO4 - MOLALR(07) = MOLAL(5)+MOLAL(6)-MOLAL(3)-MOLAL(2) ! H2SO4 - MOLALR(07) = MAX(MOLALR(07),ZERO) - - ! *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA POOR CASE - - ELSE IF (SC == 'O') THEN - MOLALR(2) = 0.5D0*MOLAL(2) ! NA2SO4 - TOTS4 = MOLAL(5)+MOLAL(6) ! Total SO4 - MOLALR(17)= 0.5*MOLAL(9) ! K2SO4 - MOLALR(21)= MOLAL(10) ! MGSO4 - MOLALR(4) = MAX(TOTS4 - MOLALR(2) - MOLALR(17) & - - MOLALR(21), ZERO) ! (NH4)2SO4 - FRNH4 = MAX(MOLAL(3) - 2.D0*MOLALR(4), ZERO) - MOLALR(5) = MIN(MOLAL(7),FRNH4) ! NH4NO3 - FRNH4 = MAX(FRNH4 - MOLALR(5), ZERO) - MOLALR(6) = MIN(MOLAL(4), FRNH4) ! NH4CL - - ! *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA RICH; CR POOR CASE - ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ - - ELSE IF (SC == 'M') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(3) = PSI8 ! NANO3 - MOLALR(4) = ZERO ! (NH4)2SO4 - FRNO3 = MAX(MOLAL(7) - MOLALR(3), ZERO) ! "FREE" NO3 - FRCL = MAX(MOLAL(4) - MOLALR(1), ZERO) ! "FREE" CL - MOLALR(5) = MIN(MOLAL(3),FRNO3) ! NH4NO3 - FRNH4 = MAX(MOLAL(3) - MOLALR(5), ZERO) ! "FREE" NH3 - MOLALR(6) = MIN(FRCL, FRNH4) ! NH4CL - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(21)= PSI10 ! MGSO4 - - ! *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE POOR ; CR+NA RICH; CR RICH CASE - ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ - - ELSE IF (SC == 'P') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(3) = PSI8 ! NANO3 - MOLALR(15)= PSI12 ! CANO32 - MOLALR(16)= PSI17 ! CACL2 - MOLALR(19)= PSI13 ! KNO3 - MOLALR(20)= PSI14 ! KCL - MOLALR(22)= PSI15 ! MGNO32 - MOLALR(23)= PSI16 ! MGCL2 - FRNO3 = MAX(MOLAL(7)-MOLALR(3)-2.D0*MOLALR(15) & - -MOLALR(19)-2.D0*MOLALR(22), ZERO) ! "FREE" NO3 - FRCL = MAX(MOLAL(4)-MOLALR(1)-2.D0*MOLALR(16) & - -MOLALR(20)-2.D0*MOLALR(23), ZERO) ! "FREE" CL - MOLALR(5) = MIN(MOLAL(3),FRNO3) ! NH4NO3 - FRNH4 = MAX(MOLAL(3) - MOLALR(5), ZERO) ! "FREE" NH3 - MOLALR(6) = MIN(FRCL, FRNH4) ! NH4CL - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(21)= PSI10 ! MGSO4 - - ! *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE RICH CASE ; NO FREE ACID - - ELSE IF (SC == 'L') THEN - MOLALR(04) = PSI5 ! (NH4)2SO4 - MOLALR(02) = PSI4 ! NA2SO4 - MOLALR(09) = PSI1 ! NH4HSO4 - MOLALR(12) = PSI3 ! NAHSO4 - MOLALR(13) = PSI2 ! LC - MOLALR(17) = PSI6 ! K2SO4 - MOLALR(21) = PSI7 ! MGSO4 - MOLALR(18) = PSI8 ! KHSO4 - - ! *** NA-NH4-SO4-NO3-CL-CA-K-MG SYSTEM ; SULFATE SUPER RICH CASE ; FREE ACID - - ELSE IF (SC == 'K') THEN - MOLALR(09) = MOLAL(3) ! NH4HSO4 - MOLALR(12) = MOLAL(2) ! NAHSO4 - MOLALR(14) = MOLAL(8) ! CASO4 - MOLALR(18) = MOLAL(9) ! KHSO4 - MOLALR(21) = MOLAL(10) ! MGSO4 - MOLALR(07) = MOLAL(5)+MOLAL(6)-MOLAL(3) & - -MOLAL(2)-MOLAL(8)-MOLAL(9)-MOLAL(10) ! H2SO4 - MOLALR(07) = MAX(MOLALR(07),ZERO) - - ! ======= REVERSE PROBLEMS =========================================== - - ! *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE - - ELSE IF (SC == 'N') THEN - MOLALR(4) = MOLAL(5) + MOLAL(6) ! (NH4)2SO4 - AML5 = WAER(3)-2.D0*MOLALR(4) ! "free" NH4 - MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO) ! NH4NO3 = MIN("free", NO3) - - ! *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM POOR CASE - - ELSE IF (SC == 'Q') THEN - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(4) = PSI6 ! (NH4)2SO4 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - - ! *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM RICH CASE - - ELSE IF (SC == 'R') THEN - MOLALR(1) = PSI3 ! NACL - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(3) = PSI2 ! NANO3 - MOLALR(4) = ZERO ! (NH4)2SO4 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - - ! *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM POOR CASE - - ELSE IF (SC == 'V') THEN - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(4) = PSI6 ! (NH4)2SO4 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - MOLALR(17)= PSI7 ! K2SO4 - MOLALR(21)= PSI8 ! MGSO4 - - ! *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM RICH, CRUSTAL POOR CASE - - ELSE IF (SC == 'U') THEN - MOLALR(1) = PSI3 ! NACL - MOLALR(2) = PSI1 ! NA2SO4 - MOLALR(3) = PSI2 ! NANO3 - MOLALR(5) = PSI5 ! NH4NO3 - MOLALR(6) = PSI4 ! NH4CL - MOLALR(17)= PSI7 ! K2SO4 - MOLALR(21)= PSI8 ! MGSO4 - - ! *** NH4-SO4-NO3-NA-CL-CA-K-MG SYSTEM ; SULFATE POOR, CRUSTAL&SODIUM RICH, CRUSTAL RICH CASE - - ELSE IF (SC == 'W') THEN - MOLALR(1) = PSI7 ! NACL - MOLALR(3) = PSI8 ! NANO3 - MOLALR(5) = PSI6 ! NH4NO3 - MOLALR(6) = PSI5 ! NH4CL - MOLALR(15)= PSI12 ! CANO32 - MOLALR(16)= PSI17 ! CACL2 - MOLALR(17)= PSI9 ! K2SO4 - MOLALR(19)= PSI13 ! KNO3 - MOLALR(20)= PSI14 ! KCL - MOLALR(21)= PSI10 ! MGSO4 - MOLALR(22)= PSI15 ! MGNO32 - MOLALR(23)= PSI16 ! MGCL2 - - ! *** UNKNOWN CASE - - ! ELSE - ! CALL PUSHERR (1001, ' ') ! FATAL ERROR: CASE NOT SUPPORTED - ENDIF - -! *** CALCULATE WATER CONTENT ; ZSR CORRELATION *********************** - - WATER = ZERO - DO 10 I=1,NPAIR - WATER = WATER + MOLALR(I)/M0(I) - 10 END DO - WATER = MAX(WATER, TINY) - - RETURN - -! *** END OF SUBROUTINE CALCMR ****************************************** - - END SUBROUTINE CALCMR - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCMDRH - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE -! 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCMDRH (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) - INCLUDE 'isrpia.inc' - EXTERNAL DRYCASE, LIQCASE - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ONE - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CALL DRYCASE - IF (ABS(ONEMWF) <= 1D-5) GOTO 200 ! DRY AEROSOL - - CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION - CNH4HSO = CNH4HS4 - CLCO = CLC - CNH4N3O = CNH4NO3 - CNH4CLO = CNH4CL - CNA2SO = CNA2SO4 - CNAHSO = CNAHSO4 - CNANO = CNANO3 - CNACLO = CNACL - GNH3O = GNH3 - GHNO3O = GHNO3 - GHCLO = GHCL - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CNH42S4 = ZERO - CNH4HS4 = ZERO - CLC = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CNAHSO4 = ZERO - CNANO3 = ZERO - CNACL = ZERO - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - CALL LIQCASE ! SECOND (LIQUID) SOLUTION - -! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL - - IF (WATER <= TINY) THEN - DO 100 I=1,NIONS - MOLAL(I)= ZERO ! Aqueous phase - 100 END DO - WATER = ZERO - - CNH42S4 = CNH42SO ! Solid phase - CNA2SO4 = CNA2SO - CNAHSO4 = CNAHSO - CNH4HS4 = CNH4HSO - CLC = CLCO - CNH4NO3 = CNH4N3O - CNANO3 = CNANO - CNACL = CNACLO - CNH4CL = CNH4CLO - - GNH3 = GNH3O ! Gas phase - GHNO3 = GHNO3O - GHCL = GHCLO - - GOTO 200 - ENDIF - -! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMSUL = CNH42SO - CNH42S4 - DSOSUL = CNA2SO - CNA2SO4 - DAMBIS = CNH4HSO - CNH4HS4 - DSOBIS = CNAHSO - CNAHSO4 - DLC = CLCO - CLC - DAMNIT = CNH4N3O - CNH4NO3 - DAMCHL = CNH4CLO - CNH4CL - DSONIT = CNANO - CNANO3 - DSOCHL = CNACLO - CNACL - -! *** FIND GAS DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMG = GNH3O - GNH3 - DHAG = GHCLO - GHCL - DNAG = GHNO3O - GHNO3 - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - -! LIQUID - - MOLAL(1)= ONEMWF*MOLAL(1) ! H+ - MOLAL(2)= ONEMWF*(2.D0*DSOSUL + DSOBIS + DSONIT + DSOCHL) ! NA+ - MOLAL(3)= ONEMWF*(2.D0*DAMSUL + DAMG + DAMBIS + DAMCHL + & - & 3.D0*DLC + DAMNIT ) ! NH4+ - MOLAL(4)= ONEMWF*( DAMCHL + DSOCHL + DHAG) ! CL- - MOLAL(5)= ONEMWF*( DAMSUL + DSOSUL + DLC - MOLAL(6)) ! SO4-- !VB 17 Sept 2001 - MOLAL(6)= ONEMWF*( MOLAL(6) + DSOBIS + DAMBIS + DLC) ! HSO4- - MOLAL(7)= ONEMWF*( DAMNIT + DSONIT + DNAG) ! NO3- - WATER = ONEMWF*WATER - -! SOLID - - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 - CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 - CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 - CLC = WF*CLCO + ONEMWF*CLC - CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 - CNANO3 = WF*CNANO + ONEMWF*CNANO3 - CNACL = WF*CNACLO + ONEMWF*CNACL - CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL - -! GAS - - GNH3 = WF*GNH3O + ONEMWF*GNH3 - GHNO3 = WF*GHNO3O + ONEMWF*GHNO3 - GHCL = WF*GHCLO + ONEMWF*GHCL - -! *** RETURN POINT - - 200 RETURN - -! *** END OF SUBROUTINE CALCMDRH **************************************** - - END SUBROUTINE CALCMDRH - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCMDRH2 - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE -! 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCMDRH2 (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) - INCLUDE 'isrpia.inc' - EXTERNAL DRYCASE, LIQCASE - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ONE - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CALL DRYCASE - IF (ABS(ONEMWF) <= 1D-5) GOTO 200 ! DRY AEROSOL - - CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION - CNH4HSO = CNH4HS4 - CLCO = CLC - CNH4N3O = CNH4NO3 - CNH4CLO = CNH4CL - CNA2SO = CNA2SO4 - CNAHSO = CNAHSO4 - CNANO = CNANO3 - CNACLO = CNACL - GNH3O = GNH3 - GHNO3O = GHNO3 - GHCLO = GHCL - - CCASO = CCASO4 - CK2SO = CK2SO4 - CMGSO = CMGSO4 - CKHSO = CKHSO4 - CCAN32O = CCANO32 - CCAC2L = CCACL2 - CKN3O = CKNO3 - CKCLO = CKCL - CMGN32O = CMGNO32 - CMGC2L = CMGCL2 - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CNH42S4 = ZERO - CNH4HS4 = ZERO - CLC = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CNAHSO4 = ZERO - CNANO3 = ZERO - CNACL = ZERO - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - CCASO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = ZERO - CCANO32 = ZERO - CCACL2 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - - CALL LIQCASE ! SECOND (LIQUID) SOLUTION - -! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL - - IF (WATER <= TINY) THEN - DO 100 I=1,NIONS - MOLAL(I)= ZERO ! Aqueous phase - 100 END DO - WATER = ZERO - - CNH42S4 = CNH42SO ! Solid phase - CNA2SO4 = CNA2SO - CNAHSO4 = CNAHSO - CNH4HS4 = CNH4HSO - CLC = CLCO - CNH4NO3 = CNH4N3O - CNANO3 = CNANO - CNACL = CNACLO - CNH4CL = CNH4CLO - - GNH3 = GNH3O ! Gas phase - GHNO3 = GHNO3O - GHCL = GHCLO - - CCASO4 = CCASO - CK2SO4 = CK2SO - CMGSO4 = CMGSO - CKHSO4 = CKHSO - CCANO32 = CCAN32O - CCACL2 = CCAC2L - CKNO3 = CKN3O - CKCL = CKCLO - CMGNO32 = CMGN32O - CMGCL2 = CMGC2L - - GOTO 200 - ENDIF - -! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMSUL = CNH42SO - CNH42S4 - DSOSUL = CNA2SO - CNA2SO4 - DAMBIS = CNH4HSO - CNH4HS4 - DSOBIS = CNAHSO - CNAHSO4 - DLC = CLCO - CLC - DAMNIT = CNH4N3O - CNH4NO3 - DAMCHL = CNH4CLO - CNH4CL - DSONIT = CNANO - CNANO3 - DSOCHL = CNACLO - CNACL - - DCASUL = CCASO - CCASO4 - DPOSUL = CK2SO - CK2SO4 - DMGSUL = CMGSO - CMGSO4 - DPOBIS = CKHSO - CKHSO4 - DCANIT = CCAN32O - CCANO32 - DCACHL = CCAC2L - CCACL2 - DPONIT = CKN3O - CKNO3 - DPOCHL = CKCLO - CKCL - DMGNIT = CMGN32O - CMGNO32 - DMGCHL = CMGC2L - CMGCL2 - -! *** FIND GAS DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMG = GNH3O - GNH3 - DHAG = GHCLO - GHCL - DNAG = GHNO3O - GHNO3 - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - -! LIQUID - - MOLAL(1) = ONEMWF*MOLAL(1) ! H+ - MOLAL(2) = ONEMWF*(2.D0*DSOSUL + DSOBIS + DSONIT + DSOCHL) ! NA+ - MOLAL(3) = ONEMWF*(2.D0*DAMSUL + DAMG + DAMBIS + DAMCHL + & - & 3.D0*DLC + DAMNIT ) ! NH4+ - MOLAL(4) = ONEMWF*(DAMCHL + DSOCHL + DHAG + 2.D0*DCACHL + & - & 2.D0*DMGCHL + DPOCHL) ! CL- - MOLAL(5) = ONEMWF*(DAMSUL + DSOSUL + DLC - MOLAL(6) & - +DCASUL + DPOSUL + DMGSUL) ! SO4-- !VB 17 Sept 2001 - MOLAL(6) = ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC + DPOBIS) ! HSO4- - MOLAL(7) = ONEMWF*(DAMNIT + DSONIT + DNAG + 2.D0*DCANIT & - + 2.D0*DMGNIT + DPONIT) ! NO3- - MOLAL(8) = ONEMWF*(DCASUL + DCANIT + DCACHL) ! CA2+ - MOLAL(9) = ONEMWF*(2.D0*DPOSUL + DPONIT + DPOCHL + DPOBIS) ! K+ - MOLAL(10)= ONEMWF*(DMGSUL + DMGNIT + DMGCHL) ! MG2+ - WATER = ONEMWF*WATER - -! SOLID - - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 - CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 - CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 - CLC = WF*CLCO + ONEMWF*CLC - CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 - CNANO3 = WF*CNANO + ONEMWF*CNANO3 - CNACL = WF*CNACLO + ONEMWF*CNACL - CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL - - CCASO4 = WF*CCASO + ONEMWF*CCASO4 - CK2SO4 = WF*CK2SO + ONEMWF*CK2SO4 - CMGSO4 = WF*CMGSO + ONEMWF*CMGSO4 - CKHSO4 = WF*CKHSO + ONEMWF*CKHSO4 - CCANO32 = WF*CCAN32O + ONEMWF*CCANO32 - CCACL2 = WF*CCAC2L + ONEMWF*CCACL2 - CMGNO32 = WF*CMGN32O + ONEMWF*CMGNO32 - CMGCL2 = WF*CMGC2L + ONEMWF*CMGCL2 - CKCL = WF*CKCLO + ONEMWF*CKCL - -! GAS - - GNH3 = WF*GNH3O + ONEMWF*GNH3 - GHNO3 = WF*GHNO3O + ONEMWF*GHNO3 - GHCL = WF*GHCLO + ONEMWF*GHCL - -! *** RETURN POINT - - 200 RETURN - -! *** END OF SUBROUTINE CALCMDRH2 **************************************** - - END SUBROUTINE CALCMDRH2 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCMDRP - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE -! 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). (REVERSE PROBLEM) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCMDRP (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) - INCLUDE 'isrpia.inc' - EXTERNAL DRYCASE, LIQCASE - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ONE - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CALL DRYCASE - IF (ABS(ONEMWF) <= 1D-5) GOTO 200 ! DRY AEROSOL - - CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION - CNH4HSO = CNH4HS4 - CLCO = CLC - CNH4N3O = CNH4NO3 - CNH4CLO = CNH4CL - CNA2SO = CNA2SO4 - CNAHSO = CNAHSO4 - CNANO = CNANO3 - CNACLO = CNACL - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CNH42S4 = ZERO - CNH4HS4 = ZERO - CLC = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CNAHSO4 = ZERO - CNANO3 = ZERO - CNACL = ZERO - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - CALL LIQCASE ! SECOND (LIQUID) SOLUTION - -! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL - - IF (WATER <= TINY) THEN - WATER = ZERO - DO 100 I=1,NIONS - MOLAL(I)= ZERO - 100 END DO - CALL DRYCASE - GOTO 200 - ENDIF - -! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMBIS = CNH4HSO - CNH4HS4 - DSOBIS = CNAHSO - CNAHSO4 - DLC = CLCO - CLC - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - -! *** SOLID - - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 - CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 - CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 - CLC = WF*CLCO + ONEMWF*CLC - CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 - CNANO3 = WF*CNANO + ONEMWF*CNANO3 - CNACL = WF*CNACLO + ONEMWF*CNACL - CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL - -! *** LIQUID - - WATER = ONEMWF*WATER - - MOLAL(2)= WAER(1) - 2.D0*CNA2SO4 - CNAHSO4 - CNANO3 - & - CNACL ! NA+ - MOLAL(3)= WAER(3) - 2.D0*CNH42S4 - CNH4HS4 - CNH4CL - & - & 3.D0*CLC - CNH4NO3 ! NH4+ - MOLAL(4)= WAER(5) - CNACL - CNH4CL ! CL- - MOLAL(7)= WAER(4) - CNANO3 - CNH4NO3 ! NO3- - MOLAL(6)= ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC) ! HSO4- - MOLAL(5)= WAER(2) - MOLAL(6) - CLC - CNH42S4 - CNA2SO4 ! SO4-- - - A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - IF (MOLAL(5) <= TINY) THEN - HIEQ = SQRT(XKW *RH*WATER*WATER) ! Neutral solution - ELSE - HIEQ = A8*MOLAL(6)/MOLAL(5) - ENDIF - HIEN = MOLAL(4) + MOLAL(7) + MOLAL(6) + 2.D0*MOLAL(5) - & - MOLAL(2) - MOLAL(3) - MOLAL(1)= MAX (HIEQ, HIEN) ! H+ - -! *** GAS (ACTIVITY COEFS FROM LIQUID SOLUTION) - - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = MOLAL(3)/MAX(MOLAL(1),TINY)/A2 - GHNO3 = MOLAL(1)*MOLAL(7)/A3 - GHCL = MOLAL(1)*MOLAL(4)/A4 - - 200 RETURN - -! *** END OF SUBROUTINE CALCMDRP **************************************** - - END SUBROUTINE CALCMDRP - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCMDRPII - -! THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL -! DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED -! SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE -! 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). (REVERSE PROBLEM) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCMDRPII (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) - INCLUDE 'isrpia.inc' - EXTERNAL DRYCASE, LIQCASE - -! *** FIND WEIGHT FACTOR ********************************************** - - IF (WFTYP == 0) THEN - WF = ONE - ELSEIF (WFTYP == 1) THEN - WF = 0.5D0 - ELSE - WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) - ENDIF - ONEMWF = ONE - WF - -! *** FIND FIRST SECTION ; DRY ONE ************************************ - - CALL DRYCASE - IF (ABS(ONEMWF) <= 1D-5) GOTO 200 ! DRY AEROSOL - - CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION - CNH4HSO = CNH4HS4 - CLCO = CLC - CNH4N3O = CNH4NO3 - CNH4CLO = CNH4CL - CNA2SO = CNA2SO4 - CNAHSO = CNAHSO4 - CNANO = CNANO3 - CNACLO = CNACL - - CCASO = CCASO4 - CK2SO = CK2SO4 - CMGSO = CMGSO4 - CKHSO = CKHSO4 - CCAN32O = CCANO32 - CCAC2L = CCACL2 - CKN3O = CKNO3 - CKCLO = CKCL - CMGN32O = CMGNO32 - CMGC2L = CMGCL2 - -! *** FIND SECOND SECTION ; DRY & LIQUID ****************************** - - CNH42S4 = ZERO - CNH4HS4 = ZERO - CLC = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CNAHSO4 = ZERO - CNANO3 = ZERO - CNACL = ZERO - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - CCASO4 = ZERO - CK2SO4 = ZERO - CMGSO4 = ZERO - CKHSO4 = ZERO - CCANO32 = ZERO - CCACL2 = ZERO - CKNO3 = ZERO - CKCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - - CALL LIQCASE ! SECOND (LIQUID) SOLUTION - -! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL - - IF (WATER <= TINY) THEN - WATER = ZERO - DO 100 I=1,NIONS - MOLAL(I)= ZERO - 100 END DO - CALL DRYCASE - GOTO 200 - ENDIF - -! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. - - DAMBIS = CNH4HSO - CNH4HS4 - DSOBIS = CNAHSO - CNAHSO4 - DLC = CLCO - CLC - DPOBIS = CKHSO - CKHSO4 - -! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. - -! *** SOLID - - CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 - CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 - CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 - CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 - CLC = WF*CLCO + ONEMWF*CLC - CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 - CNANO3 = WF*CNANO + ONEMWF*CNANO3 - CNACL = WF*CNACLO + ONEMWF*CNACL - CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL - - CCASO4 = WF*CCASO + ONEMWF*CCASO4 - CK2SO4 = WF*CK2SO + ONEMWF*CK2SO4 - CMGSO4 = WF*CMGSO + ONEMWF*CMGSO4 - CKHSO4 = WF*CKHSO + ONEMWF*CKHSO4 - CCANO32 = WF*CCAN32O + ONEMWF*CCANO32 - CCACL2 = WF*CCAC2L + ONEMWF*CCACL2 - CMGNO32 = WF*CMGN32O + ONEMWF*CMGNO32 - CMGCL2 = WF*CMGC2L + ONEMWF*CMGCL2 - CKCL = WF*CKCLO + ONEMWF*CKCL - -! *** LIQUID - - WATER = ONEMWF*WATER - - MOLAL(2)= WAER(1) - 2.D0*CNA2SO4 - CNAHSO4 - CNANO3 - & - CNACL ! NA+ - MOLAL(3)= WAER(3) - 2.D0*CNH42S4 - CNH4HS4 - CNH4CL - & - & 3.D0*CLC - CNH4NO3 ! NH4+ - MOLAL(4)= WAER(5) - CNACL - CNH4CL - 2.D0*CCACL2 - & - & 2.D0*CMGCL2 - CKCL ! CL- - MOLAL(7)= WAER(4) - CNANO3 - CNH4NO3 - CKNO3 & - - 2.D0*CCANO32 - 2.D0*CMGNO32 ! NO3- - MOLAL(6)= ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC + DPOBIS) ! HSO4- - MOLAL(5)= WAER(2) - MOLAL(6) - CLC - CNH42S4 - CNA2SO4 & - - CCASO4 - CK2SO4 - CMGSO4 ! SO4-- - MOLAL(8)= WAER(6) - CCASO4 - CCANO32 - CCACL2 ! CA++ - MOLAL(9)= WAER(7) - 2.D0*CK2SO4 - CKNO3 - CKCL - CKHSO4 ! K+ - MOLAL(10)=WAER(8) - CMGSO4 - CMGNO32 - CMGCL2 ! MG++ - - A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - IF (MOLAL(5) <= TINY) THEN - HIEQ = SQRT(XKW *RH*WATER*WATER) ! Neutral solution - ELSE - HIEQ = A8*MOLAL(6)/MOLAL(5) - ENDIF - HIEN = MOLAL(4) + MOLAL(7) + MOLAL(6) + 2.D0*MOLAL(5) - & - MOLAL(2) - MOLAL(3) - MOLAL(1)= MAX (HIEQ, HIEN) ! H+ - -! *** GAS (ACTIVITY COEFS FROM LIQUID SOLUTION) - - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = MOLAL(3)/MAX(MOLAL(1),TINY)/A2 - GHNO3 = MOLAL(1)*MOLAL(7)/A3 - GHCL = MOLAL(1)*MOLAL(4)/A4 - - 200 RETURN - -! *** END OF SUBROUTINE CALCMDRPII ************************************** - - END SUBROUTINE CALCMDRPII - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCHS4 -! *** THIS SUBROUTINE CALCULATES THE HSO4 GENERATED FROM (H,SO4). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCHS4 (HI, SO4I, HSO4I, DELTA) - INCLUDE 'isrpia.inc' -!C CHARACTER ERRINF*40 - -! *** IF TOO LITTLE WATER, DONT SOLVE - - IF (WATER <= 1d1*TINY) THEN - DELTA = ZERO - RETURN - ENDIF - -! *** CALCULATE HSO4 SPECIATION ***************************************** - - A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. - - BB =-(HI + SO4I + A8) - CC = HI*SO4I - HSO4I*A8 - DD = BB*BB - 4.D0*CC - - IF (DD >= ZERO) THEN - SQDD = SQRT(DD) - DELTA1 = 0.5*(-BB + SQDD) - DELTA2 = 0.5*(-BB - SQDD) - IF (HSO4I <= TINY) THEN - DELTA = DELTA2 - ELSEIF( HI*SO4I >= A8*HSO4I ) THEN - DELTA = DELTA2 - ELSEIF( HI*SO4I < A8*HSO4I ) THEN - DELTA = DELTA1 - ELSE - DELTA = ZERO - ENDIF - ELSE - DELTA = ZERO - ENDIF -! C -! C *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT OF HSO4 *************** -! C -!C HYD = MAX(HI, MOLAL(1)) -!C IF (HYD.GT.TINY) THEN -!C IF (DELTA/HYD.GT.0.1d0) THEN -!C WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0 -!C CALL PUSHERR (0020, ERRINF) -!C ENDIF -!C ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCHS4 ***************************************** - - END SUBROUTINE CALCHS4 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCPH - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE CALCPH (GG, HI, OHI) - INCLUDE 'isrpia.inc' - - AKW = XKW *RH*WATER*WATER - CN = SQRT(AKW) - -! *** GG = (negative charge) - (positive charge) - - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = MAX(0.5D0*(-BB + SQRT(DD)),CN) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= MAX(0.5D0*(-BB + SQRT(DD)),CN) - HI = AKW/OHI - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCPH ****************************************** - - END SUBROUTINE CALCPH - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCACT -! *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -! METHOD. THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -! KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCACT - INCLUDE 'isrpia.inc' - - COMMON /DRVINP/ WI(8), RHI, TEMPI, IPROBI, METSTBLI, IACALCI, & - NADJI - - IF (W(1)+W(4)+W(5)+W(6)+W(7)+W(8) <= TINY) THEN !Ca,K,Mg,Na,Cl,NO3=0 - CALL CALCACT1 - ELSE IF (W(1)+W(5)+W(6)+W(7)+W(8) <= TINY) THEN !Ca,K,Mg,Na,Cl=0 - CALL CALCACT2 - ELSE IF (W(6)+W(7)+W(8) <= TINY) THEN !Ca,K,Mg=0 - CALL CALCACT3 - ELSE - CALL CALCACT4 - ENDIF - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE CALCACT - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCACT4 -! *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -! METHOD FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -! AEROSOL SYSTEM. THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -! KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL4). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCACT4 - INCLUDE 'isrpia.inc' - - REAL :: EX10 - REAL :: G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(6),F2A(4),F2B(4) - real :: MPL, XIJ, YJI - DATA G0/24*0D0/ - - - GA(I,J)= (F1(I)/Z(I) + F2A(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H - GB(I,J)= (F1(I)/Z(I+4) + F2B(J)/Z(J+3)) / (Z(I+4)+Z(J+3)) - H - -! *** SAVE ACTIVITIES IN OLD ARRAY ************************************* - - IF (FRST) THEN ! Outer loop - DO 10 I=1,NPAIR - GAMOU(I) = GAMA(I) - 10 END DO - ENDIF - - DO 20 I=1,NPAIR ! Inner loop - GAMIN(I) = GAMA(I) - 20 END DO - -! *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** - - IONIC=0.0 - DO 30 I=1,NIONS - IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) - 30 END DO - IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) - -! *** CALCULATE BINARY ACTIVITY COEFFICIENTS *************************** - -! G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02 -! G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05 - - IF (IACALC == 0) THEN ! K.M.; FULL - CALL KMFUL4 (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3),G0(4,4),G0(4,1),G0(5,2), & - G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ELSE ! K.M.; TABULATED - CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3),G0(4,4),G0(4,1),G0(5,2), & - G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ENDIF - -! *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS ******************* - - AGAMA = 0.511*(298.0/TEMP)**1.5 ! Debye Huckel const. at T - SION = SQRT(IONIC) - H = AGAMA*SION/(1+SION) - - DO 100 I=1,4 - F1(I)=0.0 - F2A(I)=0.0 - F2B(I)=0.0 - 100 END DO - F1(5)=0.0 - F1(6)=0.0 - - DO 110 I=1,3 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=1,4 - ZMI = Z(J+3) - CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC - XIJ = CH*MPL - YJI = CH*MOLAL(J+3)/WATER - F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) - F2A(J) = F2A(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) - 110 END DO - - DO 330 I=4,6 - ZPL = Z(I+4) - MPL = MOLAL(I+4)/WATER - DO 330 J=1,4 - ZMI = Z(J+3) - IF (J == 3) THEN - IF (I == 4 .OR. I == 6) THEN - GO TO 330 - ENDIF - ENDIF - CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC - XIJ = CH*MPL - YJI = CH*MOLAL(J+3)/WATER - F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) - F2B(J) = F2B(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) - 330 END DO - - -! *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** - - GAMA(01) = GA(2,1)*ZZ(01) ! NACL - GAMA(02) = GA(2,2)*ZZ(02) ! NA2SO4 - GAMA(03) = GA(2,4)*ZZ(03) ! NANO3 - GAMA(04) = GA(3,2)*ZZ(04) ! (NH4)2SO4 - GAMA(05) = GA(3,4)*ZZ(05) ! NH4NO3 - GAMA(06) = GA(3,1)*ZZ(06) ! NH4CL - GAMA(07) = GA(1,2)*ZZ(07) ! 2H-SO4 - GAMA(08) = GA(1,3)*ZZ(08) ! H-HSO4 - GAMA(09) = GA(3,3)*ZZ(09) ! NH4HSO4 - GAMA(10) = GA(1,4)*ZZ(10) ! HNO3 - GAMA(11) = GA(1,1)*ZZ(11) ! HCL - GAMA(12) = GA(2,3)*ZZ(12) ! NAHSO4 - GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09)) ! LC ; SCAPE -!C GAMA(13) = 0.50*(GAMA(04)+GAMA(09)) ! LC ; SEQUILIB -!C GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07)) ! LC ; AIM - GAMA(14) = 0.0d0 ! CASO4 - GAMA(15) = GB(4,4)*ZZ(15) ! CA(NO3)2 - GAMA(16) = GB(4,1)*ZZ(16) ! CACL2 - GAMA(17) = GB(5,2)*ZZ(17) ! K2SO4 - GAMA(18) = GB(5,3)*ZZ(18) ! KHSO4 - GAMA(19) = GB(5,4)*ZZ(19) ! KNO3 - GAMA(20) = GB(5,1)*ZZ(20) ! KCL - GAMA(21) = GB(6,2)*ZZ(21) ! MGSO4 - GAMA(22) = GB(6,4)*ZZ(22) ! MG(NO3)2 - GAMA(23) = GB(6,1)*ZZ(23) ! MGCL2 - -! *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA ************************** - - DO 200 I=1,NPAIR - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) - !C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] - 200 END DO - -! *** SETUP ACTIVITY CALCULATION FLAGS ******************************** - -! OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE. - - IF (FRST) THEN - ERROU = ZERO ! CONVERGENCE CRITERION - DO 210 I=1,NPAIR - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) - 210 END DO - CALAOU = ERROU >= EPSACT ! SETUP FLAGS - FRST = .FALSE. - ENDIF - -! INNER CALCULATION LOOP ; ALWAYS - - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=1,NPAIR - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) - 220 END DO - CALAIN = ERRIN >= EPSACT - - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter - -! *** END OF SUBROUTINE ACTIVITY **************************************** - - RETURN - END SUBROUTINE CALCACT4 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCACT3 -! *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -! METHOD FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. -! THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -! KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL3). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCACT3 - INCLUDE 'isrpia.inc' - - REAL :: EX10, URF - REAL :: G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - real :: MPL, XIJ, YJI - PARAMETER (URF=0.5) -! PARAMETER (LN10=2.30258509299404568402D0) - - G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H - -! *** SAVE ACTIVITIES IN OLD ARRAY ************************************* - - IF (FRST) THEN ! Outer loop - DO 10 I=1,13 - GAMOU(I) = GAMA(I) - 10 END DO - ENDIF - - DO 20 I=1,13 ! Inner loop - GAMIN(I) = GAMA(I) - 20 END DO - -! *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** - - IONIC=0.0 - DO 30 I=1,7 - IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) - 30 END DO - IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) - -! *** CALCULATE BINARY ACTIVITY COEFFICIENTS *************************** - -! G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02 -! G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05 - - IF (IACALC == 0) THEN ! K.M.; FULL - CALL KMFUL3 (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3)) - ELSE ! K.M.; TABULATED - CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3),G0(4,4),G0(4,1),G0(5,2), & - G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ENDIF - -! *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS ******************* - - AGAMA = 0.511*(298.0/TEMP)**1.5 ! Debye Huckel const. at T - SION = SQRT(IONIC) - H = AGAMA*SION/(1+SION) - - DO 100 I=1,3 - F1(I)=0.0 - F2(I)=0.0 - 100 END DO - F2(4)=0.0 - - DO 110 I=1,3 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=1,4 - ZMI = Z(J+3) - CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC - XIJ = CH*MPL - YJI = CH*MOLAL(J+3)/WATER - F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) - F2(J) = F2(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) - 110 END DO - -! *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** - - GAMA(01) = G(2,1)*ZZ(01) ! NACL - GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 - GAMA(03) = G(2,4)*ZZ(03) ! NANO3 - GAMA(04) = G(3,2)*ZZ(04) ! (NH4)2SO4 - GAMA(05) = G(3,4)*ZZ(05) ! NH4NO3 - GAMA(06) = G(3,1)*ZZ(06) ! NH4CL - GAMA(07) = G(1,2)*ZZ(07) ! 2H-SO4 - GAMA(08) = G(1,3)*ZZ(08) ! H-HSO4 - GAMA(09) = G(3,3)*ZZ(09) ! NH4HSO4 - GAMA(10) = G(1,4)*ZZ(10) ! HNO3 - GAMA(11) = G(1,1)*ZZ(11) ! HCL - GAMA(12) = G(2,3)*ZZ(12) ! NAHSO4 - GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09)) ! LC ; SCAPE -!C GAMA(13) = 0.50*(GAMA(04)+GAMA(09)) ! LC ; SEQUILIB -!C GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07)) ! LC ; AIM - -! *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA ************************** - - DO 200 I=1,13 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) - ! GAMA(I)=EXP(LN10*GAMA(I)) - !C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] - ! GAMA(I) = GAMIN(I)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's - 200 END DO - -! *** SETUP ACTIVITY CALCULATION FLAGS ********************************* - -! OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE. - - IF (FRST) THEN - ERROU = ZERO ! CONVERGENCE CRITERION - DO 210 I=1,13 - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) - 210 END DO - CALAOU = ERROU >= EPSACT ! SETUP FLAGS - FRST = .FALSE. - ENDIF - -! INNER CALCULATION LOOP ; ALWAYS - - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=1,13 - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) - 220 END DO - CALAIN = ERRIN >= EPSACT - - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter - -! *** END OF SUBROUTINE ACTIVITY **************************************** - - RETURN - END SUBROUTINE CALCACT3 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCACT2 -! *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -! METHOD FOR AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. -! THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -! KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL2). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCACT2 - INCLUDE 'isrpia.inc' - - REAL :: EX10, URF - REAL :: G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - real :: MPL, XIJ, YJI - PARAMETER (URF=0.5) -! PARAMETER (LN10=2.30258509299404568402D0) - - G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H - -! *** SAVE ACTIVITIES IN OLD ARRAY ************************************* - - IF (FRST) THEN ! Outer loop - DO 10 I=7,10 - GAMOU(I) = GAMA(I) - 10 END DO - GAMOU(4) = GAMA(4) - GAMOU(5) = GAMA(5) - GAMOU(13) = GAMA(13) - ENDIF - - DO 20 I=7,10 ! Inner loop - GAMIN(I) = GAMA(I) - 20 END DO - GAMIN(4) = GAMA(4) - GAMIN(5) = GAMA(5) - GAMIN(13) = GAMA(13) - -! *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** - - IONIC=0.0 - MOLAL(2) = ZERO - MOLAL(4) = ZERO - DO 30 I=1,7 - IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) - 30 END DO - IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) - -! *** CALCULATE BINARY ACTIVITY COEFFICIENTS *************************** - -! G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02 -! G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05 - - IF (IACALC == 0) THEN ! K.M.; FULL - CALL KMFUL2 (IONIC, SNGL(TEMP),G0(3,2),G0(3,4),G0(1,2), & - G0(1,3),G0(3,3),G0(1,4)) - ELSE ! K.M.; TABULATED - CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3),G0(4,4),G0(4,1),G0(5,2), & - G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ENDIF - -! *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS ******************* - - AGAMA = 0.511*(298.0/TEMP)**1.5 ! Debye Huckel const. at T - SION = SQRT(IONIC) - H = AGAMA*SION/(1+SION) - - DO 100 I=1,3 - F1(I)=0.0 - F2(I)=0.0 - 100 END DO - F2(4)=0.0 - - DO 110 I=1,3,2 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=2,4 - ZMI = Z(J+3) - CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC - XIJ = CH*MPL - YJI = CH*MOLAL(J+3)/WATER - F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) - F2(J) = F2(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) - 110 END DO - -! *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** - -! GAMA(01) = G(2,1)*ZZ(01) ! NACL -! GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 -! GAMA(03) = G(2,4)*ZZ(03) ! NANO3 - GAMA(04) = G(3,2)*ZZ(04) ! (NH4)2SO4 - GAMA(05) = G(3,4)*ZZ(05) ! NH4NO3 -! GAMA(06) = G(3,1)*ZZ(06) ! NH4CL - GAMA(07) = G(1,2)*ZZ(07) ! 2H-SO4 - GAMA(08) = G(1,3)*ZZ(08) ! H-HSO4 - GAMA(09) = G(3,3)*ZZ(09) ! NH4HSO4 - GAMA(10) = G(1,4)*ZZ(10) ! HNO3 -! GAMA(11) = G(1,1)*ZZ(11) ! HCL -! GAMA(12) = G(2,3)*ZZ(12) ! NAHSO4 - GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09)) ! LC ; SCAPE -!C GAMA(13) = 0.50*(GAMA(04)+GAMA(09)) ! LC ; SEQUILIB -!C GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07)) ! LC ; AIM - -! *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA ************************** - - DO 200 I=7,10 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) - ! GAMA(I)=EXP(LN10*GAMA(I)) - !C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] - ! GAMA(I) = GAMIN(I)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's - 200 END DO - - GAMA(4)=MAX(-5.0d0, MIN(GAMA(4),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(4)=10.0**GAMA(4) -! GAMA(I)=EXP(LN10*GAMA(I)) -!C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(4) = GAMIN(4)*(1.0-URF) + URF*GAMA(4) ! Under-relax GAMA's - - GAMA(5)=MAX(-5.0d0, MIN(GAMA(5),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(5)=10.0**GAMA(5) -! GAMA(I)=EXP(LN10*GAMA(I)) -!C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(5) = GAMIN(5)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's - - GAMA(13)=MAX(-5.0d0, MIN(GAMA(13),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(13)=10.0**GAMA(13) -! GAMA(I)=EXP(LN10*GAMA(I)) -!C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(13) = GAMIN(13)*(1.0-URF) + URF*GAMA(13) ! Under-relax GAMA's - -! *** SETUP ACTIVITY CALCULATION FLAGS ********************************* - -! OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE. - - IF (FRST) THEN - ERROU = ZERO ! CONVERGENCE CRITERION - DO 210 I=7,10 - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) - 210 END DO - ERROU=MAX(ERROU, ABS((GAMOU(4)-GAMA(4))/GAMOU(4))) - ERROU=MAX(ERROU, ABS((GAMOU(5)-GAMA(5))/GAMOU(5))) - ERROU=MAX(ERROU, ABS((GAMOU(13)-GAMA(13))/GAMOU(13))) - - CALAOU = ERROU >= EPSACT ! SETUP FLAGS - FRST = .FALSE. - ENDIF - -! INNER CALCULATION LOOP ; ALWAYS - - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=7,10 - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) - 220 END DO - ERRIN = MAX (ERRIN, ABS((GAMIN(4)-GAMA(4))/GAMIN(4))) - ERRIN = MAX (ERRIN, ABS((GAMIN(5)-GAMA(5))/GAMIN(5))) - ERRIN = MAX (ERRIN, ABS((GAMIN(13)-GAMA(13))/GAMIN(13))) - CALAIN = ERRIN >= EPSACT - - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter - -! *** END OF SUBROUTINE ACTIVITY **************************************** - - RETURN - END SUBROUTINE CALCACT2 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCACT1 -! *** CALCULATES MULTI-COMPONENT ACTIVITY COEFFICIENTS FROM BROMLEYS -! METHOD FOR AN AMMONIUM-SULFATE AEROSOL SYSTEM. -! THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY -! KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL1). - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCACT1 - INCLUDE 'isrpia.inc' - - REAL :: EX10, URF - REAL :: G0(6,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) - real :: MPL, XIJ, YJI - PARAMETER (URF=0.5) -! PARAMETER (LN10=2.30258509299404568402D0) - - G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H - -! *** SAVE ACTIVITIES IN OLD ARRAY ************************************* - - IF (FRST) THEN ! Outer loop - DO 10 I=7,9 - GAMOU(I) = GAMA(I) - 10 END DO - GAMOU(4) = GAMA(4) - ! GAMOU(5) = GAMA(5) - GAMOU(13) = GAMA(13) - ENDIF - - DO 20 I=7,9 ! Inner loop - GAMIN(I) = GAMA(I) - 20 END DO - GAMIN(4) = GAMA(4) -! GAMIN(5) = GAMA(5) - GAMIN(13) = GAMA(13) - -! *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** - - IONIC=0.0 - MOLAL(2) = ZERO - MOLAL(4) = ZERO - MOLAL(7) = ZERO - DO 30 I=1,7 - IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) - 30 END DO - IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) - -! *** CALCULATE BINARY ACTIVITY COEFFICIENTS *************************** - -! G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02 -! G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05 - - IF (IACALC == 0) THEN ! K.M.; FULL - CALL KMFUL1 (IONIC, SNGL(TEMP),G0(3,2),G0(1,2), & - G0(1,3),G0(3,3)) - ELSE ! K.M.; TABULATED - CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), & - G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), & - G0(1,4),G0(1,1),G0(2,3),G0(4,4),G0(4,1),G0(5,2), & - G0(5,3),G0(5,4),G0(5,1),G0(6,2),G0(6,4),G0(6,1)) - ENDIF - -! *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS ******************* - - AGAMA = 0.511*(298.0/TEMP)**1.5 ! Debye Huckel const. at T - SION = SQRT(IONIC) - H = AGAMA*SION/(1+SION) - - DO 100 I=1,3 - F1(I)=0.0 - F2(I)=0.0 - 100 END DO - F2(4)=0.0 - - DO 110 I=1,3,2 - ZPL = Z(I) - MPL = MOLAL(I)/WATER - DO 110 J=2,3 - ZMI = Z(J+3) - CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC - XIJ = CH*MPL - YJI = CH*MOLAL(J+3)/WATER - F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) - F2(J) = F2(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) - 110 END DO - -! *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** - -! GAMA(01) = G(2,1)*ZZ(01) ! NACL -! GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 -! GAMA(03) = G(2,4)*ZZ(03) ! NANO3 - GAMA(04) = G(3,2)*ZZ(04) ! (NH4)2SO4 -! GAMA(05) = G(3,4)*ZZ(05) ! NH4NO3 -! GAMA(06) = G(3,1)*ZZ(06) ! NH4CL - GAMA(07) = G(1,2)*ZZ(07) ! 2H-SO4 - GAMA(08) = G(1,3)*ZZ(08) ! H-HSO4 - GAMA(09) = 0.5*(GAMA(04)+GAMA(07)) ! NH4HSO4 ; AIM (Wexler & Seinfeld, 1991) -! GAMA(10) = G(1,4)*ZZ(10) ! HNO3 -! GAMA(11) = G(1,1)*ZZ(11) ! HCL -! GAMA(12) = G(2,3)*ZZ(12) ! NAHSO4 - GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09)) ! LC ; SCAPE -!C GAMA(13) = 0.50*(GAMA(04)+GAMA(09)) ! LC ; SEQUILIB -!C GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07)) ! LC ; AIM - -! *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA ************************** - - DO 200 I=7,9 - GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(I)=10.0**GAMA(I) - ! GAMA(I)=EXP(LN10*GAMA(I)) - !C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] - ! GAMA(I) = GAMIN(I)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's - 200 END DO - - GAMA(4)=MAX(-5.0d0, MIN(GAMA(4),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(4)=10.0**GAMA(4) -! GAMA(I)=EXP(LN10*GAMA(I)) -!C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(4) = GAMIN(4)*(1.0-URF) + URF*GAMA(4) ! Under-relax GAMA's - -! GAMA(5)=MAX(-5.0d0, MIN(GAMA(5),5.0d0) ) ! F77 LIBRARY ROUTINE -! GAMA(5)=10.0**GAMA(5) -!C GAMA(I)=EXP(LN10*GAMA(I)) -! C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(5) = GAMIN(5)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's - - GAMA(13)=MAX(-5.0d0, MIN(GAMA(13),5.0d0) ) ! F77 LIBRARY ROUTINE - GAMA(13)=10.0**GAMA(13) -! GAMA(I)=EXP(LN10*GAMA(I)) -!C GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] -! GAMA(13) = GAMIN(13)*(1.0-URF) + URF*GAMA(13) ! Under-relax GAMA's - -! *** SETUP ACTIVITY CALCULATION FLAGS ********************************* - -! OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE. - - IF (FRST) THEN - ERROU = ZERO ! CONVERGENCE CRITERION - DO 210 I=7,9 - ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) - 210 END DO - ERROU=MAX(ERROU, ABS((GAMOU(4)-GAMA(4))/GAMOU(4))) - ! ERROU=MAX(ERROU, ABS((GAMOU(5)-GAMA(5))/GAMOU(5))) - ERROU=MAX(ERROU, ABS((GAMOU(13)-GAMA(13))/GAMOU(13))) - - CALAOU = ERROU >= EPSACT ! SETUP FLAGS - FRST = .FALSE. - ENDIF - -! INNER CALCULATION LOOP ; ALWAYS - - ERRIN = ZERO ! CONVERGENCE CRITERION - DO 220 I=7,9 - ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) - 220 END DO - ERRIN = MAX (ERRIN, ABS((GAMIN(4)-GAMA(4))/GAMIN(4))) -! ERRIN = MAX (ERRIN, ABS((GAMIN(5)-GAMA(5))/GAMIN(5))) - ERRIN = MAX (ERRIN, ABS((GAMIN(13)-GAMA(13))/GAMIN(13))) - CALAIN = ERRIN >= EPSACT - - ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter - -! *** END OF SUBROUTINE ACTIVITY **************************************** - - RETURN - END SUBROUTINE CALCACT1 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE RSTGAM -! *** RESETS ACTIVITY COEFFICIENT ARRAYS TO DEFAULT VALUE OF 0.1 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE RSTGAM - INCLUDE 'isrpia.inc' - - DO 10 I=1, NPAIR - GAMA(I) = 0.1 - 10 END DO - -! *** END OF SUBROUTINE RSTGAM ****************************************** - - RETURN - END SUBROUTINE RSTGAM -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE KMFUL4 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -! FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM -! AEROSOL SYSTEM. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE KMFUL4 (IONIC,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09, & - G10,G11,G12,G15,G16,G17,G18,G19,G20, & - G21,G22,G23) - IMPLICIT real (A-H,O-Z) - REAL :: Ionic, TEMP - DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11,Z15,Z16,Z17,Z19,Z20, & - Z21,Z22,Z23/1, 2, 1, 2, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 4, & - & 2, 2/ - - SION = SQRT(IONIC) - -! *** Coefficients at 25 oC - - CALL MKBI(2.230, IONIC, SION, Z01, G01) - CALL MKBI(-0.19, IONIC, SION, Z02, G02) - CALL MKBI(-0.39, IONIC, SION, Z03, G03) - CALL MKBI(-0.25, IONIC, SION, Z04, G04) - CALL MKBI(-1.15, IONIC, SION, Z05, G05) - CALL MKBI(0.820, IONIC, SION, Z06, G06) - CALL MKBI(-.100, IONIC, SION, Z07, G07) - CALL MKBI(8.000, IONIC, SION, Z08, G08) - CALL MKBI(2.600, IONIC, SION, Z10, G10) - CALL MKBI(6.000, IONIC, SION, Z11, G11) - CALL MKBI(0.930, IONIC, SION, Z15, G15) - CALL MKBI(2.400, IONIC, SION, Z16, G16) - CALL MKBI(-0.25, IONIC, SION, Z17, G17) - CALL MKBI(-2.33, IONIC, SION, Z19, G19) - CALL MKBI(0.920, IONIC, SION, Z20, G20) - CALL MKBI(0.150, IONIC, SION, Z21, G21) - CALL MKBI(2.320, IONIC, SION, Z22, G22) - CALL MKBI(2.900, IONIC, SION, Z23, G23) - -! *** Correct for T other than 298 K - - TI = TEMP-273.0 - TC = TI-25.0 - IF (ABS(TC) > 1.0) THEN - CF1 = 1.125-0.005*TI - CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION)) - G01 = CF1*G01 - CF2*Z01 - G02 = CF1*G02 - CF2*Z02 - G03 = CF1*G03 - CF2*Z03 - G04 = CF1*G04 - CF2*Z04 - G05 = CF1*G05 - CF2*Z05 - G06 = CF1*G06 - CF2*Z06 - G07 = CF1*G07 - CF2*Z07 - G08 = CF1*G08 - CF2*Z08 - G10 = CF1*G10 - CF2*Z10 - G11 = CF1*G11 - CF2*Z11 - G15 = CF1*G15 - CF2*Z15 - G16 = CF1*G16 - CF2*Z16 - G17 = CF1*G17 - CF2*Z17 - G19 = CF1*G19 - CF2*Z19 - G20 = CF1*G20 - CF2*Z20 - G21 = CF1*G21 - CF2*Z21 - G22 = CF1*G22 - CF2*Z22 - G23 = CF1*G23 - CF2*Z23 - - ENDIF - - G09 = G06 + G08 - G11 - G12 = G01 + G08 - G11 - G18 = G08 + G20 - G11 - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KMFUL4 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KMFUL3 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -! FOR AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE KMFUL3 (IONIC,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09, & - G10,G11,G12) - IMPLICIT real (A-H,O-Z) - REAL :: Ionic, TEMP - DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11 & - /1, 2, 1, 2, 1, 1, 2, 1, 1, 1/ - - SION = SQRT(IONIC) - -! *** Coefficients at 25 oC - - CALL MKBI(2.230, IONIC, SION, Z01, G01) - CALL MKBI(-0.19, IONIC, SION, Z02, G02) - CALL MKBI(-0.39, IONIC, SION, Z03, G03) - CALL MKBI(-0.25, IONIC, SION, Z04, G04) - CALL MKBI(-1.15, IONIC, SION, Z05, G05) - CALL MKBI(0.820, IONIC, SION, Z06, G06) - CALL MKBI(-.100, IONIC, SION, Z07, G07) - CALL MKBI(8.000, IONIC, SION, Z08, G08) - CALL MKBI(2.600, IONIC, SION, Z10, G10) - CALL MKBI(6.000, IONIC, SION, Z11, G11) - -! *** Correct for T other than 298 K - - TI = TEMP-273.0 - TC = TI-25.0 - IF (ABS(TC) > 1.0) THEN - CF1 = 1.125-0.005*TI - CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION)) - G01 = CF1*G01 - CF2*Z01 - G02 = CF1*G02 - CF2*Z02 - G03 = CF1*G03 - CF2*Z03 - G04 = CF1*G04 - CF2*Z04 - G05 = CF1*G05 - CF2*Z05 - G06 = CF1*G06 - CF2*Z06 - G07 = CF1*G07 - CF2*Z07 - G08 = CF1*G08 - CF2*Z08 - G10 = CF1*G10 - CF2*Z10 - G11 = CF1*G11 - CF2*Z11 - ENDIF - - G09 = G06 + G08 - G11 - G12 = G01 + G08 - G11 - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KMFUL3 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KMFUL2 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -! FOR AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE KMFUL2 (IONIC,TEMP,G04,G05,G07,G08,G09,G10) - IMPLICIT real (A-H,O-Z) - REAL :: Ionic, TEMP - DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11 & - /1, 2, 1, 2, 1, 1, 2, 1, 1, 1/ - - SION = SQRT(IONIC) - -! *** Coefficients at 25 oC - -! CALL MKBI(2.230, IONIC, SION, Z01, G01) -! CALL MKBI(-0.19, IONIC, SION, Z02, G02) -! CALL MKBI(-0.39, IONIC, SION, Z03, G03) - CALL MKBI(-0.25, IONIC, SION, Z04, G04) - CALL MKBI(-1.15, IONIC, SION, Z05, G05) -! CALL MKBI(0.820, IONIC, SION, Z06, G06) - CALL MKBI(-.100, IONIC, SION, Z07, G07) - CALL MKBI(8.000, IONIC, SION, Z08, G08) - CALL MKBI(2.600, IONIC, SION, Z10, G10) -! CALL MKBI(6.000, IONIC, SION, Z11, G11) - -! *** Correct for T other than 298 K - - TI = TEMP-273.0 - TC = TI-25.0 - IF (ABS(TC) > 1.0) THEN - CF1 = 1.125-0.005*TI - CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION)) - ! G01 = CF1*G01 - CF2*Z01 - ! G02 = CF1*G02 - CF2*Z02 - ! G03 = CF1*G03 - CF2*Z03 - G04 = CF1*G04 - CF2*Z04 - G05 = CF1*G05 - CF2*Z05 - ! G06 = CF1*G06 - CF2*Z06 - G07 = CF1*G07 - CF2*Z07 - G08 = CF1*G08 - CF2*Z08 - G10 = CF1*G10 - CF2*Z10 - ! G11 = CF1*G11 - CF2*Z11 - ENDIF - - G09 = G05 + G08 - G10 -! G12 = G01 + G08 - G11 - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KMFUL2 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KMFUL1 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD -! FOR AN AMMONIUM-SULFATE AEROSOL SYSTEM. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY - -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE KMFUL1 (IONIC,TEMP,G04,G07,G08,G09) - IMPLICIT real (A-H,O-Z) - REAL :: Ionic, TEMP - DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11 & - /1, 2, 1, 2, 1, 1, 2, 1, 1, 1/ - - SION = SQRT(IONIC) - -! *** Coefficients at 25 oC - -! CALL MKBI(2.230, IONIC, SION, Z01, G01) -! CALL MKBI(-0.19, IONIC, SION, Z02, G02) -! CALL MKBI(-0.39, IONIC, SION, Z03, G03) - CALL MKBI(-0.25, IONIC, SION, Z04, G04) -! CALL MKBI(-1.15, IONIC, SION, Z05, G05) -! CALL MKBI(0.820, IONIC, SION, Z06, G06) - CALL MKBI(-.100, IONIC, SION, Z07, G07) - CALL MKBI(8.000, IONIC, SION, Z08, G08) -! CALL MKBI(2.600, IONIC, SION, Z10, G10) -! CALL MKBI(6.000, IONIC, SION, Z11, G11) - -! *** Correct for T other than 298 K - - TI = TEMP-273.0 - TC = TI-25.0 - IF (ABS(TC) > 1.0) THEN - CF1 = 1.125-0.005*TI - CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION)) - ! G01 = CF1*G01 - CF2*Z01 - ! G02 = CF1*G02 - CF2*Z02 - ! G03 = CF1*G03 - CF2*Z03 - G04 = CF1*G04 - CF2*Z04 - ! G05 = CF1*G05 - CF2*Z05 - ! G06 = CF1*G06 - CF2*Z06 - G07 = CF1*G07 - CF2*Z07 - G08 = CF1*G08 - CF2*Z08 - ! G10 = CF1*G10 - CF2*Z10 - ! G11 = CF1*G11 - CF2*Z11 - ENDIF - -! G09 = G05 + G08 - G10 ! CALCULATED IN CALCACT1 -! G12 = G01 + G08 - G11 - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KMFUL1 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE MKBI -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE MKBI(Q,IONIC,SION,ZIP,BI) - - IMPLICIT real (A-H,O-Z) - REAL :: IONIC - - B=.75-.065*Q - C= 1.0 - IF (IONIC < 6.0) C=1.+.055*Q*EXP(-.023*IONIC*IONIC*IONIC) - XX=-0.5107*SION/(1.+C*SION) - BI=(1.+B*(1.+.1*IONIC)**Q-B) - BI=ZIP*ALOG10(BI) + ZIP*XX - - RETURN - END SUBROUTINE MKBI -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KMTAB -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IONIC' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KMTAB (IN,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, & - G11,G12,G15,G16,G17,G18,G19,G20,G21,G22,G23) - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - REAL :: IN, Temp, binarray (23) - -! *** Find temperature range - - IND = NINT((TEMP-198.0)/25.0) + 1 - IND = MIN(MAX(IND,1),6) - -! *** Call appropriate routine - - IF (IND == 1) THEN - CALL KM198 (IN,binarray) - ELSEIF (IND == 2) THEN - CALL KM223 (IN,binarray) - ELSEIF (IND == 3) THEN - CALL KM248 (IN,binarray) - ELSEIF (IND == 4) THEN - CALL KM273 (IN,binarray) - ELSEIF (IND == 5) THEN - CALL KM298 (IN,binarray) - ELSE - CALL KM323 (IN,binarray) - ENDIF - - G01 = binarray(01) - G02 = binarray(02) - G03 = binarray(03) - G04 = binarray(04) - G05 = binarray(05) - G06 = binarray(06) - G07 = binarray(07) - G08 = binarray(08) - G09 = binarray(09) - G10 = binarray(10) - G11 = binarray(11) - G12 = binarray(12) - G13 = binarray(13) - G14 = binarray(14) - G15 = binarray(15) - G16 = binarray(16) - G17 = binarray(17) - G18 = binarray(18) - G19 = binarray(19) - G20 = binarray(20) - G21 = binarray(21) - G22 = binarray(22) - G23 = binarray(23) - -! *** Return point; End of subroutine - - RETURN - END SUBROUTINE KMTAB - - -! INTEGER FUNCTION IBACPOS(IN) -!C -!C Compute the index in the binary activity coefficient array -!C based on the input ionic strength. -!C -!C Chris Nolte, 6/16/05 -!C -! implicit none -! real IN -! IF (IN .LE. 0.300000E+02) THEN -! ibacpos = MIN(NINT( 0.200000E+02*IN) + 1, 600) -! ELSE -! ibacpos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) -! ENDIF -! ibacpos = min(ibacpos, 741) -! return -! end - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM198 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 198K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM198 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC198/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM198 - - - BLOCK DATA KMCF198 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - - COMMON /KMC198/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.050,-0.103,-0.127,-0.142,-0.154,-0.162,-0.169,-0.174,-0.178, & - -0.181,-0.184,-0.186,-0.188,-0.189,-0.190,-0.191,-0.191,-0.192, & - -0.192,-0.191,-0.191,-0.191,-0.190,-0.189,-0.188,-0.188,-0.187, & - -0.185,-0.184,-0.183,-0.182,-0.181,-0.179,-0.178,-0.176,-0.175, & - -0.173,-0.172,-0.170,-0.169,-0.167,-0.166,-0.164,-0.162,-0.161, & - -0.159,-0.157,-0.156,-0.154,-0.152,-0.151,-0.149,-0.147,-0.146, & - -0.144,-0.142,-0.140,-0.139,-0.137,-0.135,-0.134,-0.132,-0.130, & - -0.128,-0.127,-0.125,-0.123,-0.121,-0.120,-0.118,-0.116,-0.114, & - -0.112,-0.111,-0.109,-0.107,-0.105,-0.103,-0.101,-0.099,-0.098, & - -0.096,-0.094,-0.092,-0.090,-0.088,-0.086,-0.084,-0.082,-0.080, & - -0.078,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.060, & - -0.058,-0.056,-0.054,-0.051,-0.049,-0.047,-0.045,-0.042,-0.040, & - -0.038,-0.035,-0.033,-0.031,-0.028,-0.026,-0.024,-0.021,-0.019, & - -0.016,-0.014,-0.012,-0.009,-0.007,-0.004,-0.002, 0.000, 0.003, & - & 0.005, 0.008, 0.010, 0.012, 0.015, 0.017, 0.020, 0.022, 0.024, & - & 0.027, 0.029, 0.032, 0.034, 0.036, 0.039, 0.041, 0.044, 0.046, & - & 0.048, 0.051, 0.053, 0.055, 0.058, 0.060, 0.063, 0.065, 0.067, & - & 0.070, 0.072, 0.074, 0.077, 0.079, 0.081, 0.084, 0.086, 0.088, & - & 0.091, 0.093, 0.095, 0.098, 0.100, 0.102, 0.105, 0.107, 0.109, & - & 0.112, 0.114, 0.116, 0.118, 0.121, 0.123, 0.125, 0.127, 0.130, & - & 0.132, 0.134, 0.137, 0.139, 0.141, 0.143, 0.146, 0.148, 0.150, & - & 0.152, 0.154, 0.157, 0.159, 0.161, 0.163, 0.166, 0.168, 0.170, & - & 0.172, 0.174, 0.176, 0.179, 0.181, 0.183, 0.185, 0.187, 0.190, & - & 0.192, 0.194, 0.196, 0.198, 0.200, 0.202, 0.205, 0.207, 0.209, & - & 0.211, 0.213, 0.215, 0.217, 0.219, 0.222, 0.224, 0.226, 0.228, & - & 0.230, 0.232, 0.234, 0.236, 0.238, 0.240, 0.242, 0.244, 0.246, & - & 0.249, 0.251, 0.253, 0.255, 0.257, 0.259, 0.261, 0.263, 0.265, & - & 0.267, 0.269, 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.283, & - & 0.285, 0.287, 0.289, 0.291, 0.293, 0.295, 0.297, 0.299, 0.301, & - & 0.303, 0.304, 0.306, 0.308, 0.310, 0.312, 0.314, 0.316, 0.318, & - & 0.320, 0.322, 0.324, 0.326, 0.328, 0.329, 0.331, 0.333, 0.335, & - & 0.337, 0.339, 0.341, 0.343, 0.344, 0.346, 0.348, 0.350, 0.352, & - & 0.354, 0.356, 0.357, 0.359, 0.361, 0.363, 0.365, 0.367, 0.368, & - & 0.370, 0.372, 0.374, 0.376, 0.377, 0.379, 0.381, 0.383, 0.385, & - & 0.386, 0.388, 0.390, 0.392, 0.393, 0.395, 0.397, 0.399, 0.401, & - & 0.402, 0.404, 0.406, 0.408, 0.409, 0.411, 0.413, 0.414, 0.416, & - & 0.418, 0.420, 0.421, 0.423, 0.425, 0.426, 0.428, 0.430, 0.432, & - & 0.433, 0.435, 0.437, 0.438, 0.440, 0.442, 0.443, 0.445, 0.447, & - & 0.448, 0.450, 0.452, 0.453, 0.455, 0.457, 0.458, 0.460, 0.461, & - & 0.463, 0.465, 0.466, 0.468, 0.470, 0.471, 0.473, 0.474, 0.476, & - & 0.478, 0.479, 0.481, 0.482, 0.484, 0.486, 0.487, 0.489, 0.490, & - & 0.492, 0.493, 0.495, 0.497, 0.498, 0.500, 0.501, 0.503, 0.504, & - & 0.506, 0.508, 0.509, 0.511, 0.512, 0.514, 0.515, 0.517, 0.518, & - & 0.520, 0.521, 0.523, 0.524, 0.526, 0.527, 0.529, 0.530, 0.532, & - & 0.533, 0.535, 0.536, 0.538, 0.554, 0.568, 0.582, 0.596, 0.610, & - & 0.623, 0.636, 0.649, 0.661, 0.674, 0.686, 0.698, 0.709, 0.721, & - & 0.732, 0.743, 0.754, 0.765, 0.775, 0.786, 0.796, 0.806, 0.815, & - & 0.825, 0.834, 0.844, 0.853, 0.862, 0.870, 0.879, 0.887, 0.896, & - & 0.904, 0.912, 0.920, 0.928, 0.935, 0.943, 0.950, 0.957, 0.964, & - & 0.971, 0.978, 0.985, 0.992, 0.998, 1.005, 1.011, 1.017, 1.023, & - & 1.029, 1.035, 1.041, 1.047, 1.052, 1.058, 1.063, 1.068, 1.074, & - & 1.079, 1.084, 1.089, 1.094, 1.099, 1.103, 1.108, 1.112, 1.117, & - & 1.121, 1.126, 1.130, 1.134, 1.138, 1.142, 1.146, 1.150, 1.154, & - & 1.158, 1.161, 1.165, 1.169, 1.172, 1.175, 1.179, 1.182, 1.185, & - & 1.189, 1.192, 1.195, 1.198, 1.201, 1.204, 1.206, 1.209, 1.212, & - & 1.215, 1.217, 1.220, 1.222, 1.225, 1.227, 1.230, 1.232, 1.234, & - & 1.236, 1.239, 1.241, 1.243, 1.245, 1.247, 1.249, 1.251, 1.253, & - & 1.254, 1.256, 1.258, 1.260, 1.261, 1.263, 1.264, 1.266, 1.267, & - & 1.269, 1.270, 1.272, 1.273, 1.274, 1.276, 1.277, 1.278, 1.279, & - & 1.280, 1.281, 1.283, 1.284, 1.285, 1.286, 1.286, 1.287, 1.288, & - & 1.289, 1.290, 1.291, 1.291, 1.292, 1.293, 1.293, 1.294, 1.295, & - & 1.295, 1.296, 1.296, 1.297, 1.297, 1.297, 1.298, 1.298, 1.298, & - & 1.299, 1.299, 1.299 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.103,-0.225,-0.288,-0.332,-0.367,-0.397,-0.422,-0.445,-0.465, & - -0.484,-0.501,-0.516,-0.531,-0.545,-0.558,-0.570,-0.582,-0.593, & - -0.604,-0.614,-0.624,-0.633,-0.643,-0.651,-0.660,-0.668,-0.676, & - -0.684,-0.692,-0.699,-0.707,-0.714,-0.721,-0.727,-0.734,-0.741, & - -0.747,-0.753,-0.759,-0.765,-0.771,-0.777,-0.783,-0.788,-0.794, & - -0.799,-0.804,-0.810,-0.815,-0.820,-0.825,-0.830,-0.835,-0.840, & - -0.845,-0.849,-0.854,-0.859,-0.863,-0.868,-0.872,-0.877,-0.881, & - -0.885,-0.889,-0.894,-0.898,-0.902,-0.906,-0.910,-0.914,-0.918, & - -0.922,-0.926,-0.930,-0.934,-0.938,-0.942,-0.946,-0.949,-0.953, & - -0.957,-0.961,-0.964,-0.968,-0.971,-0.975,-0.979,-0.982,-0.986, & - -0.989,-0.993,-0.996,-1.000,-1.003,-1.007,-1.010,-1.014,-1.017, & - -1.020,-1.024,-1.027,-1.030,-1.034,-1.037,-1.040,-1.044,-1.047, & - -1.050,-1.053,-1.057,-1.060,-1.063,-1.066,-1.069,-1.072,-1.076, & - -1.079,-1.082,-1.085,-1.088,-1.091,-1.094,-1.097,-1.100,-1.103, & - -1.106,-1.109,-1.112,-1.115,-1.118,-1.121,-1.124,-1.127,-1.130, & - -1.133,-1.136,-1.139,-1.142,-1.145,-1.147,-1.150,-1.153,-1.156, & - -1.159,-1.162,-1.165,-1.167,-1.170,-1.173,-1.176,-1.179,-1.181, & - -1.184,-1.187,-1.190,-1.192,-1.195,-1.198,-1.200,-1.203,-1.206, & - -1.209,-1.211,-1.214,-1.217,-1.219,-1.222,-1.225,-1.227,-1.230, & - -1.232,-1.235,-1.238,-1.240,-1.243,-1.246,-1.248,-1.251,-1.253, & - -1.256,-1.258,-1.261,-1.264,-1.266,-1.269,-1.271,-1.274,-1.276, & - -1.279,-1.281,-1.284,-1.286,-1.289,-1.291,-1.294,-1.296,-1.299, & - -1.301,-1.304,-1.306,-1.309,-1.311,-1.313,-1.316,-1.318,-1.321, & - -1.323,-1.326,-1.328,-1.330,-1.333,-1.335,-1.338,-1.340,-1.342, & - -1.345,-1.347,-1.350,-1.352,-1.354,-1.357,-1.359,-1.361,-1.364, & - -1.366,-1.368,-1.371,-1.373,-1.375,-1.378,-1.380,-1.382,-1.385, & - -1.387,-1.389,-1.392,-1.394,-1.396,-1.399,-1.401,-1.403,-1.405, & - -1.408,-1.410,-1.412,-1.415,-1.417,-1.419,-1.421,-1.424,-1.426, & - -1.428,-1.430,-1.433,-1.435,-1.437,-1.439,-1.442,-1.444,-1.446, & - -1.448,-1.450,-1.453,-1.455,-1.457,-1.459,-1.461,-1.464,-1.466, & - -1.468,-1.470,-1.472,-1.475,-1.477,-1.479,-1.481,-1.483,-1.485, & - -1.488,-1.490,-1.492,-1.494,-1.496,-1.498,-1.501,-1.503,-1.505, & - -1.507,-1.509,-1.511,-1.513,-1.516,-1.518,-1.520,-1.522,-1.524, & - -1.526,-1.528,-1.530,-1.533,-1.535,-1.537,-1.539,-1.541,-1.543, & - -1.545,-1.547,-1.549,-1.551,-1.554,-1.556,-1.558,-1.560,-1.562, & - -1.564,-1.566,-1.568,-1.570,-1.572,-1.574,-1.576,-1.578,-1.580, & - -1.583,-1.585,-1.587,-1.589,-1.591,-1.593,-1.595,-1.597,-1.599, & - -1.601,-1.603,-1.605,-1.607,-1.609,-1.611,-1.613,-1.615,-1.617, & - -1.619,-1.621,-1.623,-1.625,-1.627,-1.629,-1.631,-1.633,-1.635, & - -1.637,-1.639,-1.641,-1.643,-1.645,-1.647,-1.649,-1.651,-1.653, & - -1.655,-1.657,-1.659,-1.661,-1.663,-1.665,-1.667,-1.669,-1.671, & - -1.673,-1.675,-1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689, & - -1.691,-1.693,-1.695,-1.696,-1.698,-1.700,-1.702,-1.704,-1.706, & - -1.708,-1.710,-1.712,-1.714,-1.716,-1.718,-1.720,-1.722,-1.724, & - -1.726,-1.727,-1.729,-1.731,-1.752,-1.771,-1.790,-1.808,-1.827, & - -1.845,-1.864,-1.882,-1.900,-1.918,-1.936,-1.954,-1.972,-1.989, & - -2.007,-2.024,-2.042,-2.059,-2.076,-2.093,-2.110,-2.127,-2.144, & - -2.161,-2.178,-2.194,-2.211,-2.228,-2.244,-2.261,-2.277,-2.293, & - -2.310,-2.326,-2.342,-2.358,-2.374,-2.390,-2.406,-2.422,-2.438, & - -2.454,-2.470,-2.486,-2.501,-2.517,-2.533,-2.548,-2.564,-2.579, & - -2.595,-2.610,-2.626,-2.641,-2.657,-2.672,-2.687,-2.702,-2.718, & - -2.733,-2.748,-2.763,-2.778,-2.793,-2.808,-2.823,-2.838,-2.853, & - -2.868,-2.883,-2.898,-2.913,-2.927,-2.942,-2.957,-2.972,-2.986, & - -3.001,-3.016,-3.030,-3.045,-3.059,-3.074,-3.089,-3.103,-3.118, & - -3.132,-3.147,-3.161,-3.175,-3.190,-3.204,-3.219,-3.233,-3.247, & - -3.261,-3.276,-3.290,-3.304,-3.318,-3.333,-3.347,-3.361,-3.375, & - -3.389,-3.403,-3.417,-3.432,-3.446,-3.460,-3.474,-3.488,-3.502, & - -3.516,-3.530,-3.544,-3.558,-3.571,-3.585,-3.599,-3.613,-3.627, & - -3.641,-3.655,-3.669,-3.682,-3.696,-3.710,-3.724,-3.737,-3.751, & - -3.765,-3.779,-3.792,-3.806,-3.820,-3.833,-3.847,-3.861,-3.874, & - -3.888,-3.901,-3.915,-3.929,-3.942,-3.956,-3.969,-3.983,-3.996, & - -4.010,-4.023,-4.037,-4.050,-4.064,-4.077,-4.091,-4.104,-4.118, & - -4.131,-4.144,-4.158 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.052,-0.114,-0.145,-0.168,-0.187,-0.202,-0.215,-0.227,-0.238, & - -0.248,-0.257,-0.265,-0.273,-0.281,-0.288,-0.294,-0.301,-0.307, & - -0.313,-0.318,-0.324,-0.329,-0.334,-0.339,-0.344,-0.349,-0.353, & - -0.357,-0.362,-0.366,-0.370,-0.374,-0.378,-0.382,-0.386,-0.389, & - -0.393,-0.396,-0.400,-0.403,-0.407,-0.410,-0.413,-0.416,-0.419, & - -0.423,-0.426,-0.429,-0.432,-0.435,-0.437,-0.440,-0.443,-0.446, & - -0.449,-0.451,-0.454,-0.457,-0.459,-0.462,-0.464,-0.467,-0.469, & - -0.472,-0.474,-0.477,-0.479,-0.482,-0.484,-0.486,-0.489,-0.491, & - -0.493,-0.496,-0.498,-0.500,-0.502,-0.505,-0.507,-0.509,-0.511, & - -0.513,-0.516,-0.518,-0.520,-0.522,-0.524,-0.526,-0.528,-0.530, & - -0.532,-0.534,-0.537,-0.539,-0.541,-0.543,-0.545,-0.547,-0.549, & - -0.551,-0.553,-0.555,-0.557,-0.559,-0.561,-0.562,-0.564,-0.566, & - -0.568,-0.570,-0.572,-0.574,-0.576,-0.578,-0.580,-0.582,-0.583, & - -0.585,-0.587,-0.589,-0.591,-0.593,-0.594,-0.596,-0.598,-0.600, & - -0.602,-0.604,-0.605,-0.607,-0.609,-0.611,-0.612,-0.614,-0.616, & - -0.618,-0.619,-0.621,-0.623,-0.625,-0.626,-0.628,-0.630,-0.631, & - -0.633,-0.635,-0.637,-0.638,-0.640,-0.642,-0.643,-0.645,-0.647, & - -0.648,-0.650,-0.651,-0.653,-0.655,-0.656,-0.658,-0.660,-0.661, & - -0.663,-0.664,-0.666,-0.668,-0.669,-0.671,-0.672,-0.674,-0.676, & - -0.677,-0.679,-0.680,-0.682,-0.683,-0.685,-0.686,-0.688,-0.689, & - -0.691,-0.693,-0.694,-0.696,-0.697,-0.699,-0.700,-0.702,-0.703, & - -0.705,-0.706,-0.708,-0.709,-0.711,-0.712,-0.714,-0.715,-0.717, & - -0.718,-0.719,-0.721,-0.722,-0.724,-0.725,-0.727,-0.728,-0.730, & - -0.731,-0.733,-0.734,-0.735,-0.737,-0.738,-0.740,-0.741,-0.743, & - -0.744,-0.745,-0.747,-0.748,-0.750,-0.751,-0.752,-0.754,-0.755, & - -0.757,-0.758,-0.759,-0.761,-0.762,-0.763,-0.765,-0.766,-0.768, & - -0.769,-0.770,-0.772,-0.773,-0.774,-0.776,-0.777,-0.778,-0.780, & - -0.781,-0.782,-0.784,-0.785,-0.787,-0.788,-0.789,-0.791,-0.792, & - -0.793,-0.794,-0.796,-0.797,-0.798,-0.800,-0.801,-0.802,-0.804, & - -0.805,-0.806,-0.808,-0.809,-0.810,-0.812,-0.813,-0.814,-0.815, & - -0.817,-0.818,-0.819,-0.821,-0.822,-0.823,-0.824,-0.826,-0.827, & - -0.828,-0.829,-0.831,-0.832,-0.833,-0.835,-0.836,-0.837,-0.838, & - -0.840,-0.841,-0.842,-0.843,-0.845,-0.846,-0.847,-0.848,-0.850, & - -0.851,-0.852,-0.853,-0.854,-0.856,-0.857,-0.858,-0.859,-0.861, & - -0.862,-0.863,-0.864,-0.866,-0.867,-0.868,-0.869,-0.870,-0.872, & - -0.873,-0.874,-0.875,-0.876,-0.878,-0.879,-0.880,-0.881,-0.882, & - -0.884,-0.885,-0.886,-0.887,-0.888,-0.890,-0.891,-0.892,-0.893, & - -0.894,-0.896,-0.897,-0.898,-0.899,-0.900,-0.901,-0.903,-0.904, & - -0.905,-0.906,-0.907,-0.908,-0.910,-0.911,-0.912,-0.913,-0.914, & - -0.915,-0.917,-0.918,-0.919,-0.920,-0.921,-0.922,-0.924,-0.925, & - -0.926,-0.927,-0.928,-0.929,-0.930,-0.932,-0.933,-0.934,-0.935, & - -0.936,-0.937,-0.938,-0.940,-0.941,-0.942,-0.943,-0.944,-0.945, & - -0.946,-0.947,-0.949,-0.950,-0.951,-0.952,-0.953,-0.954,-0.955, & - -0.956,-0.958,-0.959,-0.960,-0.961,-0.962,-0.963,-0.964,-0.965, & - -0.966,-0.968,-0.969,-0.970,-0.982,-0.992,-1.003,-1.014,-1.025, & - -1.035,-1.046,-1.056,-1.066,-1.076,-1.087,-1.097,-1.107,-1.117, & - -1.126,-1.136,-1.146,-1.156,-1.165,-1.175,-1.185,-1.194,-1.203, & - -1.213,-1.222,-1.231,-1.241,-1.250,-1.259,-1.268,-1.277,-1.286, & - -1.295,-1.304,-1.313,-1.322,-1.331,-1.340,-1.349,-1.357,-1.366, & - -1.375,-1.383,-1.392,-1.401,-1.409,-1.418,-1.426,-1.435,-1.443, & - -1.452,-1.460,-1.468,-1.477,-1.485,-1.493,-1.502,-1.510,-1.518, & - -1.526,-1.535,-1.543,-1.551,-1.559,-1.567,-1.575,-1.583,-1.591, & - -1.599,-1.607,-1.615,-1.623,-1.631,-1.639,-1.647,-1.655,-1.663, & - -1.671,-1.679,-1.686,-1.694,-1.702,-1.710,-1.718,-1.725,-1.733, & - -1.741,-1.749,-1.756,-1.764,-1.772,-1.779,-1.787,-1.794,-1.802, & - -1.810,-1.817,-1.825,-1.832,-1.840,-1.847,-1.855,-1.862,-1.870, & - -1.877,-1.885,-1.892,-1.900,-1.907,-1.915,-1.922,-1.929,-1.937, & - -1.944,-1.952,-1.959,-1.966,-1.974,-1.981,-1.988,-1.996,-2.003, & - -2.010,-2.018,-2.025,-2.032,-2.039,-2.047,-2.054,-2.061,-2.068, & - -2.075,-2.083,-2.090,-2.097,-2.104,-2.111,-2.118,-2.126,-2.133, & - -2.140,-2.147,-2.154,-2.161,-2.168,-2.175,-2.183,-2.190,-2.197, & - -2.204,-2.211,-2.218,-2.225,-2.232,-2.239,-2.246,-2.253,-2.260, & - -2.267,-2.274,-2.281 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.103,-0.226,-0.289,-0.334,-0.369,-0.399,-0.425,-0.448,-0.468, & - -0.487,-0.505,-0.521,-0.536,-0.550,-0.563,-0.576,-0.588,-0.599, & - -0.610,-0.621,-0.631,-0.641,-0.650,-0.659,-0.668,-0.677,-0.685, & - -0.693,-0.701,-0.709,-0.717,-0.724,-0.731,-0.738,-0.745,-0.752, & - -0.758,-0.765,-0.771,-0.777,-0.784,-0.790,-0.796,-0.801,-0.807, & - -0.813,-0.818,-0.824,-0.829,-0.835,-0.840,-0.845,-0.850,-0.855, & - -0.860,-0.865,-0.870,-0.875,-0.880,-0.884,-0.889,-0.894,-0.898, & - -0.903,-0.907,-0.912,-0.916,-0.920,-0.925,-0.929,-0.933,-0.937, & - -0.942,-0.946,-0.950,-0.954,-0.958,-0.962,-0.966,-0.970,-0.974, & - -0.978,-0.982,-0.985,-0.989,-0.993,-0.997,-1.001,-1.004,-1.008, & - -1.012,-1.016,-1.019,-1.023,-1.027,-1.030,-1.034,-1.037,-1.041, & - -1.045,-1.048,-1.052,-1.055,-1.059,-1.062,-1.066,-1.069,-1.072, & - -1.076,-1.079,-1.083,-1.086,-1.089,-1.093,-1.096,-1.099,-1.103, & - -1.106,-1.109,-1.113,-1.116,-1.119,-1.122,-1.126,-1.129,-1.132, & - -1.135,-1.138,-1.142,-1.145,-1.148,-1.151,-1.154,-1.157,-1.160, & - -1.164,-1.167,-1.170,-1.173,-1.176,-1.179,-1.182,-1.185,-1.188, & - -1.191,-1.194,-1.197,-1.200,-1.203,-1.206,-1.209,-1.212,-1.215, & - -1.218,-1.221,-1.223,-1.226,-1.229,-1.232,-1.235,-1.238,-1.241, & - -1.244,-1.246,-1.249,-1.252,-1.255,-1.258,-1.261,-1.263,-1.266, & - -1.269,-1.272,-1.274,-1.277,-1.280,-1.283,-1.285,-1.288,-1.291, & - -1.294,-1.296,-1.299,-1.302,-1.304,-1.307,-1.310,-1.313,-1.315, & - -1.318,-1.321,-1.323,-1.326,-1.328,-1.331,-1.334,-1.336,-1.339, & - -1.342,-1.344,-1.347,-1.349,-1.352,-1.355,-1.357,-1.360,-1.362, & - -1.365,-1.367,-1.370,-1.373,-1.375,-1.378,-1.380,-1.383,-1.385, & - -1.388,-1.390,-1.393,-1.395,-1.398,-1.400,-1.403,-1.405,-1.408, & - -1.410,-1.413,-1.415,-1.418,-1.420,-1.423,-1.425,-1.427,-1.430, & - -1.432,-1.435,-1.437,-1.440,-1.442,-1.445,-1.447,-1.449,-1.452, & - -1.454,-1.457,-1.459,-1.461,-1.464,-1.466,-1.469,-1.471,-1.473, & - -1.476,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490,-1.492,-1.495, & - -1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511,-1.513,-1.515, & - -1.518,-1.520,-1.522,-1.525,-1.527,-1.529,-1.532,-1.534,-1.536, & - -1.538,-1.541,-1.543,-1.545,-1.548,-1.550,-1.552,-1.554,-1.557, & - -1.559,-1.561,-1.563,-1.566,-1.568,-1.570,-1.572,-1.575,-1.577, & - -1.579,-1.581,-1.583,-1.586,-1.588,-1.590,-1.592,-1.595,-1.597, & - -1.599,-1.601,-1.603,-1.606,-1.608,-1.610,-1.612,-1.614,-1.616, & - -1.619,-1.621,-1.623,-1.625,-1.627,-1.630,-1.632,-1.634,-1.636, & - -1.638,-1.640,-1.642,-1.645,-1.647,-1.649,-1.651,-1.653,-1.655, & - -1.658,-1.660,-1.662,-1.664,-1.666,-1.668,-1.670,-1.672,-1.675, & - -1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689,-1.691,-1.694, & - -1.696,-1.698,-1.700,-1.702,-1.704,-1.706,-1.708,-1.710,-1.712, & - -1.714,-1.717,-1.719,-1.721,-1.723,-1.725,-1.727,-1.729,-1.731, & - -1.733,-1.735,-1.737,-1.739,-1.741,-1.743,-1.745,-1.748,-1.750, & - -1.752,-1.754,-1.756,-1.758,-1.760,-1.762,-1.764,-1.766,-1.768, & - -1.770,-1.772,-1.774,-1.776,-1.778,-1.780,-1.782,-1.784,-1.786, & - -1.788,-1.790,-1.792,-1.794,-1.816,-1.836,-1.855,-1.875,-1.894, & - -1.914,-1.933,-1.952,-1.971,-1.989,-2.008,-2.027,-2.045,-2.063, & - -2.082,-2.100,-2.118,-2.136,-2.154,-2.171,-2.189,-2.207,-2.224, & - -2.242,-2.259,-2.276,-2.293,-2.311,-2.328,-2.345,-2.362,-2.379, & - -2.395,-2.412,-2.429,-2.446,-2.462,-2.479,-2.495,-2.512,-2.528, & - -2.544,-2.561,-2.577,-2.593,-2.609,-2.625,-2.642,-2.658,-2.674, & - -2.689,-2.705,-2.721,-2.737,-2.753,-2.768,-2.784,-2.800,-2.815, & - -2.831,-2.847,-2.862,-2.878,-2.893,-2.908,-2.924,-2.939,-2.954, & - -2.970,-2.985,-3.000,-3.015,-3.031,-3.046,-3.061,-3.076,-3.091, & - -3.106,-3.121,-3.136,-3.151,-3.166,-3.181,-3.196,-3.210,-3.225, & - -3.240,-3.255,-3.270,-3.284,-3.299,-3.314,-3.328,-3.343,-3.358, & - -3.372,-3.387,-3.401,-3.416,-3.430,-3.445,-3.459,-3.474,-3.488, & - -3.503,-3.517,-3.531,-3.546,-3.560,-3.574,-3.589,-3.603,-3.617, & - -3.631,-3.646,-3.660,-3.674,-3.688,-3.702,-3.717,-3.731,-3.745, & - -3.759,-3.773,-3.787,-3.801,-3.815,-3.829,-3.843,-3.857,-3.871, & - -3.885,-3.899,-3.913,-3.927,-3.941,-3.955,-3.969,-3.982,-3.996, & - -4.010,-4.024,-4.038,-4.051,-4.065,-4.079,-4.093,-4.107,-4.120, & - -4.134,-4.148,-4.161,-4.175,-4.189,-4.202,-4.216,-4.230,-4.243, & - -4.257,-4.271,-4.284 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.052,-0.117,-0.152,-0.178,-0.199,-0.217,-0.232,-0.247,-0.260, & - -0.272,-0.283,-0.294,-0.304,-0.314,-0.323,-0.332,-0.341,-0.349, & - -0.357,-0.365,-0.372,-0.379,-0.386,-0.393,-0.400,-0.407,-0.413, & - -0.419,-0.426,-0.432,-0.437,-0.443,-0.449,-0.455,-0.460,-0.466, & - -0.471,-0.476,-0.481,-0.486,-0.491,-0.496,-0.501,-0.506,-0.511, & - -0.515,-0.520,-0.524,-0.529,-0.533,-0.537,-0.542,-0.546,-0.550, & - -0.554,-0.558,-0.563,-0.567,-0.570,-0.574,-0.578,-0.582,-0.586, & - -0.590,-0.593,-0.597,-0.601,-0.604,-0.608,-0.612,-0.615,-0.619, & - -0.622,-0.626,-0.629,-0.633,-0.636,-0.640,-0.643,-0.646,-0.650, & - -0.653,-0.656,-0.660,-0.663,-0.666,-0.670,-0.673,-0.676,-0.679, & - -0.683,-0.686,-0.689,-0.692,-0.696,-0.699,-0.702,-0.705,-0.708, & - -0.711,-0.715,-0.718,-0.721,-0.724,-0.727,-0.730,-0.733,-0.736, & - -0.739,-0.742,-0.746,-0.749,-0.752,-0.755,-0.758,-0.761,-0.764, & - -0.767,-0.770,-0.773,-0.776,-0.778,-0.781,-0.784,-0.787,-0.790, & - -0.793,-0.796,-0.799,-0.802,-0.805,-0.807,-0.810,-0.813,-0.816, & - -0.819,-0.821,-0.824,-0.827,-0.830,-0.833,-0.835,-0.838,-0.841, & - -0.843,-0.846,-0.849,-0.852,-0.854,-0.857,-0.860,-0.862,-0.865, & - -0.867,-0.870,-0.873,-0.875,-0.878,-0.880,-0.883,-0.886,-0.888, & - -0.891,-0.893,-0.896,-0.898,-0.901,-0.903,-0.906,-0.908,-0.911, & - -0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928,-0.930,-0.933, & - -0.935,-0.938,-0.940,-0.942,-0.945,-0.947,-0.950,-0.952,-0.954, & - -0.957,-0.959,-0.961,-0.964,-0.966,-0.968,-0.971,-0.973,-0.975, & - -0.977,-0.980,-0.982,-0.984,-0.987,-0.989,-0.991,-0.993,-0.996, & - -0.998,-1.000,-1.002,-1.004,-1.007,-1.009,-1.011,-1.013,-1.015, & - -1.018,-1.020,-1.022,-1.024,-1.026,-1.028,-1.031,-1.033,-1.035, & - -1.037,-1.039,-1.041,-1.043,-1.046,-1.048,-1.050,-1.052,-1.054, & - -1.056,-1.058,-1.060,-1.062,-1.064,-1.066,-1.068,-1.070,-1.072, & - -1.075,-1.077,-1.079,-1.081,-1.083,-1.085,-1.087,-1.089,-1.091, & - -1.093,-1.095,-1.097,-1.099,-1.101,-1.103,-1.105,-1.107,-1.109, & - -1.110,-1.112,-1.114,-1.116,-1.118,-1.120,-1.122,-1.124,-1.126, & - -1.128,-1.130,-1.132,-1.134,-1.136,-1.137,-1.139,-1.141,-1.143, & - -1.145,-1.147,-1.149,-1.151,-1.153,-1.154,-1.156,-1.158,-1.160, & - -1.162,-1.164,-1.166,-1.167,-1.169,-1.171,-1.173,-1.175,-1.176, & - -1.178,-1.180,-1.182,-1.184,-1.186,-1.187,-1.189,-1.191,-1.193, & - -1.195,-1.196,-1.198,-1.200,-1.202,-1.203,-1.205,-1.207,-1.209, & - -1.210,-1.212,-1.214,-1.216,-1.217,-1.219,-1.221,-1.223,-1.224, & - -1.226,-1.228,-1.230,-1.231,-1.233,-1.235,-1.236,-1.238,-1.240, & - -1.241,-1.243,-1.245,-1.247,-1.248,-1.250,-1.252,-1.253,-1.255, & - -1.257,-1.258,-1.260,-1.262,-1.263,-1.265,-1.267,-1.268,-1.270, & - -1.272,-1.273,-1.275,-1.276,-1.278,-1.280,-1.281,-1.283,-1.285, & - -1.286,-1.288,-1.289,-1.291,-1.293,-1.294,-1.296,-1.298,-1.299, & - -1.301,-1.302,-1.304,-1.306,-1.307,-1.309,-1.310,-1.312,-1.313, & - -1.315,-1.317,-1.318,-1.320,-1.321,-1.323,-1.324,-1.326,-1.328, & - -1.329,-1.331,-1.332,-1.334,-1.335,-1.337,-1.338,-1.340,-1.341, & - -1.343,-1.345,-1.346,-1.348,-1.364,-1.379,-1.394,-1.408,-1.422, & - -1.436,-1.450,-1.464,-1.478,-1.491,-1.504,-1.518,-1.531,-1.543, & - -1.556,-1.569,-1.581,-1.593,-1.606,-1.618,-1.630,-1.641,-1.653, & - -1.665,-1.676,-1.688,-1.699,-1.710,-1.722,-1.733,-1.744,-1.755, & - -1.765,-1.776,-1.787,-1.797,-1.808,-1.818,-1.829,-1.839,-1.849, & - -1.859,-1.870,-1.880,-1.890,-1.900,-1.909,-1.919,-1.929,-1.939, & - -1.948,-1.958,-1.968,-1.977,-1.986,-1.996,-2.005,-2.015,-2.024, & - -2.033,-2.042,-2.051,-2.060,-2.070,-2.079,-2.088,-2.096,-2.105, & - -2.114,-2.123,-2.132,-2.141,-2.149,-2.158,-2.167,-2.175,-2.184, & - -2.193,-2.201,-2.210,-2.218,-2.226,-2.235,-2.243,-2.252,-2.260, & - -2.268,-2.277,-2.285,-2.293,-2.301,-2.309,-2.318,-2.326,-2.334, & - -2.342,-2.350,-2.358,-2.366,-2.374,-2.382,-2.390,-2.398,-2.406, & - -2.414,-2.422,-2.429,-2.437,-2.445,-2.453,-2.461,-2.468,-2.476, & - -2.484,-2.492,-2.499,-2.507,-2.515,-2.522,-2.530,-2.537,-2.545, & - -2.553,-2.560,-2.568,-2.575,-2.583,-2.590,-2.598,-2.605,-2.613, & - -2.620,-2.628,-2.635,-2.642,-2.650,-2.657,-2.664,-2.672,-2.679, & - -2.686,-2.694,-2.701,-2.708,-2.716,-2.723,-2.730,-2.737,-2.745, & - -2.752,-2.759,-2.766,-2.773,-2.781,-2.788,-2.795,-2.802,-2.809, & - -2.816,-2.823,-2.831 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.051,-0.108,-0.136,-0.155,-0.170,-0.182,-0.192,-0.200,-0.207, & - -0.214,-0.220,-0.225,-0.230,-0.234,-0.238,-0.242,-0.245,-0.248, & - -0.251,-0.254,-0.256,-0.259,-0.261,-0.263,-0.265,-0.267,-0.269, & - -0.270,-0.272,-0.274,-0.275,-0.276,-0.278,-0.279,-0.280,-0.281, & - -0.283,-0.284,-0.285,-0.286,-0.287,-0.288,-0.289,-0.289,-0.290, & - -0.291,-0.292,-0.293,-0.293,-0.294,-0.295,-0.296,-0.296,-0.297, & - -0.298,-0.298,-0.299,-0.300,-0.300,-0.301,-0.301,-0.302,-0.302, & - -0.303,-0.303,-0.304,-0.304,-0.305,-0.305,-0.306,-0.306,-0.307, & - -0.307,-0.308,-0.308,-0.308,-0.309,-0.309,-0.309,-0.310,-0.310, & - -0.310,-0.311,-0.311,-0.311,-0.312,-0.312,-0.312,-0.312,-0.313, & - -0.313,-0.313,-0.313,-0.313,-0.314,-0.314,-0.314,-0.314,-0.314, & - -0.314,-0.314,-0.314,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, & - -0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, & - -0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, & - -0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315,-0.315, & - -0.315,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314, & - -0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.314,-0.313, & - -0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313,-0.313, & - -0.313,-0.313,-0.313,-0.313,-0.312,-0.312,-0.312,-0.312,-0.312, & - -0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312,-0.312, & - -0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311,-0.311, & - -0.311,-0.311,-0.311,-0.311,-0.311,-0.310,-0.310,-0.310,-0.310, & - -0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310,-0.310, & - -0.310,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309, & - -0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.309,-0.308, & - -0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308, & - -0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.308,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306, & - -0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.306,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307,-0.307, & - -0.307,-0.307,-0.307,-0.307,-0.307,-0.308,-0.308,-0.308,-0.308, & - -0.308,-0.308,-0.308,-0.308,-0.308,-0.309,-0.310,-0.311,-0.311, & - -0.312,-0.313,-0.314,-0.315,-0.316,-0.317,-0.319,-0.320,-0.321, & - -0.322,-0.324,-0.325,-0.327,-0.328,-0.330,-0.331,-0.333,-0.335, & - -0.336,-0.338,-0.340,-0.342,-0.344,-0.346,-0.348,-0.350,-0.352, & - -0.354,-0.356,-0.358,-0.360,-0.362,-0.365,-0.367,-0.369,-0.371, & - -0.374,-0.376,-0.379,-0.381,-0.383,-0.386,-0.389,-0.391,-0.394, & - -0.396,-0.399,-0.401,-0.404,-0.407,-0.410,-0.412,-0.415,-0.418, & - -0.421,-0.423,-0.426,-0.429,-0.432,-0.435,-0.438,-0.441,-0.444, & - -0.447,-0.450,-0.453,-0.456,-0.459,-0.462,-0.465,-0.468,-0.471, & - -0.475,-0.478,-0.481,-0.484,-0.487,-0.491,-0.494,-0.497,-0.500, & - -0.504,-0.507,-0.510,-0.514,-0.517,-0.520,-0.524,-0.527,-0.531, & - -0.534,-0.537,-0.541,-0.544,-0.548,-0.551,-0.555,-0.558,-0.562, & - -0.565,-0.569,-0.573,-0.576,-0.580,-0.583,-0.587,-0.591,-0.594, & - -0.598,-0.601,-0.605,-0.609,-0.612,-0.616,-0.620,-0.624,-0.627, & - -0.631,-0.635,-0.639,-0.642,-0.646,-0.650,-0.654,-0.657,-0.661, & - -0.665,-0.669,-0.673,-0.677,-0.680,-0.684,-0.688,-0.692,-0.696, & - -0.700,-0.704,-0.708,-0.711,-0.715,-0.719,-0.723,-0.727,-0.731, & - -0.735,-0.739,-0.743,-0.747,-0.751,-0.755,-0.759,-0.763,-0.767, & - -0.771,-0.775,-0.779 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.103,-0.225,-0.286,-0.330,-0.365,-0.394,-0.419,-0.441,-0.460, & - -0.478,-0.495,-0.510,-0.524,-0.538,-0.550,-0.562,-0.573,-0.584, & - -0.594,-0.604,-0.613,-0.622,-0.631,-0.640,-0.648,-0.656,-0.663, & - -0.671,-0.678,-0.685,-0.692,-0.699,-0.705,-0.711,-0.718,-0.724, & - -0.730,-0.736,-0.741,-0.747,-0.753,-0.758,-0.763,-0.769,-0.774, & - -0.779,-0.784,-0.789,-0.794,-0.798,-0.803,-0.808,-0.812,-0.817, & - -0.821,-0.826,-0.830,-0.834,-0.839,-0.843,-0.847,-0.851,-0.855, & - -0.859,-0.863,-0.867,-0.871,-0.875,-0.879,-0.883,-0.886,-0.890, & - -0.894,-0.897,-0.901,-0.905,-0.908,-0.912,-0.915,-0.919,-0.922, & - -0.926,-0.929,-0.933,-0.936,-0.939,-0.943,-0.946,-0.949,-0.953, & - -0.956,-0.959,-0.962,-0.965,-0.969,-0.972,-0.975,-0.978,-0.981, & - -0.984,-0.987,-0.990,-0.994,-0.997,-1.000,-1.003,-1.006,-1.009, & - -1.012,-1.015,-1.017,-1.020,-1.023,-1.026,-1.029,-1.032,-1.035, & - -1.038,-1.041,-1.043,-1.046,-1.049,-1.052,-1.055,-1.057,-1.060, & - -1.063,-1.066,-1.068,-1.071,-1.074,-1.077,-1.079,-1.082,-1.085, & - -1.087,-1.090,-1.093,-1.095,-1.098,-1.100,-1.103,-1.106,-1.108, & - -1.111,-1.113,-1.116,-1.119,-1.121,-1.124,-1.126,-1.129,-1.131, & - -1.134,-1.136,-1.139,-1.141,-1.144,-1.146,-1.149,-1.151,-1.154, & - -1.156,-1.159,-1.161,-1.163,-1.166,-1.168,-1.171,-1.173,-1.176, & - -1.178,-1.180,-1.183,-1.185,-1.187,-1.190,-1.192,-1.195,-1.197, & - -1.199,-1.202,-1.204,-1.206,-1.209,-1.211,-1.213,-1.216,-1.218, & - -1.220,-1.222,-1.225,-1.227,-1.229,-1.232,-1.234,-1.236,-1.238, & - -1.241,-1.243,-1.245,-1.247,-1.250,-1.252,-1.254,-1.256,-1.258, & - -1.261,-1.263,-1.265,-1.267,-1.270,-1.272,-1.274,-1.276,-1.278, & - -1.280,-1.283,-1.285,-1.287,-1.289,-1.291,-1.293,-1.296,-1.298, & - -1.300,-1.302,-1.304,-1.306,-1.308,-1.311,-1.313,-1.315,-1.317, & - -1.319,-1.321,-1.323,-1.325,-1.328,-1.330,-1.332,-1.334,-1.336, & - -1.338,-1.340,-1.342,-1.344,-1.346,-1.348,-1.350,-1.353,-1.355, & - -1.357,-1.359,-1.361,-1.363,-1.365,-1.367,-1.369,-1.371,-1.373, & - -1.375,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389,-1.391, & - -1.393,-1.395,-1.397,-1.399,-1.401,-1.403,-1.405,-1.407,-1.409, & - -1.411,-1.413,-1.415,-1.417,-1.419,-1.421,-1.423,-1.425,-1.427, & - -1.429,-1.431,-1.433,-1.435,-1.437,-1.439,-1.441,-1.443,-1.445, & - -1.447,-1.449,-1.451,-1.453,-1.455,-1.456,-1.458,-1.460,-1.462, & - -1.464,-1.466,-1.468,-1.470,-1.472,-1.474,-1.476,-1.478,-1.480, & - -1.481,-1.483,-1.485,-1.487,-1.489,-1.491,-1.493,-1.495,-1.497, & - -1.499,-1.500,-1.502,-1.504,-1.506,-1.508,-1.510,-1.512,-1.514, & - -1.516,-1.517,-1.519,-1.521,-1.523,-1.525,-1.527,-1.529,-1.531, & - -1.532,-1.534,-1.536,-1.538,-1.540,-1.542,-1.544,-1.545,-1.547, & - -1.549,-1.551,-1.553,-1.555,-1.557,-1.558,-1.560,-1.562,-1.564, & - -1.566,-1.568,-1.569,-1.571,-1.573,-1.575,-1.577,-1.579,-1.580, & - -1.582,-1.584,-1.586,-1.588,-1.589,-1.591,-1.593,-1.595,-1.597, & - -1.598,-1.600,-1.602,-1.604,-1.606,-1.608,-1.609,-1.611,-1.613, & - -1.615,-1.617,-1.618,-1.620,-1.622,-1.624,-1.625,-1.627,-1.629, & - -1.631,-1.633,-1.634,-1.636,-1.655,-1.673,-1.691,-1.708,-1.725, & - -1.742,-1.760,-1.777,-1.793,-1.810,-1.827,-1.844,-1.860,-1.877, & - -1.893,-1.910,-1.926,-1.942,-1.958,-1.974,-1.990,-2.006,-2.022, & - -2.038,-2.054,-2.070,-2.086,-2.101,-2.117,-2.132,-2.148,-2.163, & - -2.179,-2.194,-2.210,-2.225,-2.240,-2.255,-2.271,-2.286,-2.301, & - -2.316,-2.331,-2.346,-2.361,-2.376,-2.391,-2.406,-2.420,-2.435, & - -2.450,-2.465,-2.479,-2.494,-2.509,-2.523,-2.538,-2.553,-2.567, & - -2.582,-2.596,-2.611,-2.625,-2.640,-2.654,-2.668,-2.683,-2.697, & - -2.711,-2.726,-2.740,-2.754,-2.768,-2.783,-2.797,-2.811,-2.825, & - -2.839,-2.853,-2.867,-2.881,-2.895,-2.909,-2.923,-2.937,-2.951, & - -2.965,-2.979,-2.993,-3.007,-3.021,-3.035,-3.049,-3.063,-3.076, & - -3.090,-3.104,-3.118,-3.132,-3.145,-3.159,-3.173,-3.186,-3.200, & - -3.214,-3.227,-3.241,-3.255,-3.268,-3.282,-3.295,-3.309,-3.323, & - -3.336,-3.350,-3.363,-3.377,-3.390,-3.404,-3.417,-3.431,-3.444, & - -3.458,-3.471,-3.484,-3.498,-3.511,-3.525,-3.538,-3.551,-3.565, & - -3.578,-3.591,-3.605,-3.618,-3.631,-3.645,-3.658,-3.671,-3.684, & - -3.698,-3.711,-3.724,-3.737,-3.750,-3.764,-3.777,-3.790,-3.803, & - -3.816,-3.829,-3.843,-3.856,-3.869,-3.882,-3.895,-3.908,-3.921, & - -3.934,-3.947,-3.960 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.047,-0.093,-0.110,-0.119,-0.125,-0.128,-0.130,-0.130,-0.129, & - -0.128,-0.126,-0.123,-0.119,-0.116,-0.111,-0.107,-0.102,-0.096, & - -0.091,-0.085,-0.079,-0.073,-0.066,-0.059,-0.052,-0.045,-0.037, & - -0.030,-0.022,-0.014,-0.006, 0.003, 0.011, 0.020, 0.028, 0.037, & - & 0.046, 0.055, 0.065, 0.074, 0.083, 0.093, 0.103, 0.113, 0.122, & - & 0.132, 0.142, 0.152, 0.163, 0.173, 0.183, 0.194, 0.204, 0.215, & - & 0.225, 0.236, 0.247, 0.258, 0.268, 0.279, 0.290, 0.301, 0.312, & - & 0.323, 0.334, 0.346, 0.357, 0.368, 0.380, 0.391, 0.402, 0.414, & - & 0.425, 0.437, 0.449, 0.461, 0.472, 0.484, 0.496, 0.508, 0.520, & - & 0.532, 0.544, 0.557, 0.569, 0.581, 0.594, 0.606, 0.619, 0.631, & - & 0.644, 0.657, 0.669, 0.682, 0.695, 0.708, 0.721, 0.734, 0.747, & - & 0.761, 0.774, 0.787, 0.800, 0.814, 0.827, 0.841, 0.854, 0.868, & - & 0.881, 0.895, 0.908, 0.922, 0.936, 0.949, 0.963, 0.977, 0.990, & - & 1.004, 1.018, 1.031, 1.045, 1.059, 1.072, 1.086, 1.100, 1.114, & - & 1.127, 1.141, 1.155, 1.168, 1.182, 1.195, 1.209, 1.223, 1.236, & - & 1.250, 1.263, 1.277, 1.290, 1.304, 1.317, 1.331, 1.344, 1.358, & - & 1.371, 1.384, 1.398, 1.411, 1.424, 1.437, 1.451, 1.464, 1.477, & - & 1.490, 1.503, 1.516, 1.529, 1.542, 1.555, 1.568, 1.581, 1.594, & - & 1.607, 1.620, 1.633, 1.646, 1.659, 1.671, 1.684, 1.697, 1.709, & - & 1.722, 1.735, 1.747, 1.760, 1.772, 1.785, 1.798, 1.810, 1.822, & - & 1.835, 1.847, 1.860, 1.872, 1.884, 1.896, 1.909, 1.921, 1.933, & - & 1.945, 1.957, 1.970, 1.982, 1.994, 2.006, 2.018, 2.030, 2.042, & - & 2.054, 2.065, 2.077, 2.089, 2.101, 2.113, 2.125, 2.136, 2.148, & - & 2.160, 2.171, 2.183, 2.195, 2.206, 2.218, 2.229, 2.241, 2.252, & - & 2.264, 2.275, 2.286, 2.298, 2.309, 2.320, 2.332, 2.343, 2.354, & - & 2.365, 2.377, 2.388, 2.399, 2.410, 2.421, 2.432, 2.443, 2.454, & - & 2.465, 2.476, 2.487, 2.498, 2.509, 2.520, 2.531, 2.541, 2.552, & - & 2.563, 2.574, 2.584, 2.595, 2.606, 2.616, 2.627, 2.638, 2.648, & - & 2.659, 2.669, 2.680, 2.690, 2.701, 2.711, 2.722, 2.732, 2.742, & - & 2.753, 2.763, 2.773, 2.784, 2.794, 2.804, 2.814, 2.825, 2.835, & - & 2.845, 2.855, 2.865, 2.875, 2.885, 2.895, 2.905, 2.915, 2.925, & - & 2.935, 2.945, 2.955, 2.965, 2.975, 2.985, 2.995, 3.005, 3.014, & - & 3.024, 3.034, 3.044, 3.053, 3.063, 3.073, 3.082, 3.092, 3.102, & - & 3.111, 3.121, 3.130, 3.140, 3.149, 3.159, 3.168, 3.178, 3.187, & - & 3.197, 3.206, 3.215, 3.225, 3.234, 3.243, 3.253, 3.262, 3.271, & - & 3.280, 3.290, 3.299, 3.308, 3.317, 3.326, 3.336, 3.345, 3.354, & - & 3.363, 3.372, 3.381, 3.390, 3.399, 3.408, 3.417, 3.426, 3.435, & - & 3.444, 3.453, 3.462, 3.470, 3.479, 3.488, 3.497, 3.506, 3.514, & - & 3.523, 3.532, 3.541, 3.549, 3.558, 3.567, 3.575, 3.584, 3.593, & - & 3.601, 3.610, 3.619, 3.627, 3.636, 3.644, 3.653, 3.661, 3.670, & - & 3.678, 3.687, 3.695, 3.704, 3.712, 3.720, 3.729, 3.737, 3.745, & - & 3.754, 3.762, 3.770, 3.779, 3.787, 3.795, 3.803, 3.812, 3.820, & - & 3.828, 3.836, 3.844, 3.852, 3.861, 3.869, 3.877, 3.885, 3.893, & - & 3.901, 3.909, 3.917, 3.925, 3.933, 3.941, 3.949, 3.957, 3.965, & - & 3.973, 3.981, 3.989, 3.997, 4.081, 4.158, 4.233, 4.307, 4.380, & - & 4.452, 4.522, 4.592, 4.660, 4.727, 4.793, 4.859, 4.923, 4.986, & - & 5.048, 5.110, 5.171, 5.230, 5.289, 5.347, 5.405, 5.461, 5.517, & - & 5.572, 5.626, 5.680, 5.733, 5.785, 5.837, 5.888, 5.938, 5.988, & - & 6.037, 6.085, 6.133, 6.181, 6.228, 6.274, 6.320, 6.365, 6.410, & - & 6.454, 6.498, 6.541, 6.584, 6.626, 6.668, 6.710, 6.751, 6.792, & - & 6.832, 6.872, 6.911, 6.950, 6.989, 7.027, 7.065, 7.102, 7.139, & - & 7.176, 7.212, 7.248, 7.284, 7.319, 7.354, 7.389, 7.424, 7.458, & - & 7.491, 7.525, 7.558, 7.591, 7.623, 7.656, 7.688, 7.719, 7.751, & - & 7.782, 7.813, 7.844, 7.874, 7.904, 7.934, 7.964, 7.993, 8.022, & - & 8.051, 8.080, 8.108, 8.137, 8.165, 8.192, 8.220, 8.247, 8.274, & - & 8.301, 8.328, 8.354, 8.381, 8.407, 8.433, 8.458, 8.484, 8.509, & - & 8.534, 8.559, 8.584, 8.609, 8.633, 8.657, 8.681, 8.705, 8.729, & - & 8.752, 8.776, 8.799, 8.822, 8.845, 8.868, 8.890, 8.913, 8.935, & - & 8.957, 8.979, 9.001, 9.022, 9.044, 9.065, 9.086, 9.107, 9.128, & - & 9.149, 9.170, 9.190, 9.211, 9.231, 9.251, 9.271, 9.291, 9.311, & - & 9.330, 9.350, 9.369, 9.388, 9.407, 9.426, 9.445, 9.464, 9.483, & - & 9.501, 9.520, 9.538, 9.556, 9.574, 9.592, 9.610, 9.628, 9.645, & - & 9.663, 9.680, 9.698 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.050,-0.107,-0.134,-0.153,-0.167,-0.179,-0.189,-0.197,-0.204, & - -0.211,-0.216,-0.221,-0.226,-0.230,-0.234,-0.237,-0.240,-0.243, & - -0.245,-0.247,-0.249,-0.251,-0.252,-0.254,-0.255,-0.256,-0.256, & - -0.257,-0.257,-0.258,-0.258,-0.258,-0.258,-0.258,-0.257,-0.257, & - -0.256,-0.255,-0.255,-0.254,-0.253,-0.252,-0.250,-0.249,-0.248, & - -0.246,-0.245,-0.243,-0.242,-0.240,-0.238,-0.236,-0.234,-0.232, & - -0.230,-0.228,-0.226,-0.224,-0.221,-0.219,-0.217,-0.214,-0.212, & - -0.209,-0.207,-0.204,-0.201,-0.199,-0.196,-0.193,-0.190,-0.188, & - -0.185,-0.182,-0.179,-0.176,-0.173,-0.170,-0.167,-0.163,-0.160, & - -0.157,-0.154,-0.150,-0.147,-0.144,-0.140,-0.137,-0.133,-0.130, & - -0.126,-0.123,-0.119,-0.116,-0.112,-0.108,-0.104,-0.101,-0.097, & - -0.093,-0.089,-0.086,-0.082,-0.078,-0.074,-0.070,-0.066,-0.062, & - -0.058,-0.054,-0.050,-0.046,-0.042,-0.038,-0.034,-0.030,-0.026, & - -0.022,-0.018,-0.014,-0.010,-0.006,-0.002, 0.002, 0.006, 0.010, & - & 0.014, 0.018, 0.022, 0.026, 0.030, 0.034, 0.038, 0.042, 0.046, & - & 0.050, 0.054, 0.058, 0.062, 0.066, 0.070, 0.074, 0.078, 0.082, & - & 0.086, 0.090, 0.094, 0.098, 0.102, 0.106, 0.110, 0.114, 0.117, & - & 0.121, 0.125, 0.129, 0.133, 0.137, 0.140, 0.144, 0.148, 0.152, & - & 0.156, 0.159, 0.163, 0.167, 0.171, 0.174, 0.178, 0.182, 0.186, & - & 0.189, 0.193, 0.197, 0.200, 0.204, 0.208, 0.211, 0.215, 0.219, & - & 0.222, 0.226, 0.229, 0.233, 0.237, 0.240, 0.244, 0.247, 0.251, & - & 0.254, 0.258, 0.261, 0.265, 0.268, 0.272, 0.275, 0.279, 0.282, & - & 0.286, 0.289, 0.293, 0.296, 0.299, 0.303, 0.306, 0.309, 0.313, & - & 0.316, 0.320, 0.323, 0.326, 0.330, 0.333, 0.336, 0.339, 0.343, & - & 0.346, 0.349, 0.353, 0.356, 0.359, 0.362, 0.366, 0.369, 0.372, & - & 0.375, 0.378, 0.382, 0.385, 0.388, 0.391, 0.394, 0.397, 0.401, & - & 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.422, 0.425, 0.428, & - & 0.431, 0.434, 0.438, 0.441, 0.444, 0.447, 0.450, 0.453, 0.456, & - & 0.459, 0.462, 0.465, 0.467, 0.470, 0.473, 0.476, 0.479, 0.482, & - & 0.485, 0.488, 0.491, 0.494, 0.497, 0.500, 0.502, 0.505, 0.508, & - & 0.511, 0.514, 0.517, 0.520, 0.522, 0.525, 0.528, 0.531, 0.534, & - & 0.536, 0.539, 0.542, 0.545, 0.547, 0.550, 0.553, 0.556, 0.558, & - & 0.561, 0.564, 0.567, 0.569, 0.572, 0.575, 0.577, 0.580, 0.583, & - & 0.585, 0.588, 0.591, 0.593, 0.596, 0.599, 0.601, 0.604, 0.607, & - & 0.609, 0.612, 0.614, 0.617, 0.620, 0.622, 0.625, 0.627, 0.630, & - & 0.633, 0.635, 0.638, 0.640, 0.643, 0.645, 0.648, 0.650, 0.653, & - & 0.655, 0.658, 0.660, 0.663, 0.665, 0.668, 0.670, 0.673, 0.675, & - & 0.678, 0.680, 0.683, 0.685, 0.687, 0.690, 0.692, 0.695, 0.697, & - & 0.700, 0.702, 0.704, 0.707, 0.709, 0.711, 0.714, 0.716, 0.719, & - & 0.721, 0.723, 0.726, 0.728, 0.730, 0.733, 0.735, 0.737, 0.740, & - & 0.742, 0.744, 0.747, 0.749, 0.751, 0.754, 0.756, 0.758, 0.760, & - & 0.763, 0.765, 0.767, 0.769, 0.772, 0.774, 0.776, 0.778, 0.781, & - & 0.783, 0.785, 0.787, 0.790, 0.792, 0.794, 0.796, 0.798, 0.801, & - & 0.803, 0.805, 0.807, 0.809, 0.811, 0.814, 0.816, 0.818, 0.820, & - & 0.822, 0.824, 0.827, 0.829, 0.851, 0.872, 0.892, 0.912, 0.932, & - & 0.951, 0.969, 0.988, 1.006, 1.024, 1.041, 1.058, 1.075, 1.091, & - & 1.107, 1.123, 1.139, 1.154, 1.169, 1.184, 1.199, 1.213, 1.227, & - & 1.241, 1.255, 1.268, 1.282, 1.295, 1.307, 1.320, 1.332, 1.345, & - & 1.357, 1.368, 1.380, 1.392, 1.403, 1.414, 1.425, 1.436, 1.446, & - & 1.457, 1.467, 1.478, 1.488, 1.497, 1.507, 1.517, 1.526, 1.536, & - & 1.545, 1.554, 1.563, 1.572, 1.580, 1.589, 1.597, 1.606, 1.614, & - & 1.622, 1.630, 1.638, 1.646, 1.653, 1.661, 1.668, 1.676, 1.683, & - & 1.690, 1.697, 1.704, 1.711, 1.718, 1.724, 1.731, 1.737, 1.744, & - & 1.750, 1.756, 1.762, 1.769, 1.775, 1.780, 1.786, 1.792, 1.798, & - & 1.803, 1.809, 1.814, 1.820, 1.825, 1.830, 1.835, 1.840, 1.845, & - & 1.850, 1.855, 1.860, 1.865, 1.870, 1.874, 1.879, 1.883, 1.888, & - & 1.892, 1.896, 1.901, 1.905, 1.909, 1.913, 1.917, 1.921, 1.925, & - & 1.929, 1.933, 1.936, 1.940, 1.944, 1.947, 1.951, 1.955, 1.958, & - & 1.961, 1.965, 1.968, 1.971, 1.975, 1.978, 1.981, 1.984, 1.987, & - & 1.990, 1.993, 1.996, 1.999, 2.001, 2.004, 2.007, 2.010, 2.012, & - & 2.015, 2.017, 2.020, 2.022, 2.025, 2.027, 2.030, 2.032, 2.034, & - & 2.037, 2.039, 2.041, 2.043, 2.045, 2.047, 2.049, 2.051, 2.053, & - & 2.055, 2.057, 2.059 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.049,-0.102,-0.125,-0.140,-0.150,-0.158,-0.163,-0.168,-0.171, & - -0.174,-0.176,-0.178,-0.179,-0.179,-0.179,-0.179,-0.179,-0.179, & - -0.178,-0.177,-0.176,-0.175,-0.174,-0.172,-0.171,-0.169,-0.168, & - -0.166,-0.164,-0.162,-0.160,-0.158,-0.156,-0.154,-0.152,-0.150, & - -0.148,-0.146,-0.144,-0.141,-0.139,-0.137,-0.135,-0.132,-0.130, & - -0.128,-0.126,-0.123,-0.121,-0.119,-0.116,-0.114,-0.112,-0.109, & - -0.107,-0.105,-0.102,-0.100,-0.098,-0.095,-0.093,-0.091,-0.088, & - -0.086,-0.084,-0.081,-0.079,-0.077,-0.074,-0.072,-0.070,-0.067, & - -0.065,-0.062,-0.060,-0.057,-0.055,-0.052,-0.050,-0.048,-0.045, & - -0.042,-0.040,-0.037,-0.035,-0.032,-0.030,-0.027,-0.024,-0.022, & - -0.019,-0.016,-0.013,-0.011,-0.008,-0.005,-0.002, 0.001, 0.003, & - & 0.006, 0.009, 0.012, 0.015, 0.018, 0.021, 0.024, 0.027, 0.030, & - & 0.033, 0.036, 0.039, 0.042, 0.045, 0.048, 0.051, 0.054, 0.057, & - & 0.060, 0.063, 0.066, 0.069, 0.072, 0.075, 0.078, 0.081, 0.084, & - & 0.087, 0.091, 0.094, 0.097, 0.100, 0.103, 0.106, 0.109, 0.112, & - & 0.115, 0.118, 0.121, 0.124, 0.127, 0.130, 0.133, 0.136, 0.139, & - & 0.142, 0.146, 0.149, 0.152, 0.155, 0.158, 0.161, 0.164, 0.167, & - & 0.170, 0.173, 0.176, 0.179, 0.182, 0.185, 0.188, 0.191, 0.193, & - & 0.196, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, 0.217, 0.220, & - & 0.223, 0.226, 0.229, 0.232, 0.235, 0.237, 0.240, 0.243, 0.246, & - & 0.249, 0.252, 0.255, 0.258, 0.260, 0.263, 0.266, 0.269, 0.272, & - & 0.275, 0.278, 0.280, 0.283, 0.286, 0.289, 0.292, 0.294, 0.297, & - & 0.300, 0.303, 0.306, 0.308, 0.311, 0.314, 0.317, 0.319, 0.322, & - & 0.325, 0.328, 0.330, 0.333, 0.336, 0.339, 0.341, 0.344, 0.347, & - & 0.349, 0.352, 0.355, 0.358, 0.360, 0.363, 0.366, 0.368, 0.371, & - & 0.374, 0.376, 0.379, 0.382, 0.384, 0.387, 0.389, 0.392, 0.395, & - & 0.397, 0.400, 0.403, 0.405, 0.408, 0.410, 0.413, 0.415, 0.418, & - & 0.421, 0.423, 0.426, 0.428, 0.431, 0.433, 0.436, 0.438, 0.441, & - & 0.444, 0.446, 0.449, 0.451, 0.454, 0.456, 0.459, 0.461, 0.464, & - & 0.466, 0.469, 0.471, 0.473, 0.476, 0.478, 0.481, 0.483, 0.486, & - & 0.488, 0.491, 0.493, 0.495, 0.498, 0.500, 0.503, 0.505, 0.508, & - & 0.510, 0.512, 0.515, 0.517, 0.519, 0.522, 0.524, 0.527, 0.529, & - & 0.531, 0.534, 0.536, 0.538, 0.541, 0.543, 0.545, 0.548, 0.550, & - & 0.552, 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.568, 0.571, & - & 0.573, 0.575, 0.578, 0.580, 0.582, 0.584, 0.587, 0.589, 0.591, & - & 0.593, 0.595, 0.598, 0.600, 0.602, 0.604, 0.607, 0.609, 0.611, & - & 0.613, 0.615, 0.618, 0.620, 0.622, 0.624, 0.626, 0.628, 0.631, & - & 0.633, 0.635, 0.637, 0.639, 0.641, 0.644, 0.646, 0.648, 0.650, & - & 0.652, 0.654, 0.656, 0.658, 0.660, 0.663, 0.665, 0.667, 0.669, & - & 0.671, 0.673, 0.675, 0.677, 0.679, 0.681, 0.683, 0.685, 0.688, & - & 0.690, 0.692, 0.694, 0.696, 0.698, 0.700, 0.702, 0.704, 0.706, & - & 0.708, 0.710, 0.712, 0.714, 0.716, 0.718, 0.720, 0.722, 0.724, & - & 0.726, 0.728, 0.730, 0.732, 0.734, 0.736, 0.738, 0.740, 0.742, & - & 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.755, 0.757, 0.759, & - & 0.761, 0.763, 0.765, 0.767, 0.787, 0.805, 0.824, 0.841, 0.859, & - & 0.876, 0.893, 0.909, 0.926, 0.942, 0.957, 0.973, 0.988, 1.003, & - & 1.017, 1.032, 1.046, 1.060, 1.073, 1.087, 1.100, 1.113, 1.126, & - & 1.138, 1.151, 1.163, 1.175, 1.187, 1.198, 1.210, 1.221, 1.232, & - & 1.243, 1.253, 1.264, 1.274, 1.285, 1.295, 1.305, 1.314, 1.324, & - & 1.333, 1.343, 1.352, 1.361, 1.370, 1.378, 1.387, 1.395, 1.404, & - & 1.412, 1.420, 1.428, 1.436, 1.444, 1.451, 1.459, 1.466, 1.474, & - & 1.481, 1.488, 1.495, 1.502, 1.509, 1.515, 1.522, 1.529, 1.535, & - & 1.541, 1.548, 1.554, 1.560, 1.566, 1.572, 1.577, 1.583, 1.589, & - & 1.594, 1.600, 1.605, 1.610, 1.616, 1.621, 1.626, 1.631, 1.636, & - & 1.641, 1.645, 1.650, 1.655, 1.659, 1.664, 1.668, 1.673, 1.677, & - & 1.681, 1.685, 1.690, 1.694, 1.698, 1.702, 1.705, 1.709, 1.713, & - & 1.717, 1.720, 1.724, 1.728, 1.731, 1.734, 1.738, 1.741, 1.744, & - & 1.748, 1.751, 1.754, 1.757, 1.760, 1.763, 1.766, 1.769, 1.772, & - & 1.775, 1.777, 1.780, 1.783, 1.785, 1.788, 1.790, 1.793, 1.795, & - & 1.798, 1.800, 1.802, 1.805, 1.807, 1.809, 1.811, 1.813, 1.815, & - & 1.817, 1.819, 1.821, 1.823, 1.825, 1.827, 1.829, 1.831, 1.832, & - & 1.834, 1.836, 1.838, 1.839, 1.841, 1.842, 1.844, 1.845, 1.847, & - & 1.848, 1.849, 1.851 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.048,-0.094,-0.112,-0.122,-0.128,-0.131,-0.133,-0.133,-0.133, & - -0.131,-0.129,-0.126,-0.123,-0.119,-0.116,-0.111,-0.107,-0.102, & - -0.097,-0.092,-0.086,-0.080,-0.075,-0.069,-0.062,-0.056,-0.050, & - -0.043,-0.037,-0.030,-0.023,-0.016,-0.009,-0.002, 0.005, 0.012, & - & 0.020, 0.027, 0.035, 0.042, 0.050, 0.057, 0.065, 0.072, 0.080, & - & 0.088, 0.095, 0.103, 0.111, 0.119, 0.126, 0.134, 0.142, 0.150, & - & 0.158, 0.166, 0.174, 0.182, 0.190, 0.198, 0.206, 0.214, 0.222, & - & 0.230, 0.238, 0.246, 0.254, 0.262, 0.270, 0.278, 0.287, 0.295, & - & 0.303, 0.311, 0.320, 0.328, 0.336, 0.345, 0.353, 0.362, 0.370, & - & 0.379, 0.387, 0.396, 0.405, 0.413, 0.422, 0.431, 0.440, 0.449, & - & 0.457, 0.466, 0.475, 0.484, 0.494, 0.503, 0.512, 0.521, 0.530, & - & 0.540, 0.549, 0.558, 0.568, 0.577, 0.587, 0.596, 0.606, 0.615, & - & 0.625, 0.634, 0.644, 0.653, 0.663, 0.673, 0.682, 0.692, 0.702, & - & 0.711, 0.721, 0.731, 0.740, 0.750, 0.760, 0.769, 0.779, 0.789, & - & 0.798, 0.808, 0.818, 0.827, 0.837, 0.847, 0.856, 0.866, 0.875, & - & 0.885, 0.895, 0.904, 0.914, 0.923, 0.933, 0.942, 0.952, 0.961, & - & 0.971, 0.980, 0.990, 0.999, 1.009, 1.018, 1.027, 1.037, 1.046, & - & 1.055, 1.065, 1.074, 1.083, 1.093, 1.102, 1.111, 1.120, 1.130, & - & 1.139, 1.148, 1.157, 1.166, 1.175, 1.184, 1.194, 1.203, 1.212, & - & 1.221, 1.230, 1.239, 1.248, 1.257, 1.266, 1.275, 1.283, 1.292, & - & 1.301, 1.310, 1.319, 1.328, 1.336, 1.345, 1.354, 1.363, 1.372, & - & 1.380, 1.389, 1.398, 1.406, 1.415, 1.423, 1.432, 1.441, 1.449, & - & 1.458, 1.466, 1.475, 1.483, 1.492, 1.500, 1.509, 1.517, 1.526, & - & 1.534, 1.542, 1.551, 1.559, 1.567, 1.576, 1.584, 1.592, 1.600, & - & 1.609, 1.617, 1.625, 1.633, 1.641, 1.649, 1.658, 1.666, 1.674, & - & 1.682, 1.690, 1.698, 1.706, 1.714, 1.722, 1.730, 1.738, 1.746, & - & 1.754, 1.762, 1.769, 1.777, 1.785, 1.793, 1.801, 1.809, 1.816, & - & 1.824, 1.832, 1.840, 1.847, 1.855, 1.863, 1.870, 1.878, 1.886, & - & 1.893, 1.901, 1.908, 1.916, 1.924, 1.931, 1.939, 1.946, 1.954, & - & 1.961, 1.969, 1.976, 1.983, 1.991, 1.998, 2.006, 2.013, 2.020, & - & 2.028, 2.035, 2.042, 2.049, 2.057, 2.064, 2.071, 2.078, 2.086, & - & 2.093, 2.100, 2.107, 2.114, 2.122, 2.129, 2.136, 2.143, 2.150, & - & 2.157, 2.164, 2.171, 2.178, 2.185, 2.192, 2.199, 2.206, 2.213, & - & 2.220, 2.227, 2.234, 2.241, 2.247, 2.254, 2.261, 2.268, 2.275, & - & 2.282, 2.288, 2.295, 2.302, 2.309, 2.315, 2.322, 2.329, 2.336, & - & 2.342, 2.349, 2.356, 2.362, 2.369, 2.376, 2.382, 2.389, 2.395, & - & 2.402, 2.408, 2.415, 2.421, 2.428, 2.434, 2.441, 2.447, 2.454, & - & 2.460, 2.467, 2.473, 2.480, 2.486, 2.492, 2.499, 2.505, 2.512, & - & 2.518, 2.524, 2.531, 2.537, 2.543, 2.549, 2.556, 2.562, 2.568, & - & 2.574, 2.581, 2.587, 2.593, 2.599, 2.605, 2.612, 2.618, 2.624, & - & 2.630, 2.636, 2.642, 2.648, 2.654, 2.660, 2.666, 2.672, 2.679, & - & 2.685, 2.691, 2.697, 2.703, 2.709, 2.714, 2.720, 2.726, 2.732, & - & 2.738, 2.744, 2.750, 2.756, 2.762, 2.768, 2.774, 2.779, 2.785, & - & 2.791, 2.797, 2.803, 2.808, 2.814, 2.820, 2.826, 2.832, 2.837, & - & 2.843, 2.849, 2.854, 2.860, 2.921, 2.976, 3.031, 3.084, 3.137, & - & 3.189, 3.240, 3.290, 3.339, 3.387, 3.435, 3.482, 3.528, 3.574, & - & 3.619, 3.663, 3.706, 3.749, 3.792, 3.833, 3.874, 3.915, 3.955, & - & 3.994, 4.033, 4.072, 4.109, 4.147, 4.184, 4.220, 4.256, 4.291, & - & 4.327, 4.361, 4.395, 4.429, 4.462, 4.495, 4.528, 4.560, 4.592, & - & 4.623, 4.654, 4.685, 4.716, 4.746, 4.775, 4.805, 4.834, 4.862, & - & 4.891, 4.919, 4.947, 4.974, 5.001, 5.028, 5.055, 5.081, 5.107, & - & 5.133, 5.159, 5.184, 5.209, 5.234, 5.259, 5.283, 5.307, 5.331, & - & 5.355, 5.378, 5.401, 5.424, 5.447, 5.469, 5.492, 5.514, 5.536, & - & 5.557, 5.579, 5.600, 5.621, 5.642, 5.663, 5.684, 5.704, 5.724, & - & 5.744, 5.764, 5.784, 5.803, 5.823, 5.842, 5.861, 5.880, 5.898, & - & 5.917, 5.935, 5.953, 5.972, 5.989, 6.007, 6.025, 6.042, 6.060, & - & 6.077, 6.094, 6.111, 6.128, 6.144, 6.161, 6.177, 6.194, 6.210, & - & 6.226, 6.242, 6.257, 6.273, 6.289, 6.304, 6.319, 6.334, 6.350, & - & 6.365, 6.379, 6.394, 6.409, 6.423, 6.438, 6.452, 6.466, 6.480, & - & 6.494, 6.508, 6.522, 6.536, 6.549, 6.563, 6.576, 6.589, 6.602, & - & 6.616, 6.629, 6.641, 6.654, 6.667, 6.680, 6.692, 6.705, 6.717, & - & 6.729, 6.742, 6.754, 6.766, 6.778, 6.790, 6.801, 6.813, 6.825, & - & 6.836, 6.848, 6.859 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.049,-0.101,-0.125,-0.140,-0.151,-0.159,-0.166,-0.171,-0.175, & - -0.178,-0.181,-0.183,-0.184,-0.185,-0.186,-0.186,-0.186,-0.186, & - -0.186,-0.185,-0.184,-0.183,-0.181,-0.180,-0.178,-0.176,-0.174, & - -0.172,-0.170,-0.167,-0.165,-0.162,-0.159,-0.156,-0.153,-0.150, & - -0.147,-0.144,-0.140,-0.137,-0.133,-0.130,-0.126,-0.122,-0.118, & - -0.114,-0.110,-0.106,-0.102,-0.098,-0.094,-0.090,-0.085,-0.081, & - -0.076,-0.072,-0.068,-0.063,-0.058,-0.054,-0.049,-0.044,-0.040, & - -0.035,-0.030,-0.025,-0.020,-0.015,-0.010,-0.005, 0.000, 0.005, & - & 0.010, 0.015, 0.020, 0.026, 0.031, 0.036, 0.042, 0.047, 0.052, & - & 0.058, 0.063, 0.069, 0.075, 0.080, 0.086, 0.092, 0.097, 0.103, & - & 0.109, 0.115, 0.121, 0.127, 0.133, 0.139, 0.145, 0.151, 0.157, & - & 0.163, 0.169, 0.175, 0.181, 0.188, 0.194, 0.200, 0.206, 0.213, & - & 0.219, 0.225, 0.232, 0.238, 0.244, 0.251, 0.257, 0.264, 0.270, & - & 0.276, 0.283, 0.289, 0.296, 0.302, 0.308, 0.315, 0.321, 0.328, & - & 0.334, 0.341, 0.347, 0.353, 0.360, 0.366, 0.373, 0.379, 0.385, & - & 0.392, 0.398, 0.404, 0.411, 0.417, 0.423, 0.430, 0.436, 0.442, & - & 0.448, 0.455, 0.461, 0.467, 0.473, 0.480, 0.486, 0.492, 0.498, & - & 0.504, 0.510, 0.517, 0.523, 0.529, 0.535, 0.541, 0.547, 0.553, & - & 0.559, 0.565, 0.571, 0.577, 0.583, 0.589, 0.595, 0.601, 0.607, & - & 0.613, 0.619, 0.625, 0.631, 0.637, 0.642, 0.648, 0.654, 0.660, & - & 0.666, 0.671, 0.677, 0.683, 0.689, 0.694, 0.700, 0.706, 0.712, & - & 0.717, 0.723, 0.729, 0.734, 0.740, 0.746, 0.751, 0.757, 0.762, & - & 0.768, 0.773, 0.779, 0.785, 0.790, 0.796, 0.801, 0.807, 0.812, & - & 0.817, 0.823, 0.828, 0.834, 0.839, 0.845, 0.850, 0.855, 0.861, & - & 0.866, 0.871, 0.877, 0.882, 0.887, 0.893, 0.898, 0.903, 0.908, & - & 0.914, 0.919, 0.924, 0.929, 0.934, 0.939, 0.945, 0.950, 0.955, & - & 0.960, 0.965, 0.970, 0.975, 0.980, 0.986, 0.991, 0.996, 1.001, & - & 1.006, 1.011, 1.016, 1.021, 1.026, 1.031, 1.036, 1.041, 1.046, & - & 1.050, 1.055, 1.060, 1.065, 1.070, 1.075, 1.080, 1.085, 1.089, & - & 1.094, 1.099, 1.104, 1.109, 1.114, 1.118, 1.123, 1.128, 1.133, & - & 1.137, 1.142, 1.147, 1.151, 1.156, 1.161, 1.165, 1.170, 1.175, & - & 1.179, 1.184, 1.189, 1.193, 1.198, 1.203, 1.207, 1.212, 1.216, & - & 1.221, 1.225, 1.230, 1.234, 1.239, 1.243, 1.248, 1.252, 1.257, & - & 1.261, 1.266, 1.270, 1.275, 1.279, 1.284, 1.288, 1.293, 1.297, & - & 1.301, 1.306, 1.310, 1.314, 1.319, 1.323, 1.327, 1.332, 1.336, & - & 1.340, 1.345, 1.349, 1.353, 1.358, 1.362, 1.366, 1.370, 1.375, & - & 1.379, 1.383, 1.387, 1.391, 1.396, 1.400, 1.404, 1.408, 1.412, & - & 1.417, 1.421, 1.425, 1.429, 1.433, 1.437, 1.441, 1.445, 1.450, & - & 1.454, 1.458, 1.462, 1.466, 1.470, 1.474, 1.478, 1.482, 1.486, & - & 1.490, 1.494, 1.498, 1.502, 1.506, 1.510, 1.514, 1.518, 1.522, & - & 1.526, 1.530, 1.534, 1.538, 1.542, 1.546, 1.549, 1.553, 1.557, & - & 1.561, 1.565, 1.569, 1.573, 1.577, 1.580, 1.584, 1.588, 1.592, & - & 1.596, 1.600, 1.603, 1.607, 1.611, 1.615, 1.618, 1.622, 1.626, & - & 1.630, 1.633, 1.637, 1.641, 1.645, 1.648, 1.652, 1.656, 1.660, & - & 1.663, 1.667, 1.671, 1.674, 1.714, 1.749, 1.784, 1.819, 1.853, & - & 1.886, 1.919, 1.951, 1.982, 2.014, 2.044, 2.074, 2.104, 2.133, & - & 2.162, 2.190, 2.218, 2.246, 2.273, 2.300, 2.326, 2.352, 2.377, & - & 2.403, 2.427, 2.452, 2.476, 2.500, 2.523, 2.547, 2.569, 2.592, & - & 2.614, 2.636, 2.658, 2.679, 2.700, 2.721, 2.742, 2.762, 2.782, & - & 2.802, 2.822, 2.841, 2.860, 2.879, 2.898, 2.916, 2.934, 2.952, & - & 2.970, 2.988, 3.005, 3.022, 3.039, 3.056, 3.073, 3.089, 3.105, & - & 3.121, 3.137, 3.153, 3.168, 3.184, 3.199, 3.214, 3.229, 3.244, & - & 3.258, 3.273, 3.287, 3.301, 3.315, 3.329, 3.342, 3.356, 3.369, & - & 3.382, 3.395, 3.408, 3.421, 3.434, 3.446, 3.459, 3.471, 3.483, & - & 3.496, 3.507, 3.519, 3.531, 3.543, 3.554, 3.566, 3.577, 3.588, & - & 3.599, 3.610, 3.621, 3.632, 3.642, 3.653, 3.663, 3.674, 3.684, & - & 3.694, 3.704, 3.714, 3.724, 3.734, 3.743, 3.753, 3.762, 3.772, & - & 3.781, 3.790, 3.800, 3.809, 3.818, 3.826, 3.835, 3.844, 3.853, & - & 3.861, 3.870, 3.878, 3.887, 3.895, 3.903, 3.911, 3.919, 3.927, & - & 3.935, 3.943, 3.951, 3.959, 3.966, 3.974, 3.981, 3.989, 3.996, & - & 4.004, 4.011, 4.018, 4.025, 4.032, 4.039, 4.046, 4.053, 4.060, & - & 4.067, 4.073, 4.080, 4.087, 4.093, 4.100, 4.106, 4.113, 4.119, & - & 4.125, 4.131, 4.138 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.082,-0.178,-0.227,-0.261,-0.288,-0.311,-0.330,-0.347,-0.363, & - -0.377,-0.389,-0.401,-0.412,-0.422,-0.431,-0.440,-0.449,-0.457, & - -0.464,-0.471,-0.478,-0.485,-0.491,-0.497,-0.503,-0.508,-0.514, & - -0.519,-0.524,-0.529,-0.533,-0.538,-0.542,-0.546,-0.550,-0.554, & - -0.557,-0.561,-0.565,-0.568,-0.571,-0.574,-0.578,-0.581,-0.583, & - -0.586,-0.589,-0.592,-0.594,-0.597,-0.599,-0.602,-0.604,-0.606, & - -0.608,-0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.622,-0.624, & - -0.625,-0.627,-0.629,-0.630,-0.632,-0.633,-0.635,-0.636,-0.637, & - -0.639,-0.640,-0.641,-0.643,-0.644,-0.645,-0.646,-0.647,-0.648, & - -0.649,-0.650,-0.651,-0.652,-0.653,-0.654,-0.655,-0.656,-0.657, & - -0.658,-0.658,-0.659,-0.660,-0.661,-0.661,-0.662,-0.663,-0.663, & - -0.664,-0.665,-0.665,-0.666,-0.666,-0.667,-0.667,-0.668,-0.668, & - -0.669,-0.669,-0.670,-0.670,-0.671,-0.671,-0.671,-0.672,-0.672, & - -0.673,-0.673,-0.673,-0.674,-0.674,-0.674,-0.675,-0.675,-0.675, & - -0.676,-0.676,-0.676,-0.676,-0.677,-0.677,-0.677,-0.677,-0.678, & - -0.678,-0.678,-0.679,-0.679,-0.679,-0.679,-0.679,-0.680,-0.680, & - -0.680,-0.680,-0.681,-0.681,-0.681,-0.681,-0.681,-0.682,-0.682, & - -0.682,-0.682,-0.682,-0.683,-0.683,-0.683,-0.683,-0.683,-0.684, & - -0.684,-0.684,-0.684,-0.684,-0.685,-0.685,-0.685,-0.685,-0.685, & - -0.686,-0.686,-0.686,-0.686,-0.686,-0.687,-0.687,-0.687,-0.687, & - -0.687,-0.687,-0.688,-0.688,-0.688,-0.688,-0.688,-0.689,-0.689, & - -0.689,-0.689,-0.689,-0.690,-0.690,-0.690,-0.690,-0.690,-0.691, & - -0.691,-0.691,-0.691,-0.691,-0.691,-0.692,-0.692,-0.692,-0.692, & - -0.692,-0.693,-0.693,-0.693,-0.693,-0.693,-0.694,-0.694,-0.694, & - -0.694,-0.694,-0.695,-0.695,-0.695,-0.695,-0.695,-0.696,-0.696, & - -0.696,-0.696,-0.696,-0.697,-0.697,-0.697,-0.697,-0.698,-0.698, & - -0.698,-0.698,-0.698,-0.699,-0.699,-0.699,-0.699,-0.699,-0.700, & - -0.700,-0.700,-0.700,-0.701,-0.701,-0.701,-0.701,-0.702,-0.702, & - -0.702,-0.702,-0.702,-0.703,-0.703,-0.703,-0.703,-0.704,-0.704, & - -0.704,-0.704,-0.705,-0.705,-0.705,-0.705,-0.706,-0.706,-0.706, & - -0.706,-0.706,-0.707,-0.707,-0.707,-0.707,-0.708,-0.708,-0.708, & - -0.708,-0.709,-0.709,-0.709,-0.710,-0.710,-0.710,-0.710,-0.711, & - -0.711,-0.711,-0.711,-0.712,-0.712,-0.712,-0.712,-0.713,-0.713, & - -0.713,-0.713,-0.714,-0.714,-0.714,-0.715,-0.715,-0.715,-0.715, & - -0.716,-0.716,-0.716,-0.716,-0.717,-0.717,-0.717,-0.718,-0.718, & - -0.718,-0.718,-0.719,-0.719,-0.719,-0.720,-0.720,-0.720,-0.720, & - -0.721,-0.721,-0.721,-0.722,-0.722,-0.722,-0.723,-0.723,-0.723, & - -0.723,-0.724,-0.724,-0.724,-0.725,-0.725,-0.725,-0.726,-0.726, & - -0.726,-0.727,-0.727,-0.727,-0.727,-0.728,-0.728,-0.728,-0.729, & - -0.729,-0.729,-0.730,-0.730,-0.730,-0.731,-0.731,-0.731,-0.732, & - -0.732,-0.732,-0.733,-0.733,-0.733,-0.733,-0.734,-0.734,-0.734, & - -0.735,-0.735,-0.735,-0.736,-0.736,-0.736,-0.737,-0.737,-0.737, & - -0.738,-0.738,-0.738,-0.739,-0.739,-0.740,-0.740,-0.740,-0.741, & - -0.741,-0.741,-0.742,-0.742,-0.742,-0.743,-0.743,-0.743,-0.744, & - -0.744,-0.744,-0.745,-0.745,-0.749,-0.753,-0.756,-0.760,-0.764, & - -0.768,-0.772,-0.776,-0.780,-0.784,-0.788,-0.793,-0.797,-0.801, & - -0.806,-0.810,-0.815,-0.820,-0.824,-0.829,-0.834,-0.839,-0.844, & - -0.848,-0.853,-0.858,-0.863,-0.869,-0.874,-0.879,-0.884,-0.889, & - -0.895,-0.900,-0.905,-0.911,-0.916,-0.922,-0.927,-0.933,-0.938, & - -0.944,-0.950,-0.955,-0.961,-0.967,-0.972,-0.978,-0.984,-0.990, & - -0.996,-1.002,-1.008,-1.014,-1.020,-1.026,-1.032,-1.038,-1.044, & - -1.050,-1.056,-1.062,-1.068,-1.075,-1.081,-1.087,-1.093,-1.100, & - -1.106,-1.112,-1.119,-1.125,-1.131,-1.138,-1.144,-1.151,-1.157, & - -1.164,-1.170,-1.177,-1.183,-1.190,-1.196,-1.203,-1.209,-1.216, & - -1.223,-1.229,-1.236,-1.243,-1.249,-1.256,-1.263,-1.270,-1.276, & - -1.283,-1.290,-1.297,-1.304,-1.310,-1.317,-1.324,-1.331,-1.338, & - -1.345,-1.352,-1.359,-1.365,-1.372,-1.379,-1.386,-1.393,-1.400, & - -1.407,-1.414,-1.421,-1.428,-1.435,-1.442,-1.450,-1.457,-1.464, & - -1.471,-1.478,-1.485,-1.492,-1.499,-1.506,-1.514,-1.521,-1.528, & - -1.535,-1.542,-1.549,-1.557,-1.564,-1.571,-1.578,-1.586,-1.593, & - -1.600,-1.607,-1.615,-1.622,-1.629,-1.636,-1.644,-1.651,-1.658, & - -1.666,-1.673,-1.680,-1.688,-1.695,-1.702,-1.710,-1.717,-1.725, & - -1.732,-1.739,-1.747 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.101,-0.216,-0.271,-0.308,-0.337,-0.360,-0.379,-0.396,-0.410, & - -0.422,-0.433,-0.443,-0.452,-0.460,-0.468,-0.475,-0.481,-0.487, & - -0.492,-0.497,-0.502,-0.506,-0.510,-0.514,-0.517,-0.520,-0.524, & - -0.526,-0.529,-0.532,-0.534,-0.537,-0.539,-0.541,-0.543,-0.545, & - -0.547,-0.549,-0.550,-0.552,-0.553,-0.555,-0.556,-0.558,-0.559, & - -0.560,-0.561,-0.563,-0.564,-0.565,-0.566,-0.567,-0.568,-0.569, & - -0.570,-0.571,-0.572,-0.572,-0.573,-0.574,-0.575,-0.576,-0.576, & - -0.577,-0.578,-0.578,-0.579,-0.580,-0.580,-0.581,-0.581,-0.582, & - -0.582,-0.583,-0.583,-0.584,-0.584,-0.585,-0.585,-0.585,-0.586, & - -0.586,-0.586,-0.586,-0.587,-0.587,-0.587,-0.587,-0.587,-0.587, & - -0.587,-0.588,-0.588,-0.588,-0.588,-0.588,-0.587,-0.587,-0.587, & - -0.587,-0.587,-0.587,-0.587,-0.587,-0.586,-0.586,-0.586,-0.586, & - -0.585,-0.585,-0.585,-0.585,-0.584,-0.584,-0.584,-0.583,-0.583, & - -0.583,-0.582,-0.582,-0.581,-0.581,-0.581,-0.580,-0.580,-0.579, & - -0.579,-0.579,-0.578,-0.578,-0.577,-0.577,-0.576,-0.576,-0.576, & - -0.575,-0.575,-0.574,-0.574,-0.573,-0.573,-0.572,-0.572,-0.571, & - -0.571,-0.570,-0.570,-0.570,-0.569,-0.569,-0.568,-0.568,-0.567, & - -0.567,-0.566,-0.566,-0.565,-0.565,-0.564,-0.564,-0.563,-0.563, & - -0.562,-0.562,-0.562,-0.561,-0.561,-0.560,-0.560,-0.559,-0.559, & - -0.558,-0.558,-0.557,-0.557,-0.556,-0.556,-0.555,-0.555,-0.554, & - -0.554,-0.554,-0.553,-0.553,-0.552,-0.552,-0.551,-0.551,-0.550, & - -0.550,-0.549,-0.549,-0.548,-0.548,-0.548,-0.547,-0.547,-0.546, & - -0.546,-0.545,-0.545,-0.544,-0.544,-0.544,-0.543,-0.543,-0.542, & - -0.542,-0.541,-0.541,-0.540,-0.540,-0.540,-0.539,-0.539,-0.538, & - -0.538,-0.537,-0.537,-0.537,-0.536,-0.536,-0.535,-0.535,-0.535, & - -0.534,-0.534,-0.533,-0.533,-0.533,-0.532,-0.532,-0.531,-0.531, & - -0.531,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.527, & - -0.527,-0.527,-0.526,-0.526,-0.525,-0.525,-0.525,-0.524,-0.524, & - -0.524,-0.523,-0.523,-0.523,-0.522,-0.522,-0.521,-0.521,-0.521, & - -0.520,-0.520,-0.520,-0.519,-0.519,-0.519,-0.518,-0.518,-0.518, & - -0.517,-0.517,-0.517,-0.516,-0.516,-0.516,-0.515,-0.515,-0.515, & - -0.514,-0.514,-0.514,-0.513,-0.513,-0.513,-0.512,-0.512,-0.512, & - -0.512,-0.511,-0.511,-0.511,-0.510,-0.510,-0.510,-0.509,-0.509, & - -0.509,-0.509,-0.508,-0.508,-0.508,-0.507,-0.507,-0.507,-0.507, & - -0.506,-0.506,-0.506,-0.506,-0.505,-0.505,-0.505,-0.504,-0.504, & - -0.504,-0.504,-0.503,-0.503,-0.503,-0.503,-0.502,-0.502,-0.502, & - -0.502,-0.501,-0.501,-0.501,-0.501,-0.501,-0.500,-0.500,-0.500, & - -0.500,-0.499,-0.499,-0.499,-0.499,-0.499,-0.498,-0.498,-0.498, & - -0.498,-0.497,-0.497,-0.497,-0.497,-0.497,-0.496,-0.496,-0.496, & - -0.496,-0.496,-0.495,-0.495,-0.495,-0.495,-0.495,-0.495,-0.494, & - -0.494,-0.494,-0.494,-0.494,-0.493,-0.493,-0.493,-0.493,-0.493, & - -0.493,-0.492,-0.492,-0.492,-0.492,-0.492,-0.492,-0.491,-0.491, & - -0.491,-0.491,-0.491,-0.491,-0.491,-0.490,-0.490,-0.490,-0.490, & - -0.490,-0.490,-0.490,-0.489,-0.489,-0.489,-0.489,-0.489,-0.489, & - -0.489,-0.489,-0.488,-0.488,-0.487,-0.486,-0.485,-0.485,-0.484, & - -0.484,-0.484,-0.484,-0.484,-0.484,-0.484,-0.485,-0.485,-0.486, & - -0.487,-0.488,-0.489,-0.490,-0.491,-0.492,-0.494,-0.495,-0.497, & - -0.499,-0.501,-0.503,-0.505,-0.507,-0.509,-0.511,-0.514,-0.516, & - -0.519,-0.522,-0.524,-0.527,-0.530,-0.533,-0.536,-0.539,-0.543, & - -0.546,-0.549,-0.553,-0.556,-0.560,-0.563,-0.567,-0.571,-0.575, & - -0.578,-0.582,-0.586,-0.590,-0.595,-0.599,-0.603,-0.607,-0.612, & - -0.616,-0.620,-0.625,-0.629,-0.634,-0.639,-0.643,-0.648,-0.653, & - -0.658,-0.663,-0.668,-0.673,-0.678,-0.683,-0.688,-0.693,-0.698, & - -0.703,-0.709,-0.714,-0.719,-0.725,-0.730,-0.736,-0.741,-0.747, & - -0.752,-0.758,-0.764,-0.769,-0.775,-0.781,-0.787,-0.792,-0.798, & - -0.804,-0.810,-0.816,-0.822,-0.828,-0.834,-0.840,-0.846,-0.853, & - -0.859,-0.865,-0.871,-0.877,-0.884,-0.890,-0.896,-0.903,-0.909, & - -0.916,-0.922,-0.929,-0.935,-0.942,-0.948,-0.955,-0.961,-0.968, & - -0.975,-0.981,-0.988,-0.995,-1.001,-1.008,-1.015,-1.022,-1.029, & - -1.036,-1.042,-1.049,-1.056,-1.063,-1.070,-1.077,-1.084,-1.091, & - -1.098,-1.105,-1.112,-1.119,-1.127,-1.134,-1.141,-1.148,-1.155, & - -1.162,-1.170,-1.177,-1.184,-1.191,-1.199,-1.206,-1.213,-1.221, & - -1.228,-1.235,-1.243 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.099,-0.205,-0.252,-0.282,-0.304,-0.320,-0.332,-0.342,-0.350, & - -0.356,-0.361,-0.364,-0.367,-0.369,-0.370,-0.371,-0.371,-0.371, & - -0.370,-0.370,-0.368,-0.367,-0.365,-0.363,-0.361,-0.358,-0.356, & - -0.353,-0.350,-0.347,-0.344,-0.341,-0.337,-0.334,-0.330,-0.327, & - -0.323,-0.320,-0.316,-0.312,-0.308,-0.305,-0.301,-0.297,-0.293, & - -0.289,-0.285,-0.281,-0.277,-0.273,-0.269,-0.265,-0.262,-0.258, & - -0.254,-0.250,-0.246,-0.242,-0.238,-0.234,-0.230,-0.226,-0.222, & - -0.218,-0.213,-0.209,-0.205,-0.201,-0.197,-0.193,-0.189,-0.185, & - -0.181,-0.176,-0.172,-0.168,-0.164,-0.160,-0.155,-0.151,-0.146, & - -0.142,-0.138,-0.133,-0.129,-0.124,-0.120,-0.115,-0.110,-0.106, & - -0.101,-0.096,-0.091,-0.086,-0.082,-0.077,-0.072,-0.067,-0.062, & - -0.057,-0.052,-0.047,-0.042,-0.036,-0.031,-0.026,-0.021,-0.016, & - -0.010,-0.005, 0.000, 0.005, 0.011, 0.016, 0.021, 0.027, 0.032, & - & 0.037, 0.043, 0.048, 0.054, 0.059, 0.064, 0.070, 0.075, 0.081, & - & 0.086, 0.092, 0.097, 0.102, 0.108, 0.113, 0.119, 0.124, 0.129, & - & 0.135, 0.140, 0.146, 0.151, 0.156, 0.162, 0.167, 0.173, 0.178, & - & 0.183, 0.189, 0.194, 0.199, 0.205, 0.210, 0.215, 0.221, 0.226, & - & 0.231, 0.237, 0.242, 0.247, 0.252, 0.258, 0.263, 0.268, 0.273, & - & 0.279, 0.284, 0.289, 0.294, 0.299, 0.305, 0.310, 0.315, 0.320, & - & 0.325, 0.331, 0.336, 0.341, 0.346, 0.351, 0.356, 0.361, 0.366, & - & 0.371, 0.377, 0.382, 0.387, 0.392, 0.397, 0.402, 0.407, 0.412, & - & 0.417, 0.422, 0.427, 0.432, 0.437, 0.442, 0.447, 0.452, 0.457, & - & 0.462, 0.467, 0.472, 0.476, 0.481, 0.486, 0.491, 0.496, 0.501, & - & 0.506, 0.511, 0.515, 0.520, 0.525, 0.530, 0.535, 0.539, 0.544, & - & 0.549, 0.554, 0.559, 0.563, 0.568, 0.573, 0.578, 0.582, 0.587, & - & 0.592, 0.596, 0.601, 0.606, 0.610, 0.615, 0.620, 0.624, 0.629, & - & 0.634, 0.638, 0.643, 0.647, 0.652, 0.657, 0.661, 0.666, 0.670, & - & 0.675, 0.679, 0.684, 0.688, 0.693, 0.697, 0.702, 0.706, 0.711, & - & 0.715, 0.720, 0.724, 0.729, 0.733, 0.737, 0.742, 0.746, 0.751, & - & 0.755, 0.759, 0.764, 0.768, 0.773, 0.777, 0.781, 0.786, 0.790, & - & 0.794, 0.798, 0.803, 0.807, 0.811, 0.816, 0.820, 0.824, 0.828, & - & 0.833, 0.837, 0.841, 0.845, 0.849, 0.854, 0.858, 0.862, 0.866, & - & 0.870, 0.874, 0.879, 0.883, 0.887, 0.891, 0.895, 0.899, 0.903, & - & 0.907, 0.912, 0.916, 0.920, 0.924, 0.928, 0.932, 0.936, 0.940, & - & 0.944, 0.948, 0.952, 0.956, 0.960, 0.964, 0.968, 0.972, 0.976, & - & 0.980, 0.984, 0.988, 0.992, 0.995, 0.999, 1.003, 1.007, 1.011, & - & 1.015, 1.019, 1.023, 1.026, 1.030, 1.034, 1.038, 1.042, 1.046, & - & 1.049, 1.053, 1.057, 1.061, 1.065, 1.068, 1.072, 1.076, 1.080, & - & 1.083, 1.087, 1.091, 1.095, 1.098, 1.102, 1.106, 1.109, 1.113, & - & 1.117, 1.120, 1.124, 1.128, 1.131, 1.135, 1.139, 1.142, 1.146, & - & 1.150, 1.153, 1.157, 1.160, 1.164, 1.168, 1.171, 1.175, 1.178, & - & 1.182, 1.185, 1.189, 1.192, 1.196, 1.200, 1.203, 1.207, 1.210, & - & 1.214, 1.217, 1.221, 1.224, 1.227, 1.231, 1.234, 1.238, 1.241, & - & 1.245, 1.248, 1.252, 1.255, 1.258, 1.262, 1.265, 1.269, 1.272, & - & 1.275, 1.279, 1.282, 1.285, 1.321, 1.354, 1.386, 1.417, 1.448, & - & 1.478, 1.508, 1.537, 1.565, 1.593, 1.621, 1.648, 1.674, 1.700, & - & 1.726, 1.751, 1.776, 1.800, 1.824, 1.848, 1.871, 1.893, 1.916, & - & 1.938, 1.959, 1.980, 2.001, 2.022, 2.042, 2.061, 2.081, 2.100, & - & 2.119, 2.137, 2.156, 2.173, 2.191, 2.208, 2.225, 2.242, 2.259, & - & 2.275, 2.291, 2.307, 2.322, 2.337, 2.352, 2.367, 2.382, 2.396, & - & 2.410, 2.424, 2.438, 2.451, 2.464, 2.477, 2.490, 2.502, 2.515, & - & 2.527, 2.539, 2.551, 2.562, 2.574, 2.585, 2.596, 2.607, 2.618, & - & 2.628, 2.639, 2.649, 2.659, 2.669, 2.679, 2.688, 2.698, 2.707, & - & 2.716, 2.725, 2.734, 2.743, 2.751, 2.760, 2.768, 2.776, 2.784, & - & 2.792, 2.800, 2.808, 2.815, 2.823, 2.830, 2.837, 2.844, 2.851, & - & 2.858, 2.865, 2.871, 2.878, 2.884, 2.890, 2.896, 2.902, 2.908, & - & 2.914, 2.920, 2.925, 2.931, 2.936, 2.942, 2.947, 2.952, 2.957, & - & 2.962, 2.967, 2.972, 2.976, 2.981, 2.985, 2.990, 2.994, 2.998, & - & 3.003, 3.007, 3.011, 3.014, 3.018, 3.022, 3.026, 3.029, 3.033, & - & 3.036, 3.040, 3.043, 3.046, 3.049, 3.052, 3.055, 3.058, 3.061, & - & 3.064, 3.066, 3.069, 3.072, 3.074, 3.077, 3.079, 3.081, 3.083, & - & 3.086, 3.088, 3.090, 3.092, 3.094, 3.096, 3.097, 3.099, 3.101, & - & 3.102, 3.104, 3.105 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.103,-0.226,-0.289,-0.334,-0.369,-0.399,-0.425,-0.448,-0.468, & - -0.487,-0.505,-0.521,-0.536,-0.550,-0.563,-0.576,-0.588,-0.599, & - -0.610,-0.621,-0.631,-0.641,-0.650,-0.659,-0.668,-0.677,-0.685, & - -0.693,-0.701,-0.709,-0.717,-0.724,-0.731,-0.738,-0.745,-0.752, & - -0.758,-0.765,-0.771,-0.777,-0.784,-0.790,-0.796,-0.801,-0.807, & - -0.813,-0.818,-0.824,-0.829,-0.835,-0.840,-0.845,-0.850,-0.855, & - -0.860,-0.865,-0.870,-0.875,-0.880,-0.884,-0.889,-0.894,-0.898, & - -0.903,-0.907,-0.912,-0.916,-0.920,-0.925,-0.929,-0.933,-0.937, & - -0.942,-0.946,-0.950,-0.954,-0.958,-0.962,-0.966,-0.970,-0.974, & - -0.978,-0.982,-0.985,-0.989,-0.993,-0.997,-1.001,-1.004,-1.008, & - -1.012,-1.016,-1.019,-1.023,-1.027,-1.030,-1.034,-1.037,-1.041, & - -1.045,-1.048,-1.052,-1.055,-1.059,-1.062,-1.066,-1.069,-1.072, & - -1.076,-1.079,-1.083,-1.086,-1.089,-1.093,-1.096,-1.099,-1.103, & - -1.106,-1.109,-1.113,-1.116,-1.119,-1.122,-1.126,-1.129,-1.132, & - -1.135,-1.138,-1.142,-1.145,-1.148,-1.151,-1.154,-1.157,-1.160, & - -1.164,-1.167,-1.170,-1.173,-1.176,-1.179,-1.182,-1.185,-1.188, & - -1.191,-1.194,-1.197,-1.200,-1.203,-1.206,-1.209,-1.212,-1.215, & - -1.218,-1.221,-1.223,-1.226,-1.229,-1.232,-1.235,-1.238,-1.241, & - -1.244,-1.246,-1.249,-1.252,-1.255,-1.258,-1.261,-1.263,-1.266, & - -1.269,-1.272,-1.274,-1.277,-1.280,-1.283,-1.285,-1.288,-1.291, & - -1.294,-1.296,-1.299,-1.302,-1.304,-1.307,-1.310,-1.313,-1.315, & - -1.318,-1.321,-1.323,-1.326,-1.328,-1.331,-1.334,-1.336,-1.339, & - -1.342,-1.344,-1.347,-1.349,-1.352,-1.355,-1.357,-1.360,-1.362, & - -1.365,-1.367,-1.370,-1.373,-1.375,-1.378,-1.380,-1.383,-1.385, & - -1.388,-1.390,-1.393,-1.395,-1.398,-1.400,-1.403,-1.405,-1.408, & - -1.410,-1.413,-1.415,-1.418,-1.420,-1.423,-1.425,-1.427,-1.430, & - -1.432,-1.435,-1.437,-1.440,-1.442,-1.445,-1.447,-1.449,-1.452, & - -1.454,-1.457,-1.459,-1.461,-1.464,-1.466,-1.469,-1.471,-1.473, & - -1.476,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490,-1.492,-1.495, & - -1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511,-1.513,-1.515, & - -1.518,-1.520,-1.522,-1.525,-1.527,-1.529,-1.532,-1.534,-1.536, & - -1.538,-1.541,-1.543,-1.545,-1.548,-1.550,-1.552,-1.554,-1.557, & - -1.559,-1.561,-1.563,-1.566,-1.568,-1.570,-1.572,-1.575,-1.577, & - -1.579,-1.581,-1.583,-1.586,-1.588,-1.590,-1.592,-1.595,-1.597, & - -1.599,-1.601,-1.603,-1.606,-1.608,-1.610,-1.612,-1.614,-1.616, & - -1.619,-1.621,-1.623,-1.625,-1.627,-1.630,-1.632,-1.634,-1.636, & - -1.638,-1.640,-1.642,-1.645,-1.647,-1.649,-1.651,-1.653,-1.655, & - -1.658,-1.660,-1.662,-1.664,-1.666,-1.668,-1.670,-1.672,-1.675, & - -1.677,-1.679,-1.681,-1.683,-1.685,-1.687,-1.689,-1.691,-1.694, & - -1.696,-1.698,-1.700,-1.702,-1.704,-1.706,-1.708,-1.710,-1.712, & - -1.714,-1.717,-1.719,-1.721,-1.723,-1.725,-1.727,-1.729,-1.731, & - -1.733,-1.735,-1.737,-1.739,-1.741,-1.743,-1.745,-1.748,-1.750, & - -1.752,-1.754,-1.756,-1.758,-1.760,-1.762,-1.764,-1.766,-1.768, & - -1.770,-1.772,-1.774,-1.776,-1.778,-1.780,-1.782,-1.784,-1.786, & - -1.788,-1.790,-1.792,-1.794,-1.816,-1.836,-1.855,-1.875,-1.894, & - -1.914,-1.933,-1.952,-1.971,-1.989,-2.008,-2.027,-2.045,-2.063, & - -2.082,-2.100,-2.118,-2.136,-2.154,-2.171,-2.189,-2.207,-2.224, & - -2.242,-2.259,-2.276,-2.293,-2.311,-2.328,-2.345,-2.362,-2.379, & - -2.395,-2.412,-2.429,-2.446,-2.462,-2.479,-2.495,-2.512,-2.528, & - -2.544,-2.561,-2.577,-2.593,-2.609,-2.625,-2.642,-2.658,-2.674, & - -2.689,-2.705,-2.721,-2.737,-2.753,-2.768,-2.784,-2.800,-2.815, & - -2.831,-2.847,-2.862,-2.878,-2.893,-2.908,-2.924,-2.939,-2.954, & - -2.970,-2.985,-3.000,-3.015,-3.031,-3.046,-3.061,-3.076,-3.091, & - -3.106,-3.121,-3.136,-3.151,-3.166,-3.181,-3.196,-3.210,-3.225, & - -3.240,-3.255,-3.270,-3.284,-3.299,-3.314,-3.328,-3.343,-3.358, & - -3.372,-3.387,-3.401,-3.416,-3.430,-3.445,-3.459,-3.474,-3.488, & - -3.503,-3.517,-3.531,-3.546,-3.560,-3.574,-3.589,-3.603,-3.617, & - -3.631,-3.646,-3.660,-3.674,-3.688,-3.702,-3.717,-3.731,-3.745, & - -3.759,-3.773,-3.787,-3.801,-3.815,-3.829,-3.843,-3.857,-3.871, & - -3.885,-3.899,-3.913,-3.927,-3.941,-3.955,-3.969,-3.982,-3.996, & - -4.010,-4.024,-4.038,-4.051,-4.065,-4.079,-4.093,-4.107,-4.120, & - -4.134,-4.148,-4.161,-4.175,-4.189,-4.202,-4.216,-4.230,-4.243, & - -4.257,-4.271,-4.284 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.050,-0.106,-0.133,-0.152,-0.166,-0.177,-0.187,-0.195,-0.202, & - -0.208,-0.214,-0.218,-0.223,-0.227,-0.230,-0.233,-0.236,-0.238, & - -0.240,-0.242,-0.244,-0.246,-0.247,-0.248,-0.249,-0.250,-0.250, & - -0.250,-0.251,-0.251,-0.251,-0.251,-0.250,-0.250,-0.249,-0.249, & - -0.248,-0.247,-0.246,-0.245,-0.244,-0.242,-0.241,-0.240,-0.238, & - -0.236,-0.235,-0.233,-0.231,-0.229,-0.227,-0.225,-0.223,-0.221, & - -0.219,-0.216,-0.214,-0.212,-0.209,-0.207,-0.204,-0.202,-0.199, & - -0.196,-0.193,-0.191,-0.188,-0.185,-0.182,-0.179,-0.176,-0.173, & - -0.170,-0.167,-0.164,-0.161,-0.158,-0.154,-0.151,-0.148,-0.144, & - -0.141,-0.138,-0.134,-0.131,-0.127,-0.124,-0.120,-0.116,-0.113, & - -0.109,-0.105,-0.102,-0.098,-0.094,-0.090,-0.086,-0.082,-0.078, & - -0.074,-0.071,-0.067,-0.063,-0.059,-0.054,-0.050,-0.046,-0.042, & - -0.038,-0.034,-0.030,-0.026,-0.022,-0.017,-0.013,-0.009,-0.005, & - -0.001, 0.004, 0.008, 0.012, 0.016, 0.020, 0.025, 0.029, 0.033, & - & 0.037, 0.041, 0.046, 0.050, 0.054, 0.058, 0.062, 0.067, 0.071, & - & 0.075, 0.079, 0.083, 0.087, 0.091, 0.096, 0.100, 0.104, 0.108, & - & 0.112, 0.116, 0.120, 0.124, 0.128, 0.132, 0.136, 0.141, 0.145, & - & 0.149, 0.153, 0.157, 0.161, 0.165, 0.169, 0.173, 0.176, 0.180, & - & 0.184, 0.188, 0.192, 0.196, 0.200, 0.204, 0.208, 0.212, 0.215, & - & 0.219, 0.223, 0.227, 0.231, 0.235, 0.238, 0.242, 0.246, 0.250, & - & 0.254, 0.257, 0.261, 0.265, 0.268, 0.272, 0.276, 0.280, 0.283, & - & 0.287, 0.291, 0.294, 0.298, 0.302, 0.305, 0.309, 0.312, 0.316, & - & 0.320, 0.323, 0.327, 0.330, 0.334, 0.337, 0.341, 0.344, 0.348, & - & 0.351, 0.355, 0.358, 0.362, 0.365, 0.369, 0.372, 0.376, 0.379, & - & 0.382, 0.386, 0.389, 0.393, 0.396, 0.399, 0.403, 0.406, 0.409, & - & 0.413, 0.416, 0.419, 0.423, 0.426, 0.429, 0.433, 0.436, 0.439, & - & 0.442, 0.446, 0.449, 0.452, 0.455, 0.459, 0.462, 0.465, 0.468, & - & 0.471, 0.475, 0.478, 0.481, 0.484, 0.487, 0.490, 0.493, 0.497, & - & 0.500, 0.503, 0.506, 0.509, 0.512, 0.515, 0.518, 0.521, 0.524, & - & 0.527, 0.530, 0.533, 0.536, 0.539, 0.542, 0.545, 0.548, 0.551, & - & 0.554, 0.557, 0.560, 0.563, 0.566, 0.569, 0.572, 0.575, 0.578, & - & 0.581, 0.584, 0.587, 0.590, 0.592, 0.595, 0.598, 0.601, 0.604, & - & 0.607, 0.610, 0.612, 0.615, 0.618, 0.621, 0.624, 0.627, 0.629, & - & 0.632, 0.635, 0.638, 0.640, 0.643, 0.646, 0.649, 0.651, 0.654, & - & 0.657, 0.660, 0.662, 0.665, 0.668, 0.671, 0.673, 0.676, 0.679, & - & 0.681, 0.684, 0.687, 0.689, 0.692, 0.695, 0.697, 0.700, 0.702, & - & 0.705, 0.708, 0.710, 0.713, 0.716, 0.718, 0.721, 0.723, 0.726, & - & 0.728, 0.731, 0.734, 0.736, 0.739, 0.741, 0.744, 0.746, 0.749, & - & 0.751, 0.754, 0.756, 0.759, 0.761, 0.764, 0.766, 0.769, 0.771, & - & 0.774, 0.776, 0.779, 0.781, 0.784, 0.786, 0.788, 0.791, 0.793, & - & 0.796, 0.798, 0.801, 0.803, 0.805, 0.808, 0.810, 0.813, 0.815, & - & 0.817, 0.820, 0.822, 0.824, 0.827, 0.829, 0.832, 0.834, 0.836, & - & 0.839, 0.841, 0.843, 0.846, 0.848, 0.850, 0.852, 0.855, 0.857, & - & 0.859, 0.862, 0.864, 0.866, 0.868, 0.871, 0.873, 0.875, 0.878, & - & 0.880, 0.882, 0.884, 0.887, 0.910, 0.932, 0.953, 0.974, 0.995, & - & 1.015, 1.034, 1.054, 1.072, 1.091, 1.109, 1.127, 1.145, 1.162, & - & 1.179, 1.196, 1.213, 1.229, 1.245, 1.260, 1.276, 1.291, 1.306, & - & 1.320, 1.335, 1.349, 1.363, 1.377, 1.390, 1.404, 1.417, 1.430, & - & 1.442, 1.455, 1.467, 1.479, 1.491, 1.503, 1.515, 1.526, 1.538, & - & 1.549, 1.560, 1.570, 1.581, 1.592, 1.602, 1.612, 1.622, 1.632, & - & 1.642, 1.652, 1.661, 1.671, 1.680, 1.689, 1.698, 1.707, 1.716, & - & 1.724, 1.733, 1.741, 1.750, 1.758, 1.766, 1.774, 1.782, 1.789, & - & 1.797, 1.805, 1.812, 1.820, 1.827, 1.834, 1.841, 1.848, 1.855, & - & 1.862, 1.868, 1.875, 1.882, 1.888, 1.894, 1.901, 1.907, 1.913, & - & 1.919, 1.925, 1.931, 1.937, 1.943, 1.948, 1.954, 1.959, 1.965, & - & 1.970, 1.976, 1.981, 1.986, 1.991, 1.996, 2.001, 2.006, 2.011, & - & 2.016, 2.020, 2.025, 2.030, 2.034, 2.039, 2.043, 2.048, 2.052, & - & 2.056, 2.060, 2.064, 2.069, 2.073, 2.077, 2.080, 2.084, 2.088, & - & 2.092, 2.096, 2.099, 2.103, 2.107, 2.110, 2.114, 2.117, 2.120, & - & 2.124, 2.127, 2.130, 2.133, 2.137, 2.140, 2.143, 2.146, 2.149, & - & 2.152, 2.155, 2.158, 2.160, 2.163, 2.166, 2.169, 2.171, 2.174, & - & 2.176, 2.179, 2.181, 2.184, 2.186, 2.189, 2.191, 2.193, 2.196, & - & 2.198, 2.200, 2.202 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.053,-0.124,-0.164,-0.194,-0.219,-0.242,-0.262,-0.281,-0.298, & - -0.314,-0.330,-0.345,-0.359,-0.372,-0.385,-0.398,-0.411,-0.423, & - -0.434,-0.446,-0.457,-0.468,-0.478,-0.489,-0.499,-0.509,-0.519, & - -0.528,-0.538,-0.547,-0.556,-0.565,-0.574,-0.583,-0.592,-0.600, & - -0.608,-0.617,-0.625,-0.633,-0.641,-0.648,-0.656,-0.664,-0.671, & - -0.678,-0.686,-0.693,-0.700,-0.707,-0.714,-0.721,-0.727,-0.734, & - -0.741,-0.747,-0.754,-0.760,-0.766,-0.773,-0.779,-0.785,-0.791, & - -0.797,-0.803,-0.809,-0.815,-0.821,-0.827,-0.832,-0.838,-0.844, & - -0.849,-0.855,-0.861,-0.866,-0.872,-0.877,-0.883,-0.888,-0.894, & - -0.899,-0.904,-0.910,-0.915,-0.920,-0.926,-0.931,-0.936,-0.942, & - -0.947,-0.952,-0.957,-0.963,-0.968,-0.973,-0.978,-0.983,-0.988, & - -0.994,-0.999,-1.004,-1.009,-1.014,-1.019,-1.024,-1.029,-1.034, & - -1.039,-1.044,-1.049,-1.054,-1.059,-1.064,-1.069,-1.074,-1.079, & - -1.083,-1.088,-1.093,-1.098,-1.103,-1.107,-1.112,-1.117,-1.122, & - -1.126,-1.131,-1.136,-1.140,-1.145,-1.149,-1.154,-1.158,-1.163, & - -1.168,-1.172,-1.176,-1.181,-1.185,-1.190,-1.194,-1.199,-1.203, & - -1.207,-1.212,-1.216,-1.220,-1.224,-1.229,-1.233,-1.237,-1.241, & - -1.245,-1.250,-1.254,-1.258,-1.262,-1.266,-1.270,-1.274,-1.278, & - -1.282,-1.286,-1.290,-1.294,-1.298,-1.302,-1.306,-1.310,-1.314, & - -1.318,-1.321,-1.325,-1.329,-1.333,-1.337,-1.341,-1.344,-1.348, & - -1.352,-1.355,-1.359,-1.363,-1.367,-1.370,-1.374,-1.378,-1.381, & - -1.385,-1.388,-1.392,-1.395,-1.399,-1.403,-1.406,-1.410,-1.413, & - -1.417,-1.420,-1.423,-1.427,-1.430,-1.434,-1.437,-1.441,-1.444, & - -1.447,-1.451,-1.454,-1.457,-1.461,-1.464,-1.467,-1.470,-1.474, & - -1.477,-1.480,-1.483,-1.487,-1.490,-1.493,-1.496,-1.499,-1.503, & - -1.506,-1.509,-1.512,-1.515,-1.518,-1.521,-1.524,-1.528,-1.531, & - -1.534,-1.537,-1.540,-1.543,-1.546,-1.549,-1.552,-1.555,-1.558, & - -1.561,-1.564,-1.566,-1.569,-1.572,-1.575,-1.578,-1.581,-1.584, & - -1.587,-1.590,-1.592,-1.595,-1.598,-1.601,-1.604,-1.607,-1.609, & - -1.612,-1.615,-1.618,-1.620,-1.623,-1.626,-1.629,-1.631,-1.634, & - -1.637,-1.639,-1.642,-1.645,-1.647,-1.650,-1.653,-1.655,-1.658, & - -1.661,-1.663,-1.666,-1.668,-1.671,-1.674,-1.676,-1.679,-1.681, & - -1.684,-1.686,-1.689,-1.691,-1.694,-1.696,-1.699,-1.701,-1.704, & - -1.706,-1.709,-1.711,-1.714,-1.716,-1.719,-1.721,-1.724,-1.726, & - -1.728,-1.731,-1.733,-1.736,-1.738,-1.740,-1.743,-1.745,-1.747, & - -1.750,-1.752,-1.754,-1.757,-1.759,-1.761,-1.764,-1.766,-1.768, & - -1.771,-1.773,-1.775,-1.777,-1.780,-1.782,-1.784,-1.786,-1.789, & - -1.791,-1.793,-1.795,-1.797,-1.800,-1.802,-1.804,-1.806,-1.808, & - -1.811,-1.813,-1.815,-1.817,-1.819,-1.821,-1.823,-1.826,-1.828, & - -1.830,-1.832,-1.834,-1.836,-1.838,-1.840,-1.842,-1.844,-1.847, & - -1.849,-1.851,-1.853,-1.855,-1.857,-1.859,-1.861,-1.863,-1.865, & - -1.867,-1.869,-1.871,-1.873,-1.875,-1.877,-1.879,-1.881,-1.883, & - -1.885,-1.887,-1.889,-1.891,-1.893,-1.895,-1.897,-1.898,-1.900, & - -1.902,-1.904,-1.906,-1.908,-1.910,-1.912,-1.914,-1.916,-1.917, & - -1.919,-1.921,-1.923,-1.925,-1.945,-1.963,-1.980,-1.997,-2.014, & - -2.030,-2.046,-2.062,-2.077,-2.092,-2.107,-2.122,-2.136,-2.150, & - -2.163,-2.177,-2.190,-2.203,-2.216,-2.228,-2.241,-2.253,-2.265, & - -2.277,-2.289,-2.300,-2.311,-2.323,-2.334,-2.345,-2.356,-2.366, & - -2.377,-2.387,-2.398,-2.408,-2.418,-2.428,-2.438,-2.448,-2.457, & - -2.467,-2.477,-2.486,-2.496,-2.505,-2.514,-2.523,-2.532,-2.541, & - -2.550,-2.559,-2.568,-2.577,-2.586,-2.594,-2.603,-2.611,-2.620, & - -2.628,-2.637,-2.645,-2.653,-2.662,-2.670,-2.678,-2.686,-2.694, & - -2.702,-2.710,-2.718,-2.726,-2.734,-2.742,-2.750,-2.758,-2.765, & - -2.773,-2.781,-2.789,-2.796,-2.804,-2.811,-2.819,-2.827,-2.834, & - -2.842,-2.849,-2.857,-2.864,-2.871,-2.879,-2.886,-2.893,-2.901, & - -2.908,-2.915,-2.923,-2.930,-2.937,-2.944,-2.951,-2.959,-2.966, & - -2.973,-2.980,-2.987,-2.994,-3.001,-3.008,-3.015,-3.022,-3.029, & - -3.036,-3.043,-3.050,-3.057,-3.064,-3.071,-3.078,-3.085,-3.092, & - -3.099,-3.106,-3.113,-3.119,-3.126,-3.133,-3.140,-3.147,-3.154, & - -3.160,-3.167,-3.174,-3.181,-3.187,-3.194,-3.201,-3.208,-3.214, & - -3.221,-3.228,-3.234,-3.241,-3.248,-3.254,-3.261,-3.268,-3.274, & - -3.281,-3.287,-3.294,-3.301,-3.307,-3.314,-3.320,-3.327,-3.334, & - -3.340,-3.347,-3.353 & - / - -! *** KCL - - DATA BNC20M/ & - -0.051,-0.108,-0.135,-0.154,-0.169,-0.180,-0.190,-0.198,-0.205, & - -0.211,-0.217,-0.222,-0.226,-0.231,-0.234,-0.238,-0.241,-0.244, & - -0.246,-0.249,-0.251,-0.253,-0.255,-0.257,-0.259,-0.261,-0.262, & - -0.264,-0.265,-0.267,-0.268,-0.269,-0.270,-0.271,-0.272,-0.273, & - -0.274,-0.275,-0.276,-0.277,-0.278,-0.278,-0.279,-0.280,-0.280, & - -0.281,-0.282,-0.282,-0.283,-0.283,-0.284,-0.285,-0.285,-0.286, & - -0.286,-0.287,-0.287,-0.287,-0.288,-0.288,-0.289,-0.289,-0.289, & - -0.290,-0.290,-0.291,-0.291,-0.291,-0.292,-0.292,-0.292,-0.292, & - -0.293,-0.293,-0.293,-0.293,-0.294,-0.294,-0.294,-0.294,-0.294, & - -0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295, & - -0.295,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296, & - -0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295, & - -0.295,-0.295,-0.294,-0.294,-0.294,-0.294,-0.294,-0.294,-0.294, & - -0.293,-0.293,-0.293,-0.293,-0.293,-0.293,-0.292,-0.292,-0.292, & - -0.292,-0.292,-0.291,-0.291,-0.291,-0.291,-0.291,-0.290,-0.290, & - -0.290,-0.290,-0.290,-0.289,-0.289,-0.289,-0.289,-0.289,-0.288, & - -0.288,-0.288,-0.288,-0.287,-0.287,-0.287,-0.287,-0.287,-0.286, & - -0.286,-0.286,-0.286,-0.285,-0.285,-0.285,-0.285,-0.285,-0.284, & - -0.284,-0.284,-0.284,-0.283,-0.283,-0.283,-0.283,-0.283,-0.282, & - -0.282,-0.282,-0.282,-0.281,-0.281,-0.281,-0.281,-0.281,-0.280, & - -0.280,-0.280,-0.280,-0.279,-0.279,-0.279,-0.279,-0.279,-0.278, & - -0.278,-0.278,-0.278,-0.278,-0.277,-0.277,-0.277,-0.277,-0.276, & - -0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.275, & - -0.274,-0.274,-0.274,-0.274,-0.274,-0.273,-0.273,-0.273,-0.273, & - -0.273,-0.272,-0.272,-0.272,-0.272,-0.272,-0.271,-0.271,-0.271, & - -0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.270,-0.270,-0.269, & - -0.269,-0.269,-0.269,-0.269,-0.268,-0.268,-0.268,-0.268,-0.268, & - -0.268,-0.267,-0.267,-0.267,-0.267,-0.267,-0.266,-0.266,-0.266, & - -0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265, & - -0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.263,-0.263,-0.263, & - -0.263,-0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.262, & - -0.262,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.260, & - -0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.259,-0.259, & - -0.259,-0.259,-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.258, & - -0.258,-0.258,-0.258,-0.258,-0.257,-0.257,-0.257,-0.257,-0.257, & - -0.257,-0.257,-0.257,-0.257,-0.256,-0.256,-0.256,-0.256,-0.256, & - -0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.255,-0.255, & - -0.255,-0.255,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254,-0.254, & - -0.254,-0.254,-0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253, & - -0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253,-0.253, & - -0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252, & - -0.252,-0.252,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.251, & - -0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251,-0.251, & - -0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250,-0.250,-0.250, & - -0.250,-0.250,-0.250,-0.250,-0.250,-0.249,-0.249,-0.249,-0.248, & - -0.248,-0.248,-0.248,-0.249,-0.249,-0.249,-0.249,-0.250,-0.250, & - -0.251,-0.251,-0.252,-0.252,-0.253,-0.254,-0.255,-0.255,-0.256, & - -0.257,-0.258,-0.259,-0.261,-0.262,-0.263,-0.264,-0.265,-0.267, & - -0.268,-0.269,-0.271,-0.272,-0.274,-0.276,-0.277,-0.279,-0.280, & - -0.282,-0.284,-0.286,-0.287,-0.289,-0.291,-0.293,-0.295,-0.297, & - -0.299,-0.301,-0.303,-0.305,-0.307,-0.309,-0.312,-0.314,-0.316, & - -0.318,-0.321,-0.323,-0.325,-0.328,-0.330,-0.332,-0.335,-0.337, & - -0.340,-0.342,-0.345,-0.347,-0.350,-0.352,-0.355,-0.358,-0.360, & - -0.363,-0.366,-0.368,-0.371,-0.374,-0.377,-0.379,-0.382,-0.385, & - -0.388,-0.391,-0.394,-0.396,-0.399,-0.402,-0.405,-0.408,-0.411, & - -0.414,-0.417,-0.420,-0.423,-0.426,-0.429,-0.432,-0.436,-0.439, & - -0.442,-0.445,-0.448,-0.451,-0.454,-0.458,-0.461,-0.464,-0.467, & - -0.471,-0.474,-0.477,-0.480,-0.484,-0.487,-0.490,-0.494,-0.497, & - -0.500,-0.504,-0.507,-0.511,-0.514,-0.517,-0.521,-0.524,-0.528, & - -0.531,-0.535,-0.538,-0.542,-0.545,-0.549,-0.552,-0.556,-0.559, & - -0.563,-0.566,-0.570,-0.574,-0.577,-0.581,-0.584,-0.588,-0.592, & - -0.595,-0.599,-0.603,-0.606,-0.610,-0.614,-0.617,-0.621,-0.625, & - -0.628,-0.632,-0.636 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.205,-0.445,-0.564,-0.649,-0.715,-0.770,-0.817,-0.858,-0.895, & - -0.928,-0.958,-0.986,-1.012,-1.036,-1.058,-1.079,-1.099,-1.118, & - -1.136,-1.153,-1.170,-1.185,-1.200,-1.215,-1.229,-1.242,-1.255, & - -1.268,-1.280,-1.292,-1.303,-1.315,-1.325,-1.336,-1.346,-1.357, & - -1.366,-1.376,-1.386,-1.395,-1.404,-1.413,-1.421,-1.430,-1.438, & - -1.447,-1.455,-1.463,-1.471,-1.478,-1.486,-1.494,-1.501,-1.508, & - -1.515,-1.523,-1.530,-1.536,-1.543,-1.550,-1.557,-1.563,-1.570, & - -1.576,-1.583,-1.589,-1.595,-1.601,-1.607,-1.613,-1.619,-1.625, & - -1.631,-1.637,-1.643,-1.648,-1.654,-1.659,-1.665,-1.670,-1.676, & - -1.681,-1.687,-1.692,-1.697,-1.702,-1.707,-1.713,-1.718,-1.723, & - -1.728,-1.733,-1.738,-1.742,-1.747,-1.752,-1.757,-1.762,-1.766, & - -1.771,-1.776,-1.780,-1.785,-1.789,-1.794,-1.798,-1.803,-1.807, & - -1.812,-1.816,-1.820,-1.825,-1.829,-1.833,-1.838,-1.842,-1.846, & - -1.850,-1.854,-1.858,-1.863,-1.867,-1.871,-1.875,-1.879,-1.883, & - -1.887,-1.891,-1.895,-1.899,-1.903,-1.907,-1.911,-1.915,-1.919, & - -1.922,-1.926,-1.930,-1.934,-1.938,-1.942,-1.945,-1.949,-1.953, & - -1.957,-1.960,-1.964,-1.968,-1.972,-1.975,-1.979,-1.983,-1.986, & - -1.990,-1.994,-1.997,-2.001,-2.004,-2.008,-2.012,-2.015,-2.019, & - -2.022,-2.026,-2.029,-2.033,-2.036,-2.040,-2.043,-2.047,-2.050, & - -2.054,-2.057,-2.061,-2.064,-2.068,-2.071,-2.074,-2.078,-2.081, & - -2.085,-2.088,-2.091,-2.095,-2.098,-2.102,-2.105,-2.108,-2.112, & - -2.115,-2.118,-2.122,-2.125,-2.128,-2.132,-2.135,-2.138,-2.141, & - -2.145,-2.148,-2.151,-2.154,-2.158,-2.161,-2.164,-2.167,-2.171, & - -2.174,-2.177,-2.180,-2.184,-2.187,-2.190,-2.193,-2.196,-2.200, & - -2.203,-2.206,-2.209,-2.212,-2.215,-2.219,-2.222,-2.225,-2.228, & - -2.231,-2.234,-2.237,-2.241,-2.244,-2.247,-2.250,-2.253,-2.256, & - -2.259,-2.262,-2.265,-2.269,-2.272,-2.275,-2.278,-2.281,-2.284, & - -2.287,-2.290,-2.293,-2.296,-2.299,-2.302,-2.305,-2.308,-2.311, & - -2.314,-2.317,-2.320,-2.324,-2.327,-2.330,-2.333,-2.336,-2.339, & - -2.342,-2.345,-2.348,-2.351,-2.354,-2.357,-2.360,-2.363,-2.366, & - -2.369,-2.371,-2.374,-2.377,-2.380,-2.383,-2.386,-2.389,-2.392, & - -2.395,-2.398,-2.401,-2.404,-2.407,-2.410,-2.413,-2.416,-2.419, & - -2.422,-2.425,-2.427,-2.430,-2.433,-2.436,-2.439,-2.442,-2.445, & - -2.448,-2.451,-2.454,-2.457,-2.460,-2.462,-2.465,-2.468,-2.471, & - -2.474,-2.477,-2.480,-2.483,-2.485,-2.488,-2.491,-2.494,-2.497, & - -2.500,-2.503,-2.506,-2.508,-2.511,-2.514,-2.517,-2.520,-2.523, & - -2.526,-2.528,-2.531,-2.534,-2.537,-2.540,-2.543,-2.546,-2.548, & - -2.551,-2.554,-2.557,-2.560,-2.563,-2.565,-2.568,-2.571,-2.574, & - -2.577,-2.579,-2.582,-2.585,-2.588,-2.591,-2.594,-2.596,-2.599, & - -2.602,-2.605,-2.608,-2.610,-2.613,-2.616,-2.619,-2.622,-2.624, & - -2.627,-2.630,-2.633,-2.635,-2.638,-2.641,-2.644,-2.647,-2.649, & - -2.652,-2.655,-2.658,-2.661,-2.663,-2.666,-2.669,-2.672,-2.674, & - -2.677,-2.680,-2.683,-2.685,-2.688,-2.691,-2.694,-2.696,-2.699, & - -2.702,-2.705,-2.707,-2.710,-2.713,-2.716,-2.718,-2.721,-2.724, & - -2.727,-2.729,-2.732,-2.735,-2.765,-2.792,-2.819,-2.846,-2.873, & - -2.900,-2.927,-2.953,-2.980,-3.006,-3.033,-3.059,-3.086,-3.112, & - -3.138,-3.164,-3.191,-3.217,-3.243,-3.269,-3.295,-3.321,-3.346, & - -3.372,-3.398,-3.424,-3.449,-3.475,-3.501,-3.526,-3.552,-3.578, & - -3.603,-3.629,-3.654,-3.679,-3.705,-3.730,-3.755,-3.781,-3.806, & - -3.831,-3.857,-3.882,-3.907,-3.932,-3.957,-3.982,-4.008,-4.033, & - -4.058,-4.083,-4.108,-4.133,-4.158,-4.183,-4.208,-4.233,-4.258, & - -4.282,-4.307,-4.332,-4.357,-4.382,-4.407,-4.431,-4.456,-4.481, & - -4.506,-4.530,-4.555,-4.580,-4.605,-4.629,-4.654,-4.679,-4.703, & - -4.728,-4.752,-4.777,-4.802,-4.826,-4.851,-4.875,-4.900,-4.924, & - -4.949,-4.973,-4.998,-5.022,-5.047,-5.071,-5.096,-5.120,-5.145, & - -5.169,-5.193,-5.218,-5.242,-5.267,-5.291,-5.315,-5.340,-5.364, & - -5.388,-5.413,-5.437,-5.461,-5.485,-5.510,-5.534,-5.558,-5.582, & - -5.607,-5.631,-5.655,-5.679,-5.703,-5.728,-5.752,-5.776,-5.800, & - -5.824,-5.848,-5.873,-5.897,-5.921,-5.945,-5.969,-5.993,-6.017, & - -6.041,-6.065,-6.089,-6.113,-6.137,-6.161,-6.186,-6.210,-6.234, & - -6.258,-6.282,-6.306,-6.329,-6.353,-6.377,-6.401,-6.425,-6.449, & - -6.473,-6.497,-6.521,-6.545,-6.569,-6.593,-6.617,-6.641,-6.664, & - -6.688,-6.712,-6.736 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.099,-0.205,-0.253,-0.283,-0.305,-0.322,-0.335,-0.345,-0.353, & - -0.359,-0.364,-0.368,-0.371,-0.374,-0.375,-0.376,-0.377,-0.377, & - -0.376,-0.376,-0.375,-0.373,-0.372,-0.370,-0.368,-0.366,-0.364, & - -0.361,-0.359,-0.356,-0.353,-0.350,-0.347,-0.344,-0.341,-0.338, & - -0.334,-0.331,-0.328,-0.324,-0.321,-0.317,-0.314,-0.310,-0.306, & - -0.303,-0.299,-0.295,-0.292,-0.288,-0.284,-0.281,-0.277,-0.273, & - -0.270,-0.266,-0.262,-0.258,-0.255,-0.251,-0.247,-0.243,-0.240, & - -0.236,-0.232,-0.228,-0.225,-0.221,-0.217,-0.213,-0.209,-0.205, & - -0.201,-0.197,-0.194,-0.190,-0.186,-0.182,-0.177,-0.173,-0.169, & - -0.165,-0.161,-0.157,-0.153,-0.148,-0.144,-0.140,-0.135,-0.131, & - -0.126,-0.122,-0.117,-0.113,-0.108,-0.104,-0.099,-0.094,-0.090, & - -0.085,-0.080,-0.075,-0.070,-0.066,-0.061,-0.056,-0.051,-0.046, & - -0.041,-0.036,-0.031,-0.026,-0.021,-0.016,-0.011,-0.006,-0.001, & - & 0.004, 0.010, 0.015, 0.020, 0.025, 0.030, 0.035, 0.040, 0.045, & - & 0.050, 0.056, 0.061, 0.066, 0.071, 0.076, 0.081, 0.086, 0.092, & - & 0.097, 0.102, 0.107, 0.112, 0.117, 0.122, 0.127, 0.132, 0.137, & - & 0.143, 0.148, 0.153, 0.158, 0.163, 0.168, 0.173, 0.178, 0.183, & - & 0.188, 0.193, 0.198, 0.203, 0.208, 0.213, 0.218, 0.223, 0.228, & - & 0.233, 0.238, 0.243, 0.248, 0.253, 0.258, 0.262, 0.267, 0.272, & - & 0.277, 0.282, 0.287, 0.292, 0.297, 0.302, 0.306, 0.311, 0.316, & - & 0.321, 0.326, 0.331, 0.335, 0.340, 0.345, 0.350, 0.354, 0.359, & - & 0.364, 0.369, 0.373, 0.378, 0.383, 0.388, 0.392, 0.397, 0.402, & - & 0.406, 0.411, 0.416, 0.420, 0.425, 0.430, 0.434, 0.439, 0.444, & - & 0.448, 0.453, 0.457, 0.462, 0.466, 0.471, 0.476, 0.480, 0.485, & - & 0.489, 0.494, 0.498, 0.503, 0.507, 0.512, 0.516, 0.521, 0.525, & - & 0.530, 0.534, 0.538, 0.543, 0.547, 0.552, 0.556, 0.561, 0.565, & - & 0.569, 0.574, 0.578, 0.582, 0.587, 0.591, 0.595, 0.600, 0.604, & - & 0.608, 0.613, 0.617, 0.621, 0.625, 0.630, 0.634, 0.638, 0.642, & - & 0.647, 0.651, 0.655, 0.659, 0.664, 0.668, 0.672, 0.676, 0.680, & - & 0.684, 0.689, 0.693, 0.697, 0.701, 0.705, 0.709, 0.713, 0.717, & - & 0.721, 0.726, 0.730, 0.734, 0.738, 0.742, 0.746, 0.750, 0.754, & - & 0.758, 0.762, 0.766, 0.770, 0.774, 0.778, 0.782, 0.786, 0.790, & - & 0.794, 0.798, 0.801, 0.805, 0.809, 0.813, 0.817, 0.821, 0.825, & - & 0.829, 0.833, 0.836, 0.840, 0.844, 0.848, 0.852, 0.856, 0.859, & - & 0.863, 0.867, 0.871, 0.875, 0.878, 0.882, 0.886, 0.890, 0.893, & - & 0.897, 0.901, 0.905, 0.908, 0.912, 0.916, 0.919, 0.923, 0.927, & - & 0.931, 0.934, 0.938, 0.941, 0.945, 0.949, 0.952, 0.956, 0.960, & - & 0.963, 0.967, 0.970, 0.974, 0.978, 0.981, 0.985, 0.988, 0.992, & - & 0.995, 0.999, 1.002, 1.006, 1.010, 1.013, 1.017, 1.020, 1.024, & - & 1.027, 1.031, 1.034, 1.037, 1.041, 1.044, 1.048, 1.051, 1.055, & - & 1.058, 1.061, 1.065, 1.068, 1.072, 1.075, 1.078, 1.082, 1.085, & - & 1.089, 1.092, 1.095, 1.099, 1.102, 1.105, 1.109, 1.112, 1.115, & - & 1.119, 1.122, 1.125, 1.128, 1.132, 1.135, 1.138, 1.142, 1.145, & - & 1.148, 1.151, 1.155, 1.158, 1.161, 1.164, 1.167, 1.171, 1.174, & - & 1.177, 1.180, 1.183, 1.187, 1.220, 1.251, 1.281, 1.311, 1.340, & - & 1.369, 1.397, 1.424, 1.451, 1.477, 1.503, 1.529, 1.554, 1.579, & - & 1.603, 1.627, 1.650, 1.673, 1.695, 1.717, 1.739, 1.760, 1.781, & - & 1.802, 1.822, 1.842, 1.862, 1.881, 1.900, 1.918, 1.937, 1.955, & - & 1.972, 1.990, 2.007, 2.024, 2.040, 2.056, 2.072, 2.088, 2.103, & - & 2.119, 2.134, 2.148, 2.163, 2.177, 2.191, 2.205, 2.218, 2.231, & - & 2.245, 2.257, 2.270, 2.283, 2.295, 2.307, 2.319, 2.330, 2.342, & - & 2.353, 2.364, 2.375, 2.386, 2.397, 2.407, 2.417, 2.427, 2.437, & - & 2.447, 2.456, 2.466, 2.475, 2.484, 2.493, 2.502, 2.511, 2.519, & - & 2.528, 2.536, 2.544, 2.552, 2.560, 2.567, 2.575, 2.582, 2.590, & - & 2.597, 2.604, 2.611, 2.618, 2.624, 2.631, 2.637, 2.644, 2.650, & - & 2.656, 2.662, 2.668, 2.674, 2.680, 2.685, 2.691, 2.696, 2.701, & - & 2.706, 2.712, 2.717, 2.721, 2.726, 2.731, 2.735, 2.740, 2.744, & - & 2.749, 2.753, 2.757, 2.761, 2.765, 2.769, 2.773, 2.777, 2.780, & - & 2.784, 2.787, 2.791, 2.794, 2.797, 2.801, 2.804, 2.807, 2.810, & - & 2.812, 2.815, 2.818, 2.821, 2.823, 2.826, 2.828, 2.831, 2.833, & - & 2.835, 2.837, 2.839, 2.841, 2.843, 2.845, 2.847, 2.849, 2.851, & - & 2.852, 2.854, 2.856, 2.857, 2.859, 2.860, 2.861, 2.862, 2.864, & - & 2.865, 2.866, 2.867 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.098,-0.202,-0.247,-0.275,-0.294,-0.308,-0.319,-0.327,-0.333, & - -0.337,-0.340,-0.342,-0.343,-0.343,-0.343,-0.341,-0.340,-0.338, & - -0.336,-0.333,-0.330,-0.326,-0.323,-0.319,-0.315,-0.311,-0.306, & - -0.302,-0.297,-0.293,-0.288,-0.283,-0.278,-0.273,-0.267,-0.262, & - -0.257,-0.251,-0.246,-0.241,-0.235,-0.230,-0.224,-0.218,-0.213, & - -0.207,-0.202,-0.196,-0.190,-0.185,-0.179,-0.174,-0.168,-0.162, & - -0.157,-0.151,-0.145,-0.140,-0.134,-0.128,-0.123,-0.117,-0.111, & - -0.106,-0.100,-0.094,-0.089,-0.083,-0.077,-0.071,-0.066,-0.060, & - -0.054,-0.048,-0.042,-0.037,-0.031,-0.025,-0.019,-0.013,-0.007, & - -0.001, 0.006, 0.012, 0.018, 0.024, 0.030, 0.037, 0.043, 0.049, & - & 0.056, 0.062, 0.069, 0.075, 0.082, 0.089, 0.095, 0.102, 0.109, & - & 0.116, 0.122, 0.129, 0.136, 0.143, 0.150, 0.157, 0.164, 0.171, & - & 0.178, 0.185, 0.192, 0.199, 0.207, 0.214, 0.221, 0.228, 0.235, & - & 0.242, 0.250, 0.257, 0.264, 0.271, 0.278, 0.286, 0.293, 0.300, & - & 0.307, 0.315, 0.322, 0.329, 0.336, 0.344, 0.351, 0.358, 0.365, & - & 0.372, 0.380, 0.387, 0.394, 0.401, 0.408, 0.416, 0.423, 0.430, & - & 0.437, 0.444, 0.451, 0.458, 0.466, 0.473, 0.480, 0.487, 0.494, & - & 0.501, 0.508, 0.515, 0.522, 0.529, 0.536, 0.543, 0.550, 0.557, & - & 0.564, 0.571, 0.578, 0.585, 0.592, 0.599, 0.606, 0.613, 0.620, & - & 0.626, 0.633, 0.640, 0.647, 0.654, 0.661, 0.667, 0.674, 0.681, & - & 0.688, 0.695, 0.701, 0.708, 0.715, 0.722, 0.728, 0.735, 0.742, & - & 0.748, 0.755, 0.762, 0.768, 0.775, 0.782, 0.788, 0.795, 0.801, & - & 0.808, 0.815, 0.821, 0.828, 0.834, 0.841, 0.847, 0.854, 0.860, & - & 0.867, 0.873, 0.879, 0.886, 0.892, 0.899, 0.905, 0.912, 0.918, & - & 0.924, 0.931, 0.937, 0.943, 0.950, 0.956, 0.962, 0.968, 0.975, & - & 0.981, 0.987, 0.993, 1.000, 1.006, 1.012, 1.018, 1.024, 1.031, & - & 1.037, 1.043, 1.049, 1.055, 1.061, 1.067, 1.073, 1.080, 1.086, & - & 1.092, 1.098, 1.104, 1.110, 1.116, 1.122, 1.128, 1.134, 1.140, & - & 1.146, 1.151, 1.157, 1.163, 1.169, 1.175, 1.181, 1.187, 1.193, & - & 1.199, 1.204, 1.210, 1.216, 1.222, 1.228, 1.233, 1.239, 1.245, & - & 1.251, 1.256, 1.262, 1.268, 1.273, 1.279, 1.285, 1.291, 1.296, & - & 1.302, 1.307, 1.313, 1.319, 1.324, 1.330, 1.335, 1.341, 1.347, & - & 1.352, 1.358, 1.363, 1.369, 1.374, 1.380, 1.385, 1.391, 1.396, & - & 1.402, 1.407, 1.412, 1.418, 1.423, 1.429, 1.434, 1.439, 1.445, & - & 1.450, 1.455, 1.461, 1.466, 1.471, 1.477, 1.482, 1.487, 1.493, & - & 1.498, 1.503, 1.508, 1.514, 1.519, 1.524, 1.529, 1.534, 1.540, & - & 1.545, 1.550, 1.555, 1.560, 1.565, 1.570, 1.576, 1.581, 1.586, & - & 1.591, 1.596, 1.601, 1.606, 1.611, 1.616, 1.621, 1.626, 1.631, & - & 1.636, 1.641, 1.646, 1.651, 1.656, 1.661, 1.666, 1.671, 1.676, & - & 1.681, 1.686, 1.691, 1.695, 1.700, 1.705, 1.710, 1.715, 1.720, & - & 1.725, 1.729, 1.734, 1.739, 1.744, 1.749, 1.753, 1.758, 1.763, & - & 1.768, 1.772, 1.777, 1.782, 1.786, 1.791, 1.796, 1.801, 1.805, & - & 1.810, 1.815, 1.819, 1.824, 1.829, 1.833, 1.838, 1.842, 1.847, & - & 1.852, 1.856, 1.861, 1.865, 1.870, 1.874, 1.879, 1.883, 1.888, & - & 1.892, 1.897, 1.902, 1.906, 1.954, 1.998, 2.040, 2.082, 2.124, & - & 2.164, 2.204, 2.243, 2.282, 2.319, 2.356, 2.393, 2.429, 2.464, & - & 2.499, 2.533, 2.567, 2.600, 2.632, 2.664, 2.695, 2.726, 2.757, & - & 2.787, 2.816, 2.845, 2.874, 2.902, 2.930, 2.957, 2.984, 3.010, & - & 3.036, 3.062, 3.087, 3.112, 3.137, 3.161, 3.185, 3.208, 3.232, & - & 3.254, 3.277, 3.299, 3.321, 3.342, 3.364, 3.385, 3.405, 3.426, & - & 3.446, 3.466, 3.485, 3.504, 3.523, 3.542, 3.561, 3.579, 3.597, & - & 3.615, 3.632, 3.649, 3.666, 3.683, 3.700, 3.716, 3.732, 3.748, & - & 3.764, 3.779, 3.795, 3.810, 3.825, 3.839, 3.854, 3.868, 3.882, & - & 3.896, 3.910, 3.924, 3.937, 3.950, 3.964, 3.976, 3.989, 4.002, & - & 4.014, 4.026, 4.039, 4.050, 4.062, 4.074, 4.085, 4.097, 4.108, & - & 4.119, 4.130, 4.141, 4.151, 4.162, 4.172, 4.182, 4.192, 4.202, & - & 4.212, 4.222, 4.231, 4.241, 4.250, 4.259, 4.268, 4.277, 4.286, & - & 4.295, 4.304, 4.312, 4.321, 4.329, 4.337, 4.345, 4.353, 4.361, & - & 4.369, 4.376, 4.384, 4.391, 4.399, 4.406, 4.413, 4.420, 4.427, & - & 4.434, 4.441, 4.447, 4.454, 4.460, 4.467, 4.473, 4.479, 4.485, & - & 4.491, 4.497, 4.503, 4.509, 4.515, 4.520, 4.526, 4.531, 4.537, & - & 4.542, 4.547, 4.552, 4.557, 4.562, 4.567, 4.572, 4.577, 4.582, & - & 4.586, 4.591, 4.595 & - / - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM223 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 223K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM223 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC223/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM223 - - - BLOCK DATA KMCF223 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC223/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.049,-0.101,-0.124,-0.140,-0.151,-0.159,-0.166,-0.171,-0.175, & - -0.178,-0.181,-0.183,-0.185,-0.187,-0.188,-0.188,-0.189,-0.189, & - -0.189,-0.189,-0.189,-0.189,-0.188,-0.187,-0.187,-0.186,-0.185, & - -0.184,-0.183,-0.182,-0.181,-0.180,-0.178,-0.177,-0.176,-0.174, & - -0.173,-0.172,-0.170,-0.169,-0.167,-0.166,-0.164,-0.163,-0.161, & - -0.159,-0.158,-0.156,-0.155,-0.153,-0.151,-0.150,-0.148,-0.147, & - -0.145,-0.143,-0.142,-0.140,-0.138,-0.137,-0.135,-0.134,-0.132, & - -0.130,-0.128,-0.127,-0.125,-0.123,-0.122,-0.120,-0.118,-0.117, & - -0.115,-0.113,-0.111,-0.110,-0.108,-0.106,-0.104,-0.102,-0.101, & - -0.099,-0.097,-0.095,-0.093,-0.091,-0.089,-0.087,-0.085,-0.083, & - -0.081,-0.079,-0.077,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065, & - -0.063,-0.061,-0.058,-0.056,-0.054,-0.052,-0.050,-0.048,-0.045, & - -0.043,-0.041,-0.039,-0.036,-0.034,-0.032,-0.030,-0.027,-0.025, & - -0.023,-0.020,-0.018,-0.016,-0.014,-0.011,-0.009,-0.007,-0.004, & - -0.002, 0.000, 0.003, 0.005, 0.007, 0.010, 0.012, 0.014, 0.016, & - & 0.019, 0.021, 0.023, 0.026, 0.028, 0.030, 0.033, 0.035, 0.037, & - & 0.039, 0.042, 0.044, 0.046, 0.049, 0.051, 0.053, 0.055, 0.058, & - & 0.060, 0.062, 0.064, 0.067, 0.069, 0.071, 0.073, 0.076, 0.078, & - & 0.080, 0.082, 0.085, 0.087, 0.089, 0.091, 0.094, 0.096, 0.098, & - & 0.100, 0.102, 0.105, 0.107, 0.109, 0.111, 0.113, 0.116, 0.118, & - & 0.120, 0.122, 0.124, 0.126, 0.129, 0.131, 0.133, 0.135, 0.137, & - & 0.139, 0.142, 0.144, 0.146, 0.148, 0.150, 0.152, 0.154, 0.157, & - & 0.159, 0.161, 0.163, 0.165, 0.167, 0.169, 0.171, 0.173, 0.175, & - & 0.178, 0.180, 0.182, 0.184, 0.186, 0.188, 0.190, 0.192, 0.194, & - & 0.196, 0.198, 0.200, 0.202, 0.204, 0.206, 0.208, 0.211, 0.213, & - & 0.215, 0.217, 0.219, 0.221, 0.223, 0.225, 0.227, 0.229, 0.231, & - & 0.233, 0.235, 0.237, 0.239, 0.241, 0.243, 0.245, 0.246, 0.248, & - & 0.250, 0.252, 0.254, 0.256, 0.258, 0.260, 0.262, 0.264, 0.266, & - & 0.268, 0.270, 0.272, 0.274, 0.276, 0.277, 0.279, 0.281, 0.283, & - & 0.285, 0.287, 0.289, 0.291, 0.293, 0.295, 0.296, 0.298, 0.300, & - & 0.302, 0.304, 0.306, 0.308, 0.309, 0.311, 0.313, 0.315, 0.317, & - & 0.319, 0.320, 0.322, 0.324, 0.326, 0.328, 0.330, 0.331, 0.333, & - & 0.335, 0.337, 0.339, 0.340, 0.342, 0.344, 0.346, 0.348, 0.349, & - & 0.351, 0.353, 0.355, 0.356, 0.358, 0.360, 0.362, 0.363, 0.365, & - & 0.367, 0.369, 0.370, 0.372, 0.374, 0.376, 0.377, 0.379, 0.381, & - & 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, 0.393, 0.394, 0.396, & - & 0.398, 0.400, 0.401, 0.403, 0.405, 0.406, 0.408, 0.410, 0.411, & - & 0.413, 0.415, 0.416, 0.418, 0.420, 0.421, 0.423, 0.424, 0.426, & - & 0.428, 0.429, 0.431, 0.433, 0.434, 0.436, 0.437, 0.439, 0.441, & - & 0.442, 0.444, 0.446, 0.447, 0.449, 0.450, 0.452, 0.453, 0.455, & - & 0.457, 0.458, 0.460, 0.461, 0.463, 0.464, 0.466, 0.468, 0.469, & - & 0.471, 0.472, 0.474, 0.475, 0.477, 0.478, 0.480, 0.482, 0.483, & - & 0.485, 0.486, 0.488, 0.489, 0.491, 0.492, 0.494, 0.495, 0.497, & - & 0.498, 0.500, 0.501, 0.503, 0.504, 0.506, 0.507, 0.509, 0.510, & - & 0.512, 0.513, 0.515, 0.516, 0.532, 0.546, 0.560, 0.574, 0.588, & - & 0.601, 0.614, 0.627, 0.639, 0.652, 0.664, 0.676, 0.688, 0.700, & - & 0.711, 0.722, 0.733, 0.744, 0.755, 0.765, 0.776, 0.786, 0.796, & - & 0.806, 0.816, 0.825, 0.835, 0.844, 0.853, 0.862, 0.871, 0.880, & - & 0.888, 0.897, 0.905, 0.913, 0.921, 0.929, 0.937, 0.945, 0.952, & - & 0.960, 0.967, 0.975, 0.982, 0.989, 0.996, 1.003, 1.009, 1.016, & - & 1.023, 1.029, 1.036, 1.042, 1.048, 1.054, 1.060, 1.066, 1.072, & - & 1.078, 1.084, 1.089, 1.095, 1.100, 1.106, 1.111, 1.116, 1.121, & - & 1.126, 1.131, 1.136, 1.141, 1.146, 1.151, 1.156, 1.160, 1.165, & - & 1.169, 1.174, 1.178, 1.182, 1.187, 1.191, 1.195, 1.199, 1.203, & - & 1.207, 1.211, 1.215, 1.219, 1.223, 1.226, 1.230, 1.234, 1.237, & - & 1.241, 1.244, 1.247, 1.251, 1.254, 1.257, 1.261, 1.264, 1.267, & - & 1.270, 1.273, 1.276, 1.279, 1.282, 1.285, 1.288, 1.291, 1.293, & - & 1.296, 1.299, 1.301, 1.304, 1.306, 1.309, 1.311, 1.314, 1.316, & - & 1.319, 1.321, 1.323, 1.326, 1.328, 1.330, 1.332, 1.334, 1.336, & - & 1.339, 1.341, 1.343, 1.345, 1.347, 1.348, 1.350, 1.352, 1.354, & - & 1.356, 1.358, 1.359, 1.361, 1.363, 1.364, 1.366, 1.368, 1.369, & - & 1.371, 1.372, 1.374, 1.375, 1.377, 1.378, 1.379, 1.381, 1.382, & - & 1.383, 1.385, 1.386 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.100,-0.220,-0.280,-0.323,-0.357,-0.385,-0.409,-0.431,-0.450, & - -0.468,-0.484,-0.499,-0.513,-0.526,-0.538,-0.549,-0.560,-0.571, & - -0.581,-0.590,-0.600,-0.608,-0.617,-0.625,-0.633,-0.641,-0.648, & - -0.655,-0.662,-0.669,-0.676,-0.682,-0.689,-0.695,-0.701,-0.707, & - -0.713,-0.718,-0.724,-0.729,-0.735,-0.740,-0.745,-0.750,-0.755, & - -0.760,-0.765,-0.769,-0.774,-0.779,-0.783,-0.788,-0.792,-0.796, & - -0.800,-0.805,-0.809,-0.813,-0.817,-0.821,-0.825,-0.829,-0.833, & - -0.836,-0.840,-0.844,-0.848,-0.851,-0.855,-0.858,-0.862,-0.866, & - -0.869,-0.873,-0.876,-0.879,-0.883,-0.886,-0.889,-0.893,-0.896, & - -0.899,-0.902,-0.906,-0.909,-0.912,-0.915,-0.918,-0.921,-0.924, & - -0.927,-0.930,-0.933,-0.936,-0.939,-0.942,-0.945,-0.948,-0.951, & - -0.954,-0.957,-0.960,-0.963,-0.966,-0.968,-0.971,-0.974,-0.977, & - -0.980,-0.982,-0.985,-0.988,-0.991,-0.993,-0.996,-0.999,-1.001, & - -1.004,-1.007,-1.009,-1.012,-1.015,-1.017,-1.020,-1.022,-1.025, & - -1.028,-1.030,-1.033,-1.035,-1.038,-1.040,-1.043,-1.045,-1.048, & - -1.050,-1.053,-1.055,-1.058,-1.060,-1.062,-1.065,-1.067,-1.070, & - -1.072,-1.074,-1.077,-1.079,-1.082,-1.084,-1.086,-1.089,-1.091, & - -1.093,-1.096,-1.098,-1.100,-1.102,-1.105,-1.107,-1.109,-1.112, & - -1.114,-1.116,-1.118,-1.121,-1.123,-1.125,-1.127,-1.129,-1.132, & - -1.134,-1.136,-1.138,-1.140,-1.143,-1.145,-1.147,-1.149,-1.151, & - -1.153,-1.155,-1.158,-1.160,-1.162,-1.164,-1.166,-1.168,-1.170, & - -1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.185,-1.187,-1.189, & - -1.191,-1.193,-1.195,-1.197,-1.199,-1.201,-1.203,-1.205,-1.207, & - -1.209,-1.211,-1.213,-1.215,-1.217,-1.219,-1.221,-1.223,-1.225, & - -1.227,-1.229,-1.231,-1.233,-1.235,-1.237,-1.239,-1.241,-1.243, & - -1.245,-1.247,-1.248,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260, & - -1.262,-1.264,-1.266,-1.268,-1.269,-1.271,-1.273,-1.275,-1.277, & - -1.279,-1.281,-1.283,-1.284,-1.286,-1.288,-1.290,-1.292,-1.294, & - -1.296,-1.297,-1.299,-1.301,-1.303,-1.305,-1.306,-1.308,-1.310, & - -1.312,-1.314,-1.316,-1.317,-1.319,-1.321,-1.323,-1.325,-1.326, & - -1.328,-1.330,-1.332,-1.333,-1.335,-1.337,-1.339,-1.341,-1.342, & - -1.344,-1.346,-1.348,-1.349,-1.351,-1.353,-1.355,-1.356,-1.358, & - -1.360,-1.362,-1.363,-1.365,-1.367,-1.369,-1.370,-1.372,-1.374, & - -1.375,-1.377,-1.379,-1.381,-1.382,-1.384,-1.386,-1.387,-1.389, & - -1.391,-1.393,-1.394,-1.396,-1.398,-1.399,-1.401,-1.403,-1.404, & - -1.406,-1.408,-1.409,-1.411,-1.413,-1.414,-1.416,-1.418,-1.419, & - -1.421,-1.423,-1.424,-1.426,-1.428,-1.429,-1.431,-1.433,-1.434, & - -1.436,-1.438,-1.439,-1.441,-1.442,-1.444,-1.446,-1.447,-1.449, & - -1.451,-1.452,-1.454,-1.456,-1.457,-1.459,-1.460,-1.462,-1.464, & - -1.465,-1.467,-1.468,-1.470,-1.472,-1.473,-1.475,-1.476,-1.478, & - -1.480,-1.481,-1.483,-1.484,-1.486,-1.488,-1.489,-1.491,-1.492, & - -1.494,-1.496,-1.497,-1.499,-1.500,-1.502,-1.503,-1.505,-1.507, & - -1.508,-1.510,-1.511,-1.513,-1.514,-1.516,-1.518,-1.519,-1.521, & - -1.522,-1.524,-1.525,-1.527,-1.528,-1.530,-1.531,-1.533,-1.535, & - -1.536,-1.538,-1.539,-1.541,-1.557,-1.572,-1.587,-1.602,-1.617, & - -1.632,-1.647,-1.661,-1.675,-1.690,-1.704,-1.718,-1.732,-1.746, & - -1.760,-1.774,-1.787,-1.801,-1.815,-1.828,-1.841,-1.855,-1.868, & - -1.881,-1.895,-1.908,-1.921,-1.934,-1.947,-1.960,-1.972,-1.985, & - -1.998,-2.011,-2.023,-2.036,-2.048,-2.061,-2.074,-2.086,-2.098, & - -2.111,-2.123,-2.135,-2.148,-2.160,-2.172,-2.184,-2.196,-2.208, & - -2.220,-2.232,-2.244,-2.256,-2.268,-2.280,-2.292,-2.304,-2.315, & - -2.327,-2.339,-2.351,-2.362,-2.374,-2.386,-2.397,-2.409,-2.420, & - -2.432,-2.443,-2.455,-2.466,-2.478,-2.489,-2.501,-2.512,-2.523, & - -2.535,-2.546,-2.557,-2.568,-2.580,-2.591,-2.602,-2.613,-2.625, & - -2.636,-2.647,-2.658,-2.669,-2.680,-2.691,-2.702,-2.713,-2.724, & - -2.735,-2.746,-2.757,-2.768,-2.779,-2.790,-2.801,-2.812,-2.823, & - -2.833,-2.844,-2.855,-2.866,-2.877,-2.888,-2.898,-2.909,-2.920, & - -2.930,-2.941,-2.952,-2.963,-2.973,-2.984,-2.995,-3.005,-3.016, & - -3.026,-3.037,-3.048,-3.058,-3.069,-3.079,-3.090,-3.100,-3.111, & - -3.121,-3.132,-3.142,-3.153,-3.163,-3.174,-3.184,-3.195,-3.205, & - -3.215,-3.226,-3.236,-3.247,-3.257,-3.267,-3.278,-3.288,-3.298, & - -3.309,-3.319,-3.329,-3.340,-3.350,-3.360,-3.370,-3.381,-3.391, & - -3.401,-3.411,-3.422 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.050,-0.111,-0.141,-0.164,-0.181,-0.196,-0.209,-0.220,-0.230, & - -0.239,-0.248,-0.256,-0.263,-0.270,-0.277,-0.283,-0.289,-0.295, & - -0.300,-0.306,-0.311,-0.316,-0.320,-0.325,-0.329,-0.334,-0.338, & - -0.342,-0.346,-0.350,-0.353,-0.357,-0.360,-0.364,-0.367,-0.371, & - -0.374,-0.377,-0.380,-0.384,-0.387,-0.390,-0.392,-0.395,-0.398, & - -0.401,-0.404,-0.406,-0.409,-0.412,-0.414,-0.417,-0.419,-0.422, & - -0.424,-0.427,-0.429,-0.432,-0.434,-0.436,-0.438,-0.441,-0.443, & - -0.445,-0.447,-0.449,-0.452,-0.454,-0.456,-0.458,-0.460,-0.462, & - -0.464,-0.466,-0.468,-0.470,-0.472,-0.474,-0.476,-0.478,-0.480, & - -0.482,-0.484,-0.485,-0.487,-0.489,-0.491,-0.493,-0.495,-0.496, & - -0.498,-0.500,-0.502,-0.504,-0.505,-0.507,-0.509,-0.511,-0.512, & - -0.514,-0.516,-0.518,-0.519,-0.521,-0.523,-0.524,-0.526,-0.528, & - -0.529,-0.531,-0.533,-0.534,-0.536,-0.538,-0.539,-0.541,-0.543, & - -0.544,-0.546,-0.547,-0.549,-0.551,-0.552,-0.554,-0.555,-0.557, & - -0.558,-0.560,-0.561,-0.563,-0.564,-0.566,-0.568,-0.569,-0.571, & - -0.572,-0.574,-0.575,-0.576,-0.578,-0.579,-0.581,-0.582,-0.584, & - -0.585,-0.587,-0.588,-0.590,-0.591,-0.592,-0.594,-0.595,-0.597, & - -0.598,-0.600,-0.601,-0.602,-0.604,-0.605,-0.606,-0.608,-0.609, & - -0.611,-0.612,-0.613,-0.615,-0.616,-0.617,-0.619,-0.620,-0.621, & - -0.623,-0.624,-0.625,-0.627,-0.628,-0.629,-0.631,-0.632,-0.633, & - -0.635,-0.636,-0.637,-0.638,-0.640,-0.641,-0.642,-0.643,-0.645, & - -0.646,-0.647,-0.649,-0.650,-0.651,-0.652,-0.654,-0.655,-0.656, & - -0.657,-0.659,-0.660,-0.661,-0.662,-0.663,-0.665,-0.666,-0.667, & - -0.668,-0.670,-0.671,-0.672,-0.673,-0.674,-0.676,-0.677,-0.678, & - -0.679,-0.680,-0.681,-0.683,-0.684,-0.685,-0.686,-0.687,-0.689, & - -0.690,-0.691,-0.692,-0.693,-0.694,-0.695,-0.697,-0.698,-0.699, & - -0.700,-0.701,-0.702,-0.703,-0.705,-0.706,-0.707,-0.708,-0.709, & - -0.710,-0.711,-0.712,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719, & - -0.720,-0.721,-0.722,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, & - -0.730,-0.731,-0.732,-0.733,-0.734,-0.736,-0.737,-0.738,-0.739, & - -0.740,-0.741,-0.742,-0.743,-0.744,-0.745,-0.746,-0.747,-0.748, & - -0.749,-0.750,-0.751,-0.753,-0.754,-0.755,-0.756,-0.757,-0.758, & - -0.759,-0.760,-0.761,-0.762,-0.763,-0.764,-0.765,-0.766,-0.767, & - -0.768,-0.769,-0.770,-0.771,-0.772,-0.773,-0.774,-0.775,-0.776, & - -0.777,-0.778,-0.779,-0.780,-0.781,-0.782,-0.783,-0.784,-0.785, & - -0.786,-0.787,-0.788,-0.789,-0.790,-0.791,-0.792,-0.793,-0.794, & - -0.795,-0.796,-0.797,-0.798,-0.799,-0.800,-0.801,-0.802,-0.803, & - -0.804,-0.805,-0.806,-0.807,-0.808,-0.809,-0.810,-0.811,-0.812, & - -0.813,-0.814,-0.815,-0.816,-0.817,-0.818,-0.818,-0.819,-0.820, & - -0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828,-0.829, & - -0.830,-0.831,-0.832,-0.833,-0.834,-0.835,-0.835,-0.836,-0.837, & - -0.838,-0.839,-0.840,-0.841,-0.842,-0.843,-0.844,-0.845,-0.846, & - -0.847,-0.848,-0.848,-0.849,-0.850,-0.851,-0.852,-0.853,-0.854, & - -0.855,-0.856,-0.857,-0.858,-0.859,-0.859,-0.860,-0.861,-0.862, & - -0.863,-0.864,-0.865,-0.866,-0.875,-0.884,-0.893,-0.902,-0.910, & - -0.919,-0.927,-0.936,-0.944,-0.952,-0.961,-0.969,-0.977,-0.985, & - -0.993,-1.001,-1.008,-1.016,-1.024,-1.032,-1.039,-1.047,-1.054, & - -1.062,-1.069,-1.077,-1.084,-1.092,-1.099,-1.106,-1.113,-1.121, & - -1.128,-1.135,-1.142,-1.149,-1.156,-1.163,-1.170,-1.177,-1.184, & - -1.191,-1.198,-1.204,-1.211,-1.218,-1.225,-1.231,-1.238,-1.245, & - -1.251,-1.258,-1.265,-1.271,-1.278,-1.284,-1.291,-1.297,-1.304, & - -1.310,-1.317,-1.323,-1.330,-1.336,-1.342,-1.349,-1.355,-1.361, & - -1.368,-1.374,-1.380,-1.386,-1.393,-1.399,-1.405,-1.411,-1.417, & - -1.423,-1.430,-1.436,-1.442,-1.448,-1.454,-1.460,-1.466,-1.472, & - -1.478,-1.484,-1.490,-1.496,-1.502,-1.508,-1.514,-1.520,-1.526, & - -1.532,-1.538,-1.543,-1.549,-1.555,-1.561,-1.567,-1.573,-1.578, & - -1.584,-1.590,-1.596,-1.602,-1.607,-1.613,-1.619,-1.625,-1.630, & - -1.636,-1.642,-1.648,-1.653,-1.659,-1.665,-1.670,-1.676,-1.682, & - -1.687,-1.693,-1.698,-1.704,-1.710,-1.715,-1.721,-1.726,-1.732, & - -1.738,-1.743,-1.749,-1.754,-1.760,-1.765,-1.771,-1.776,-1.782, & - -1.787,-1.793,-1.798,-1.804,-1.809,-1.815,-1.820,-1.826,-1.831, & - -1.837,-1.842,-1.847,-1.853,-1.858,-1.864,-1.869,-1.875,-1.880, & - -1.885,-1.891,-1.896 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.101,-0.220,-0.281,-0.324,-0.358,-0.387,-0.412,-0.434,-0.453, & - -0.471,-0.487,-0.503,-0.517,-0.530,-0.543,-0.555,-0.566,-0.577, & - -0.587,-0.597,-0.606,-0.615,-0.624,-0.632,-0.641,-0.649,-0.656, & - -0.664,-0.671,-0.678,-0.685,-0.692,-0.698,-0.705,-0.711,-0.717, & - -0.723,-0.729,-0.735,-0.740,-0.746,-0.752,-0.757,-0.762,-0.767, & - -0.772,-0.777,-0.782,-0.787,-0.792,-0.797,-0.801,-0.806,-0.810, & - -0.815,-0.819,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848, & - -0.852,-0.856,-0.860,-0.864,-0.868,-0.872,-0.876,-0.879,-0.883, & - -0.887,-0.890,-0.894,-0.897,-0.901,-0.904,-0.908,-0.911,-0.915, & - -0.918,-0.922,-0.925,-0.928,-0.932,-0.935,-0.938,-0.942,-0.945, & - -0.948,-0.951,-0.954,-0.958,-0.961,-0.964,-0.967,-0.970,-0.973, & - -0.976,-0.979,-0.982,-0.985,-0.988,-0.991,-0.994,-0.997,-1.000, & - -1.003,-1.006,-1.009,-1.012,-1.015,-1.018,-1.021,-1.024,-1.026, & - -1.029,-1.032,-1.035,-1.038,-1.040,-1.043,-1.046,-1.049,-1.051, & - -1.054,-1.057,-1.060,-1.062,-1.065,-1.068,-1.070,-1.073,-1.076, & - -1.078,-1.081,-1.083,-1.086,-1.089,-1.091,-1.094,-1.096,-1.099, & - -1.102,-1.104,-1.107,-1.109,-1.112,-1.114,-1.117,-1.119,-1.122, & - -1.124,-1.127,-1.129,-1.131,-1.134,-1.136,-1.139,-1.141,-1.144, & - -1.146,-1.148,-1.151,-1.153,-1.155,-1.158,-1.160,-1.163,-1.165, & - -1.167,-1.170,-1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.186, & - -1.188,-1.190,-1.193,-1.195,-1.197,-1.199,-1.202,-1.204,-1.206, & - -1.208,-1.210,-1.213,-1.215,-1.217,-1.219,-1.221,-1.224,-1.226, & - -1.228,-1.230,-1.232,-1.235,-1.237,-1.239,-1.241,-1.243,-1.245, & - -1.247,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260,-1.262,-1.264, & - -1.266,-1.269,-1.271,-1.273,-1.275,-1.277,-1.279,-1.281,-1.283, & - -1.285,-1.287,-1.289,-1.291,-1.293,-1.295,-1.297,-1.299,-1.301, & - -1.303,-1.305,-1.307,-1.309,-1.311,-1.313,-1.315,-1.317,-1.319, & - -1.321,-1.323,-1.325,-1.327,-1.329,-1.331,-1.333,-1.335,-1.337, & - -1.339,-1.341,-1.343,-1.345,-1.347,-1.349,-1.351,-1.353,-1.355, & - -1.357,-1.358,-1.360,-1.362,-1.364,-1.366,-1.368,-1.370,-1.372, & - -1.374,-1.376,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389, & - -1.391,-1.392,-1.394,-1.396,-1.398,-1.400,-1.402,-1.404,-1.405, & - -1.407,-1.409,-1.411,-1.413,-1.415,-1.417,-1.418,-1.420,-1.422, & - -1.424,-1.426,-1.427,-1.429,-1.431,-1.433,-1.435,-1.437,-1.438, & - -1.440,-1.442,-1.444,-1.445,-1.447,-1.449,-1.451,-1.453,-1.454, & - -1.456,-1.458,-1.460,-1.462,-1.463,-1.465,-1.467,-1.469,-1.470, & - -1.472,-1.474,-1.476,-1.477,-1.479,-1.481,-1.483,-1.484,-1.486, & - -1.488,-1.490,-1.491,-1.493,-1.495,-1.496,-1.498,-1.500,-1.502, & - -1.503,-1.505,-1.507,-1.509,-1.510,-1.512,-1.514,-1.515,-1.517, & - -1.519,-1.520,-1.522,-1.524,-1.526,-1.527,-1.529,-1.531,-1.532, & - -1.534,-1.536,-1.537,-1.539,-1.541,-1.542,-1.544,-1.546,-1.547, & - -1.549,-1.551,-1.552,-1.554,-1.556,-1.557,-1.559,-1.561,-1.562, & - -1.564,-1.566,-1.567,-1.569,-1.571,-1.572,-1.574,-1.576,-1.577, & - -1.579,-1.580,-1.582,-1.584,-1.585,-1.587,-1.589,-1.590,-1.592, & - -1.594,-1.595,-1.597,-1.598,-1.616,-1.632,-1.648,-1.663,-1.679, & - -1.694,-1.710,-1.725,-1.740,-1.755,-1.770,-1.785,-1.799,-1.814, & - -1.828,-1.843,-1.857,-1.871,-1.885,-1.900,-1.914,-1.928,-1.941, & - -1.955,-1.969,-1.983,-1.996,-2.010,-2.023,-2.037,-2.050,-2.063, & - -2.077,-2.090,-2.103,-2.116,-2.129,-2.142,-2.155,-2.168,-2.181, & - -2.194,-2.206,-2.219,-2.232,-2.244,-2.257,-2.269,-2.282,-2.294, & - -2.307,-2.319,-2.332,-2.344,-2.356,-2.369,-2.381,-2.393,-2.405, & - -2.417,-2.429,-2.441,-2.454,-2.466,-2.478,-2.489,-2.501,-2.513, & - -2.525,-2.537,-2.549,-2.561,-2.572,-2.584,-2.596,-2.608,-2.619, & - -2.631,-2.642,-2.654,-2.666,-2.677,-2.689,-2.700,-2.712,-2.723, & - -2.735,-2.746,-2.757,-2.769,-2.780,-2.792,-2.803,-2.814,-2.825, & - -2.837,-2.848,-2.859,-2.870,-2.882,-2.893,-2.904,-2.915,-2.926, & - -2.937,-2.948,-2.959,-2.971,-2.982,-2.993,-3.004,-3.015,-3.026, & - -3.037,-3.048,-3.058,-3.069,-3.080,-3.091,-3.102,-3.113,-3.124, & - -3.135,-3.145,-3.156,-3.167,-3.178,-3.189,-3.199,-3.210,-3.221, & - -3.232,-3.242,-3.253,-3.264,-3.274,-3.285,-3.296,-3.306,-3.317, & - -3.327,-3.338,-3.349,-3.359,-3.370,-3.380,-3.391,-3.401,-3.412, & - -3.422,-3.433,-3.443,-3.454,-3.464,-3.475,-3.485,-3.496,-3.506, & - -3.517,-3.527,-3.537 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.051,-0.114,-0.148,-0.172,-0.192,-0.209,-0.224,-0.238,-0.250, & - -0.262,-0.272,-0.282,-0.292,-0.301,-0.310,-0.318,-0.326,-0.333, & - -0.341,-0.348,-0.355,-0.362,-0.368,-0.375,-0.381,-0.387,-0.393, & - -0.398,-0.404,-0.410,-0.415,-0.420,-0.426,-0.431,-0.436,-0.441, & - -0.446,-0.450,-0.455,-0.460,-0.464,-0.469,-0.473,-0.477,-0.482, & - -0.486,-0.490,-0.494,-0.498,-0.502,-0.506,-0.510,-0.514,-0.518, & - -0.521,-0.525,-0.529,-0.532,-0.536,-0.539,-0.543,-0.546,-0.550, & - -0.553,-0.556,-0.560,-0.563,-0.566,-0.570,-0.573,-0.576,-0.579, & - -0.582,-0.585,-0.588,-0.592,-0.595,-0.598,-0.601,-0.604,-0.607, & - -0.610,-0.613,-0.616,-0.619,-0.622,-0.624,-0.627,-0.630,-0.633, & - -0.636,-0.639,-0.642,-0.645,-0.647,-0.650,-0.653,-0.656,-0.659, & - -0.662,-0.664,-0.667,-0.670,-0.673,-0.675,-0.678,-0.681,-0.684, & - -0.686,-0.689,-0.692,-0.694,-0.697,-0.700,-0.702,-0.705,-0.708, & - -0.710,-0.713,-0.716,-0.718,-0.721,-0.723,-0.726,-0.729,-0.731, & - -0.734,-0.736,-0.739,-0.741,-0.744,-0.746,-0.749,-0.751,-0.754, & - -0.756,-0.759,-0.761,-0.764,-0.766,-0.768,-0.771,-0.773,-0.776, & - -0.778,-0.780,-0.783,-0.785,-0.787,-0.790,-0.792,-0.794,-0.797, & - -0.799,-0.801,-0.804,-0.806,-0.808,-0.810,-0.813,-0.815,-0.817, & - -0.819,-0.822,-0.824,-0.826,-0.828,-0.831,-0.833,-0.835,-0.837, & - -0.839,-0.841,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, & - -0.858,-0.860,-0.863,-0.865,-0.867,-0.869,-0.871,-0.873,-0.875, & - -0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.889,-0.891,-0.893, & - -0.895,-0.897,-0.899,-0.901,-0.903,-0.905,-0.907,-0.909,-0.911, & - -0.913,-0.915,-0.917,-0.919,-0.920,-0.922,-0.924,-0.926,-0.928, & - -0.930,-0.932,-0.934,-0.936,-0.938,-0.939,-0.941,-0.943,-0.945, & - -0.947,-0.949,-0.950,-0.952,-0.954,-0.956,-0.958,-0.960,-0.961, & - -0.963,-0.965,-0.967,-0.969,-0.970,-0.972,-0.974,-0.976,-0.977, & - -0.979,-0.981,-0.983,-0.984,-0.986,-0.988,-0.990,-0.991,-0.993, & - -0.995,-0.997,-0.998,-1.000,-1.002,-1.003,-1.005,-1.007,-1.008, & - -1.010,-1.012,-1.013,-1.015,-1.017,-1.019,-1.020,-1.022,-1.023, & - -1.025,-1.027,-1.028,-1.030,-1.032,-1.033,-1.035,-1.037,-1.038, & - -1.040,-1.041,-1.043,-1.045,-1.046,-1.048,-1.049,-1.051,-1.053, & - -1.054,-1.056,-1.057,-1.059,-1.061,-1.062,-1.064,-1.065,-1.067, & - -1.068,-1.070,-1.071,-1.073,-1.075,-1.076,-1.078,-1.079,-1.081, & - -1.082,-1.084,-1.085,-1.087,-1.088,-1.090,-1.091,-1.093,-1.094, & - -1.096,-1.097,-1.099,-1.100,-1.102,-1.103,-1.105,-1.106,-1.108, & - -1.109,-1.111,-1.112,-1.114,-1.115,-1.116,-1.118,-1.119,-1.121, & - -1.122,-1.124,-1.125,-1.127,-1.128,-1.129,-1.131,-1.132,-1.134, & - -1.135,-1.137,-1.138,-1.139,-1.141,-1.142,-1.144,-1.145,-1.146, & - -1.148,-1.149,-1.151,-1.152,-1.153,-1.155,-1.156,-1.158,-1.159, & - -1.160,-1.162,-1.163,-1.164,-1.166,-1.167,-1.168,-1.170,-1.171, & - -1.173,-1.174,-1.175,-1.177,-1.178,-1.179,-1.181,-1.182,-1.183, & - -1.185,-1.186,-1.187,-1.189,-1.190,-1.191,-1.193,-1.194,-1.195, & - -1.197,-1.198,-1.199,-1.200,-1.202,-1.203,-1.204,-1.206,-1.207, & - -1.208,-1.210,-1.211,-1.212,-1.226,-1.238,-1.251,-1.263,-1.275, & - -1.287,-1.298,-1.310,-1.321,-1.333,-1.344,-1.355,-1.365,-1.376, & - -1.387,-1.397,-1.407,-1.417,-1.427,-1.437,-1.447,-1.457,-1.467, & - -1.476,-1.486,-1.495,-1.505,-1.514,-1.523,-1.532,-1.541,-1.550, & - -1.559,-1.567,-1.576,-1.585,-1.593,-1.602,-1.610,-1.619,-1.627, & - -1.635,-1.643,-1.651,-1.659,-1.667,-1.675,-1.683,-1.691,-1.699, & - -1.707,-1.715,-1.722,-1.730,-1.737,-1.745,-1.752,-1.760,-1.767, & - -1.775,-1.782,-1.789,-1.797,-1.804,-1.811,-1.818,-1.825,-1.832, & - -1.840,-1.847,-1.854,-1.861,-1.867,-1.874,-1.881,-1.888,-1.895, & - -1.902,-1.908,-1.915,-1.922,-1.929,-1.935,-1.942,-1.948,-1.955, & - -1.962,-1.968,-1.975,-1.981,-1.988,-1.994,-2.000,-2.007,-2.013, & - -2.020,-2.026,-2.032,-2.039,-2.045,-2.051,-2.057,-2.064,-2.070, & - -2.076,-2.082,-2.088,-2.094,-2.100,-2.107,-2.113,-2.119,-2.125, & - -2.131,-2.137,-2.143,-2.149,-2.155,-2.161,-2.167,-2.173,-2.179, & - -2.184,-2.190,-2.196,-2.202,-2.208,-2.214,-2.220,-2.225,-2.231, & - -2.237,-2.243,-2.248,-2.254,-2.260,-2.266,-2.271,-2.277,-2.283, & - -2.288,-2.294,-2.300,-2.305,-2.311,-2.317,-2.322,-2.328,-2.333, & - -2.339,-2.345,-2.350,-2.356,-2.361,-2.367,-2.372,-2.378,-2.383, & - -2.389,-2.394,-2.400 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.049,-0.106,-0.133,-0.151,-0.166,-0.177,-0.187,-0.195,-0.202, & - -0.208,-0.214,-0.219,-0.224,-0.228,-0.231,-0.235,-0.238,-0.241, & - -0.244,-0.246,-0.249,-0.251,-0.253,-0.255,-0.257,-0.259,-0.260, & - -0.262,-0.264,-0.265,-0.266,-0.268,-0.269,-0.270,-0.271,-0.272, & - -0.273,-0.274,-0.275,-0.276,-0.277,-0.278,-0.278,-0.279,-0.280, & - -0.281,-0.281,-0.282,-0.283,-0.283,-0.284,-0.284,-0.285,-0.285, & - -0.286,-0.287,-0.287,-0.288,-0.288,-0.288,-0.289,-0.289,-0.290, & - -0.290,-0.291,-0.291,-0.291,-0.292,-0.292,-0.292,-0.293,-0.293, & - -0.293,-0.294,-0.294,-0.294,-0.294,-0.295,-0.295,-0.295,-0.295, & - -0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.297,-0.297,-0.297, & - -0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, & - -0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, & - -0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297,-0.297, & - -0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296,-0.296, & - -0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.295,-0.294,-0.294, & - -0.294,-0.294,-0.294,-0.294,-0.294,-0.293,-0.293,-0.293,-0.293, & - -0.293,-0.293,-0.292,-0.292,-0.292,-0.292,-0.292,-0.292,-0.291, & - -0.291,-0.291,-0.291,-0.291,-0.291,-0.290,-0.290,-0.290,-0.290, & - -0.290,-0.290,-0.289,-0.289,-0.289,-0.289,-0.289,-0.288,-0.288, & - -0.288,-0.288,-0.288,-0.288,-0.287,-0.287,-0.287,-0.287,-0.287, & - -0.287,-0.286,-0.286,-0.286,-0.286,-0.286,-0.286,-0.285,-0.285, & - -0.285,-0.285,-0.285,-0.284,-0.284,-0.284,-0.284,-0.284,-0.284, & - -0.283,-0.283,-0.283,-0.283,-0.283,-0.283,-0.282,-0.282,-0.282, & - -0.282,-0.282,-0.282,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, & - -0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.279,-0.279,-0.279, & - -0.279,-0.279,-0.279,-0.278,-0.278,-0.278,-0.278,-0.278,-0.278, & - -0.277,-0.277,-0.277,-0.277,-0.277,-0.277,-0.276,-0.276,-0.276, & - -0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.275, & - -0.275,-0.275,-0.274,-0.274,-0.274,-0.274,-0.274,-0.274,-0.273, & - -0.273,-0.273,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272,-0.272, & - -0.272,-0.272,-0.272,-0.272,-0.271,-0.271,-0.271,-0.271,-0.271, & - -0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.270,-0.270, & - -0.270,-0.270,-0.269,-0.269,-0.269,-0.269,-0.269,-0.269,-0.269, & - -0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268, & - -0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.266, & - -0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265, & - -0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.265, & - -0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264,-0.264, & - -0.264,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263,-0.263, & - -0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.262,-0.262, & - -0.262,-0.262,-0.262,-0.262,-0.262,-0.262,-0.261,-0.261,-0.261, & - -0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261,-0.261, & - -0.261,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.260, & - -0.260,-0.260,-0.260,-0.260,-0.260,-0.260,-0.259,-0.259,-0.259, & - -0.259,-0.259,-0.259,-0.259,-0.258,-0.258,-0.257,-0.257,-0.257, & - -0.256,-0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.256,-0.256, & - -0.256,-0.256,-0.256,-0.256,-0.257,-0.257,-0.257,-0.258,-0.258, & - -0.259,-0.259,-0.260,-0.260,-0.261,-0.262,-0.262,-0.263,-0.264, & - -0.265,-0.265,-0.266,-0.267,-0.268,-0.269,-0.270,-0.271,-0.272, & - -0.273,-0.274,-0.275,-0.277,-0.278,-0.279,-0.280,-0.281,-0.283, & - -0.284,-0.285,-0.287,-0.288,-0.289,-0.291,-0.292,-0.294,-0.295, & - -0.297,-0.298,-0.300,-0.301,-0.303,-0.304,-0.306,-0.308,-0.309, & - -0.311,-0.313,-0.314,-0.316,-0.318,-0.320,-0.321,-0.323,-0.325, & - -0.327,-0.329,-0.331,-0.332,-0.334,-0.336,-0.338,-0.340,-0.342, & - -0.344,-0.346,-0.348,-0.350,-0.352,-0.354,-0.356,-0.358,-0.360, & - -0.362,-0.364,-0.367,-0.369,-0.371,-0.373,-0.375,-0.377,-0.379, & - -0.382,-0.384,-0.386,-0.388,-0.391,-0.393,-0.395,-0.397,-0.400, & - -0.402,-0.404,-0.406,-0.409,-0.411,-0.413,-0.416,-0.418,-0.421, & - -0.423,-0.425,-0.428,-0.430,-0.433,-0.435,-0.437,-0.440,-0.442, & - -0.445,-0.447,-0.450,-0.452,-0.455,-0.457,-0.460,-0.462,-0.465, & - -0.467,-0.470,-0.472,-0.475,-0.477,-0.480,-0.483,-0.485,-0.488, & - -0.490,-0.493,-0.496,-0.498,-0.501,-0.503,-0.506,-0.509,-0.511, & - -0.514,-0.517,-0.519 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.100,-0.219,-0.279,-0.321,-0.354,-0.382,-0.406,-0.427,-0.446, & - -0.463,-0.479,-0.493,-0.506,-0.519,-0.531,-0.542,-0.552,-0.562, & - -0.572,-0.581,-0.590,-0.598,-0.606,-0.614,-0.622,-0.629,-0.636, & - -0.643,-0.650,-0.656,-0.662,-0.668,-0.674,-0.680,-0.686,-0.692, & - -0.697,-0.702,-0.707,-0.713,-0.718,-0.722,-0.727,-0.732,-0.737, & - -0.741,-0.746,-0.750,-0.754,-0.759,-0.763,-0.767,-0.771,-0.775, & - -0.779,-0.783,-0.787,-0.791,-0.794,-0.798,-0.802,-0.805,-0.809, & - -0.813,-0.816,-0.820,-0.823,-0.826,-0.830,-0.833,-0.836,-0.840, & - -0.843,-0.846,-0.849,-0.852,-0.855,-0.859,-0.862,-0.865,-0.868, & - -0.871,-0.874,-0.877,-0.879,-0.882,-0.885,-0.888,-0.891,-0.894, & - -0.897,-0.899,-0.902,-0.905,-0.908,-0.910,-0.913,-0.916,-0.918, & - -0.921,-0.924,-0.926,-0.929,-0.932,-0.934,-0.937,-0.939,-0.942, & - -0.944,-0.947,-0.949,-0.952,-0.954,-0.957,-0.959,-0.962,-0.964, & - -0.967,-0.969,-0.971,-0.974,-0.976,-0.978,-0.981,-0.983,-0.985, & - -0.988,-0.990,-0.992,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006, & - -1.008,-1.011,-1.013,-1.015,-1.017,-1.019,-1.022,-1.024,-1.026, & - -1.028,-1.030,-1.032,-1.034,-1.037,-1.039,-1.041,-1.043,-1.045, & - -1.047,-1.049,-1.051,-1.053,-1.056,-1.058,-1.060,-1.062,-1.064, & - -1.066,-1.068,-1.070,-1.072,-1.074,-1.076,-1.078,-1.080,-1.082, & - -1.084,-1.086,-1.088,-1.090,-1.092,-1.094,-1.096,-1.098,-1.099, & - -1.101,-1.103,-1.105,-1.107,-1.109,-1.111,-1.113,-1.115,-1.117, & - -1.119,-1.121,-1.122,-1.124,-1.126,-1.128,-1.130,-1.132,-1.134, & - -1.135,-1.137,-1.139,-1.141,-1.143,-1.145,-1.146,-1.148,-1.150, & - -1.152,-1.154,-1.156,-1.157,-1.159,-1.161,-1.163,-1.165,-1.166, & - -1.168,-1.170,-1.172,-1.173,-1.175,-1.177,-1.179,-1.180,-1.182, & - -1.184,-1.186,-1.187,-1.189,-1.191,-1.193,-1.194,-1.196,-1.198, & - -1.200,-1.201,-1.203,-1.205,-1.206,-1.208,-1.210,-1.212,-1.213, & - -1.215,-1.217,-1.218,-1.220,-1.222,-1.223,-1.225,-1.227,-1.228, & - -1.230,-1.232,-1.233,-1.235,-1.237,-1.238,-1.240,-1.242,-1.243, & - -1.245,-1.247,-1.248,-1.250,-1.251,-1.253,-1.255,-1.256,-1.258, & - -1.260,-1.261,-1.263,-1.264,-1.266,-1.268,-1.269,-1.271,-1.273, & - -1.274,-1.276,-1.277,-1.279,-1.280,-1.282,-1.284,-1.285,-1.287, & - -1.288,-1.290,-1.292,-1.293,-1.295,-1.296,-1.298,-1.299,-1.301, & - -1.303,-1.304,-1.306,-1.307,-1.309,-1.310,-1.312,-1.313,-1.315, & - -1.317,-1.318,-1.320,-1.321,-1.323,-1.324,-1.326,-1.327,-1.329, & - -1.330,-1.332,-1.333,-1.335,-1.337,-1.338,-1.340,-1.341,-1.343, & - -1.344,-1.346,-1.347,-1.349,-1.350,-1.352,-1.353,-1.355,-1.356, & - -1.358,-1.359,-1.361,-1.362,-1.364,-1.365,-1.367,-1.368,-1.370, & - -1.371,-1.373,-1.374,-1.376,-1.377,-1.379,-1.380,-1.381,-1.383, & - -1.384,-1.386,-1.387,-1.389,-1.390,-1.392,-1.393,-1.395,-1.396, & - -1.398,-1.399,-1.401,-1.402,-1.403,-1.405,-1.406,-1.408,-1.409, & - -1.411,-1.412,-1.414,-1.415,-1.416,-1.418,-1.419,-1.421,-1.422, & - -1.424,-1.425,-1.427,-1.428,-1.429,-1.431,-1.432,-1.434,-1.435, & - -1.437,-1.438,-1.439,-1.441,-1.442,-1.444,-1.445,-1.447,-1.448, & - -1.449,-1.451,-1.452,-1.454,-1.469,-1.483,-1.497,-1.510,-1.524, & - -1.537,-1.551,-1.564,-1.578,-1.591,-1.604,-1.617,-1.630,-1.643, & - -1.656,-1.669,-1.681,-1.694,-1.707,-1.719,-1.732,-1.744,-1.756, & - -1.769,-1.781,-1.793,-1.806,-1.818,-1.830,-1.842,-1.854,-1.866, & - -1.878,-1.890,-1.902,-1.914,-1.925,-1.937,-1.949,-1.961,-1.972, & - -1.984,-1.996,-2.007,-2.019,-2.030,-2.042,-2.053,-2.065,-2.076, & - -2.087,-2.099,-2.110,-2.121,-2.133,-2.144,-2.155,-2.166,-2.178, & - -2.189,-2.200,-2.211,-2.222,-2.233,-2.244,-2.255,-2.266,-2.277, & - -2.288,-2.299,-2.310,-2.321,-2.332,-2.343,-2.354,-2.365,-2.375, & - -2.386,-2.397,-2.408,-2.419,-2.429,-2.440,-2.451,-2.461,-2.472, & - -2.483,-2.494,-2.504,-2.515,-2.525,-2.536,-2.547,-2.557,-2.568, & - -2.578,-2.589,-2.599,-2.610,-2.620,-2.631,-2.641,-2.652,-2.662, & - -2.673,-2.683,-2.693,-2.704,-2.714,-2.725,-2.735,-2.745,-2.756, & - -2.766,-2.776,-2.787,-2.797,-2.807,-2.817,-2.828,-2.838,-2.848, & - -2.858,-2.869,-2.879,-2.889,-2.899,-2.909,-2.920,-2.930,-2.940, & - -2.950,-2.960,-2.970,-2.980,-2.991,-3.001,-3.011,-3.021,-3.031, & - -3.041,-3.051,-3.061,-3.071,-3.081,-3.091,-3.101,-3.111,-3.121, & - -3.131,-3.141,-3.151,-3.161,-3.171,-3.181,-3.191,-3.201,-3.211, & - -3.221,-3.231,-3.241 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.047,-0.091,-0.109,-0.119,-0.125,-0.128,-0.130,-0.131,-0.130, & - -0.129,-0.128,-0.125,-0.122,-0.119,-0.115,-0.111,-0.107,-0.102, & - -0.097,-0.092,-0.086,-0.080,-0.074,-0.068,-0.062,-0.055,-0.048, & - -0.041,-0.034,-0.027,-0.019,-0.012,-0.004, 0.004, 0.012, 0.020, & - & 0.028, 0.037, 0.045, 0.054, 0.063, 0.071, 0.080, 0.089, 0.098, & - & 0.108, 0.117, 0.126, 0.136, 0.145, 0.155, 0.164, 0.174, 0.184, & - & 0.193, 0.203, 0.213, 0.223, 0.233, 0.243, 0.253, 0.263, 0.274, & - & 0.284, 0.294, 0.304, 0.315, 0.325, 0.336, 0.346, 0.357, 0.368, & - & 0.378, 0.389, 0.400, 0.411, 0.421, 0.432, 0.443, 0.455, 0.466, & - & 0.477, 0.488, 0.499, 0.511, 0.522, 0.534, 0.545, 0.557, 0.568, & - & 0.580, 0.592, 0.604, 0.615, 0.627, 0.639, 0.651, 0.664, 0.676, & - & 0.688, 0.700, 0.712, 0.725, 0.737, 0.749, 0.762, 0.774, 0.787, & - & 0.799, 0.812, 0.824, 0.837, 0.849, 0.862, 0.875, 0.887, 0.900, & - & 0.913, 0.925, 0.938, 0.951, 0.963, 0.976, 0.989, 1.001, 1.014, & - & 1.027, 1.039, 1.052, 1.064, 1.077, 1.090, 1.102, 1.115, 1.127, & - & 1.140, 1.152, 1.165, 1.177, 1.190, 1.202, 1.215, 1.227, 1.239, & - & 1.252, 1.264, 1.276, 1.289, 1.301, 1.313, 1.325, 1.338, 1.350, & - & 1.362, 1.374, 1.386, 1.398, 1.410, 1.422, 1.434, 1.446, 1.458, & - & 1.470, 1.482, 1.494, 1.506, 1.518, 1.530, 1.541, 1.553, 1.565, & - & 1.577, 1.588, 1.600, 1.612, 1.623, 1.635, 1.646, 1.658, 1.669, & - & 1.681, 1.692, 1.704, 1.715, 1.727, 1.738, 1.749, 1.761, 1.772, & - & 1.783, 1.794, 1.806, 1.817, 1.828, 1.839, 1.850, 1.861, 1.872, & - & 1.883, 1.894, 1.905, 1.916, 1.927, 1.938, 1.949, 1.960, 1.971, & - & 1.982, 1.992, 2.003, 2.014, 2.025, 2.035, 2.046, 2.057, 2.067, & - & 2.078, 2.088, 2.099, 2.109, 2.120, 2.130, 2.141, 2.151, 2.162, & - & 2.172, 2.182, 2.193, 2.203, 2.213, 2.224, 2.234, 2.244, 2.254, & - & 2.265, 2.275, 2.285, 2.295, 2.305, 2.315, 2.325, 2.335, 2.345, & - & 2.355, 2.365, 2.375, 2.385, 2.395, 2.405, 2.415, 2.424, 2.434, & - & 2.444, 2.454, 2.464, 2.473, 2.483, 2.493, 2.502, 2.512, 2.522, & - & 2.531, 2.541, 2.550, 2.560, 2.569, 2.579, 2.588, 2.598, 2.607, & - & 2.617, 2.626, 2.635, 2.645, 2.654, 2.663, 2.673, 2.682, 2.691, & - & 2.701, 2.710, 2.719, 2.728, 2.737, 2.746, 2.756, 2.765, 2.774, & - & 2.783, 2.792, 2.801, 2.810, 2.819, 2.828, 2.837, 2.846, 2.855, & - & 2.864, 2.873, 2.881, 2.890, 2.899, 2.908, 2.917, 2.925, 2.934, & - & 2.943, 2.952, 2.960, 2.969, 2.978, 2.986, 2.995, 3.004, 3.012, & - & 3.021, 3.029, 3.038, 3.047, 3.055, 3.064, 3.072, 3.080, 3.089, & - & 3.097, 3.106, 3.114, 3.123, 3.131, 3.139, 3.148, 3.156, 3.164, & - & 3.173, 3.181, 3.189, 3.197, 3.206, 3.214, 3.222, 3.230, 3.238, & - & 3.246, 3.255, 3.263, 3.271, 3.279, 3.287, 3.295, 3.303, 3.311, & - & 3.319, 3.327, 3.335, 3.343, 3.351, 3.359, 3.367, 3.375, 3.383, & - & 3.390, 3.398, 3.406, 3.414, 3.422, 3.430, 3.437, 3.445, 3.453, & - & 3.461, 3.468, 3.476, 3.484, 3.492, 3.499, 3.507, 3.515, 3.522, & - & 3.530, 3.537, 3.545, 3.553, 3.560, 3.568, 3.575, 3.583, 3.590, & - & 3.598, 3.605, 3.613, 3.620, 3.628, 3.635, 3.642, 3.650, 3.657, & - & 3.665, 3.672, 3.679, 3.687, 3.765, 3.837, 3.907, 3.976, 4.044, & - & 4.111, 4.176, 4.241, 4.305, 4.368, 4.429, 4.490, 4.550, 4.609, & - & 4.668, 4.725, 4.782, 4.838, 4.893, 4.947, 5.001, 5.054, 5.106, & - & 5.157, 5.208, 5.259, 5.308, 5.357, 5.406, 5.453, 5.501, 5.547, & - & 5.593, 5.639, 5.684, 5.729, 5.773, 5.816, 5.859, 5.902, 5.944, & - & 5.986, 6.027, 6.068, 6.108, 6.148, 6.188, 6.227, 6.265, 6.304, & - & 6.342, 6.379, 6.416, 6.453, 6.490, 6.526, 6.562, 6.597, 6.632, & - & 6.667, 6.701, 6.735, 6.769, 6.803, 6.836, 6.869, 6.901, 6.934, & - & 6.966, 6.997, 7.029, 7.060, 7.091, 7.122, 7.152, 7.182, 7.212, & - & 7.242, 7.271, 7.300, 7.329, 7.358, 7.386, 7.415, 7.443, 7.470, & - & 7.498, 7.525, 7.552, 7.579, 7.606, 7.633, 7.659, 7.685, 7.711, & - & 7.737, 7.762, 7.788, 7.813, 7.838, 7.862, 7.887, 7.912, 7.936, & - & 7.960, 7.984, 8.008, 8.031, 8.055, 8.078, 8.101, 8.124, 8.147, & - & 8.169, 8.192, 8.214, 8.236, 8.258, 8.280, 8.302, 8.323, 8.345, & - & 8.366, 8.387, 8.408, 8.429, 8.450, 8.470, 8.491, 8.511, 8.531, & - & 8.552, 8.572, 8.591, 8.611, 8.631, 8.650, 8.670, 8.689, 8.708, & - & 8.727, 8.746, 8.765, 8.783, 8.802, 8.820, 8.839, 8.857, 8.875, & - & 8.893, 8.911, 8.929, 8.946, 8.964, 8.981, 8.999, 9.016, 9.033, & - & 9.050, 9.067, 9.084 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.049,-0.104,-0.131,-0.149,-0.163,-0.174,-0.184,-0.192,-0.199, & - -0.205,-0.211,-0.216,-0.220,-0.224,-0.228,-0.231,-0.234,-0.236, & - -0.238,-0.240,-0.242,-0.244,-0.245,-0.247,-0.248,-0.248,-0.249, & - -0.250,-0.250,-0.250,-0.251,-0.251,-0.250,-0.250,-0.250,-0.249, & - -0.249,-0.248,-0.247,-0.247,-0.246,-0.245,-0.243,-0.242,-0.241, & - -0.240,-0.238,-0.237,-0.235,-0.233,-0.232,-0.230,-0.228,-0.226, & - -0.224,-0.222,-0.220,-0.218,-0.216,-0.214,-0.211,-0.209,-0.207, & - -0.204,-0.202,-0.199,-0.197,-0.194,-0.192,-0.189,-0.187,-0.184, & - -0.181,-0.178,-0.176,-0.173,-0.170,-0.167,-0.164,-0.161,-0.158, & - -0.155,-0.152,-0.149,-0.146,-0.142,-0.139,-0.136,-0.133,-0.129, & - -0.126,-0.123,-0.119,-0.116,-0.112,-0.109,-0.105,-0.102,-0.098, & - -0.095,-0.091,-0.088,-0.084,-0.080,-0.077,-0.073,-0.069,-0.066, & - -0.062,-0.058,-0.055,-0.051,-0.047,-0.043,-0.039,-0.036,-0.032, & - -0.028,-0.024,-0.020,-0.017,-0.013,-0.009,-0.005,-0.001, 0.002, & - & 0.006, 0.010, 0.014, 0.018, 0.021, 0.025, 0.029, 0.033, 0.037, & - & 0.040, 0.044, 0.048, 0.052, 0.055, 0.059, 0.063, 0.067, 0.070, & - & 0.074, 0.078, 0.081, 0.085, 0.089, 0.093, 0.096, 0.100, 0.104, & - & 0.107, 0.111, 0.114, 0.118, 0.122, 0.125, 0.129, 0.133, 0.136, & - & 0.140, 0.143, 0.147, 0.150, 0.154, 0.157, 0.161, 0.165, 0.168, & - & 0.172, 0.175, 0.178, 0.182, 0.185, 0.189, 0.192, 0.196, 0.199, & - & 0.203, 0.206, 0.209, 0.213, 0.216, 0.220, 0.223, 0.226, 0.230, & - & 0.233, 0.236, 0.240, 0.243, 0.246, 0.250, 0.253, 0.256, 0.259, & - & 0.263, 0.266, 0.269, 0.272, 0.276, 0.279, 0.282, 0.285, 0.289, & - & 0.292, 0.295, 0.298, 0.301, 0.304, 0.308, 0.311, 0.314, 0.317, & - & 0.320, 0.323, 0.326, 0.329, 0.332, 0.336, 0.339, 0.342, 0.345, & - & 0.348, 0.351, 0.354, 0.357, 0.360, 0.363, 0.366, 0.369, 0.372, & - & 0.375, 0.378, 0.381, 0.384, 0.387, 0.390, 0.393, 0.395, 0.398, & - & 0.401, 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.421, 0.424, & - & 0.427, 0.430, 0.433, 0.436, 0.438, 0.441, 0.444, 0.447, 0.450, & - & 0.452, 0.455, 0.458, 0.461, 0.464, 0.466, 0.469, 0.472, 0.475, & - & 0.477, 0.480, 0.483, 0.485, 0.488, 0.491, 0.493, 0.496, 0.499, & - & 0.501, 0.504, 0.507, 0.509, 0.512, 0.515, 0.517, 0.520, 0.523, & - & 0.525, 0.528, 0.530, 0.533, 0.536, 0.538, 0.541, 0.543, 0.546, & - & 0.548, 0.551, 0.554, 0.556, 0.559, 0.561, 0.564, 0.566, 0.569, & - & 0.571, 0.574, 0.576, 0.579, 0.581, 0.584, 0.586, 0.589, 0.591, & - & 0.594, 0.596, 0.598, 0.601, 0.603, 0.606, 0.608, 0.611, 0.613, & - & 0.615, 0.618, 0.620, 0.623, 0.625, 0.627, 0.630, 0.632, 0.635, & - & 0.637, 0.639, 0.642, 0.644, 0.646, 0.649, 0.651, 0.653, 0.656, & - & 0.658, 0.660, 0.663, 0.665, 0.667, 0.670, 0.672, 0.674, 0.676, & - & 0.679, 0.681, 0.683, 0.685, 0.688, 0.690, 0.692, 0.694, 0.697, & - & 0.699, 0.701, 0.703, 0.706, 0.708, 0.710, 0.712, 0.714, 0.717, & - & 0.719, 0.721, 0.723, 0.725, 0.728, 0.730, 0.732, 0.734, 0.736, & - & 0.738, 0.741, 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.756, & - & 0.758, 0.760, 0.762, 0.764, 0.766, 0.768, 0.770, 0.772, 0.774, & - & 0.777, 0.779, 0.781, 0.783, 0.805, 0.825, 0.845, 0.864, 0.883, & - & 0.901, 0.920, 0.938, 0.955, 0.973, 0.990, 1.006, 1.023, 1.039, & - & 1.055, 1.071, 1.086, 1.101, 1.116, 1.131, 1.145, 1.160, 1.174, & - & 1.188, 1.201, 1.215, 1.228, 1.241, 1.254, 1.266, 1.279, 1.291, & - & 1.303, 1.315, 1.327, 1.339, 1.350, 1.361, 1.372, 1.383, 1.394, & - & 1.405, 1.416, 1.426, 1.436, 1.446, 1.456, 1.466, 1.476, 1.486, & - & 1.495, 1.505, 1.514, 1.523, 1.532, 1.541, 1.550, 1.559, 1.567, & - & 1.576, 1.584, 1.592, 1.601, 1.609, 1.617, 1.625, 1.632, 1.640, & - & 1.648, 1.655, 1.663, 1.670, 1.677, 1.684, 1.692, 1.699, 1.706, & - & 1.712, 1.719, 1.726, 1.732, 1.739, 1.746, 1.752, 1.758, 1.765, & - & 1.771, 1.777, 1.783, 1.789, 1.795, 1.801, 1.806, 1.812, 1.818, & - & 1.823, 1.829, 1.834, 1.840, 1.845, 1.850, 1.856, 1.861, 1.866, & - & 1.871, 1.876, 1.881, 1.886, 1.891, 1.896, 1.900, 1.905, 1.910, & - & 1.914, 1.919, 1.923, 1.928, 1.932, 1.937, 1.941, 1.945, 1.949, & - & 1.953, 1.958, 1.962, 1.966, 1.970, 1.974, 1.978, 1.981, 1.985, & - & 1.989, 1.993, 1.996, 2.000, 2.004, 2.007, 2.011, 2.014, 2.018, & - & 2.021, 2.025, 2.028, 2.031, 2.035, 2.038, 2.041, 2.044, 2.047, & - & 2.050, 2.053, 2.056, 2.059, 2.062, 2.065, 2.068, 2.071, 2.074, & - & 2.077, 2.080, 2.082 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.048,-0.100,-0.123,-0.137,-0.147,-0.155,-0.161,-0.165,-0.169, & - -0.172,-0.174,-0.175,-0.177,-0.177,-0.178,-0.178,-0.178,-0.177, & - -0.177,-0.176,-0.175,-0.174,-0.173,-0.172,-0.171,-0.169,-0.168, & - -0.166,-0.165,-0.163,-0.161,-0.159,-0.157,-0.156,-0.154,-0.152, & - -0.150,-0.148,-0.146,-0.144,-0.141,-0.139,-0.137,-0.135,-0.133, & - -0.131,-0.129,-0.127,-0.124,-0.122,-0.120,-0.118,-0.116,-0.113, & - -0.111,-0.109,-0.107,-0.105,-0.102,-0.100,-0.098,-0.096,-0.094, & - -0.091,-0.089,-0.087,-0.085,-0.082,-0.080,-0.078,-0.076,-0.073, & - -0.071,-0.069,-0.067,-0.064,-0.062,-0.060,-0.057,-0.055,-0.052, & - -0.050,-0.048,-0.045,-0.043,-0.040,-0.038,-0.035,-0.033,-0.030, & - -0.027,-0.025,-0.022,-0.020,-0.017,-0.014,-0.012,-0.009,-0.006, & - -0.004,-0.001, 0.002, 0.005, 0.007, 0.010, 0.013, 0.016, 0.019, & - & 0.021, 0.024, 0.027, 0.030, 0.033, 0.036, 0.039, 0.041, 0.044, & - & 0.047, 0.050, 0.053, 0.056, 0.059, 0.062, 0.065, 0.068, 0.071, & - & 0.073, 0.076, 0.079, 0.082, 0.085, 0.088, 0.091, 0.094, 0.097, & - & 0.100, 0.103, 0.105, 0.108, 0.111, 0.114, 0.117, 0.120, 0.123, & - & 0.126, 0.129, 0.131, 0.134, 0.137, 0.140, 0.143, 0.146, 0.149, & - & 0.152, 0.154, 0.157, 0.160, 0.163, 0.166, 0.169, 0.171, 0.174, & - & 0.177, 0.180, 0.183, 0.186, 0.188, 0.191, 0.194, 0.197, 0.200, & - & 0.202, 0.205, 0.208, 0.211, 0.213, 0.216, 0.219, 0.222, 0.224, & - & 0.227, 0.230, 0.233, 0.235, 0.238, 0.241, 0.244, 0.246, 0.249, & - & 0.252, 0.254, 0.257, 0.260, 0.263, 0.265, 0.268, 0.271, 0.273, & - & 0.276, 0.279, 0.281, 0.284, 0.287, 0.289, 0.292, 0.294, 0.297, & - & 0.300, 0.302, 0.305, 0.308, 0.310, 0.313, 0.315, 0.318, 0.321, & - & 0.323, 0.326, 0.328, 0.331, 0.333, 0.336, 0.339, 0.341, 0.344, & - & 0.346, 0.349, 0.351, 0.354, 0.356, 0.359, 0.361, 0.364, 0.366, & - & 0.369, 0.372, 0.374, 0.376, 0.379, 0.381, 0.384, 0.386, 0.389, & - & 0.391, 0.394, 0.396, 0.399, 0.401, 0.404, 0.406, 0.409, 0.411, & - & 0.413, 0.416, 0.418, 0.421, 0.423, 0.425, 0.428, 0.430, 0.433, & - & 0.435, 0.437, 0.440, 0.442, 0.445, 0.447, 0.449, 0.452, 0.454, & - & 0.456, 0.459, 0.461, 0.463, 0.466, 0.468, 0.470, 0.473, 0.475, & - & 0.477, 0.480, 0.482, 0.484, 0.486, 0.489, 0.491, 0.493, 0.496, & - & 0.498, 0.500, 0.502, 0.505, 0.507, 0.509, 0.511, 0.514, 0.516, & - & 0.518, 0.520, 0.523, 0.525, 0.527, 0.529, 0.531, 0.534, 0.536, & - & 0.538, 0.540, 0.542, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, & - & 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.573, 0.575, & - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.590, 0.592, 0.594, & - & 0.596, 0.598, 0.600, 0.602, 0.604, 0.606, 0.608, 0.610, 0.612, & - & 0.614, 0.617, 0.619, 0.621, 0.623, 0.625, 0.627, 0.629, 0.631, & - & 0.633, 0.635, 0.637, 0.639, 0.641, 0.643, 0.645, 0.647, 0.649, & - & 0.651, 0.653, 0.655, 0.657, 0.659, 0.661, 0.663, 0.665, 0.667, & - & 0.669, 0.671, 0.673, 0.674, 0.676, 0.678, 0.680, 0.682, 0.684, & - & 0.686, 0.688, 0.690, 0.692, 0.694, 0.696, 0.698, 0.700, 0.701, & - & 0.703, 0.705, 0.707, 0.709, 0.711, 0.713, 0.715, 0.716, 0.718, & - & 0.720, 0.722, 0.724, 0.726, 0.746, 0.764, 0.781, 0.799, 0.816, & - & 0.833, 0.849, 0.866, 0.882, 0.897, 0.913, 0.928, 0.943, 0.958, & - & 0.972, 0.987, 1.001, 1.015, 1.028, 1.042, 1.055, 1.068, 1.081, & - & 1.093, 1.106, 1.118, 1.130, 1.142, 1.154, 1.165, 1.177, 1.188, & - & 1.199, 1.210, 1.221, 1.231, 1.242, 1.252, 1.262, 1.272, 1.282, & - & 1.292, 1.301, 1.311, 1.320, 1.329, 1.338, 1.347, 1.356, 1.365, & - & 1.374, 1.382, 1.391, 1.399, 1.407, 1.415, 1.423, 1.431, 1.439, & - & 1.446, 1.454, 1.462, 1.469, 1.476, 1.483, 1.491, 1.498, 1.505, & - & 1.511, 1.518, 1.525, 1.531, 1.538, 1.544, 1.551, 1.557, 1.563, & - & 1.569, 1.576, 1.582, 1.587, 1.593, 1.599, 1.605, 1.610, 1.616, & - & 1.622, 1.627, 1.632, 1.638, 1.643, 1.648, 1.653, 1.658, 1.663, & - & 1.668, 1.673, 1.678, 1.683, 1.688, 1.692, 1.697, 1.701, 1.706, & - & 1.710, 1.715, 1.719, 1.723, 1.728, 1.732, 1.736, 1.740, 1.744, & - & 1.748, 1.752, 1.756, 1.760, 1.764, 1.768, 1.771, 1.775, 1.779, & - & 1.782, 1.786, 1.789, 1.793, 1.796, 1.800, 1.803, 1.806, 1.810, & - & 1.813, 1.816, 1.819, 1.822, 1.825, 1.828, 1.831, 1.834, 1.837, & - & 1.840, 1.843, 1.846, 1.849, 1.852, 1.854, 1.857, 1.860, 1.862, & - & 1.865, 1.867, 1.870, 1.872, 1.875, 1.877, 1.880, 1.882, 1.885, & - & 1.887, 1.889, 1.891 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.047,-0.093,-0.111,-0.121,-0.127,-0.131,-0.133,-0.134,-0.133, & - -0.132,-0.131,-0.128,-0.126,-0.123,-0.119,-0.115,-0.111,-0.107, & - -0.102,-0.098,-0.093,-0.088,-0.082,-0.077,-0.071,-0.065,-0.060, & - -0.054,-0.048,-0.041,-0.035,-0.029,-0.022,-0.016,-0.009,-0.003, & - & 0.004, 0.011, 0.018, 0.025, 0.032, 0.038, 0.045, 0.053, 0.060, & - & 0.067, 0.074, 0.081, 0.088, 0.095, 0.103, 0.110, 0.117, 0.124, & - & 0.132, 0.139, 0.146, 0.154, 0.161, 0.168, 0.176, 0.183, 0.191, & - & 0.198, 0.206, 0.213, 0.221, 0.228, 0.236, 0.243, 0.251, 0.258, & - & 0.266, 0.274, 0.281, 0.289, 0.297, 0.305, 0.312, 0.320, 0.328, & - & 0.336, 0.344, 0.352, 0.360, 0.368, 0.376, 0.384, 0.393, 0.401, & - & 0.409, 0.417, 0.426, 0.434, 0.443, 0.451, 0.460, 0.468, 0.477, & - & 0.485, 0.494, 0.503, 0.511, 0.520, 0.529, 0.538, 0.546, 0.555, & - & 0.564, 0.573, 0.582, 0.591, 0.600, 0.608, 0.617, 0.626, 0.635, & - & 0.644, 0.653, 0.662, 0.671, 0.680, 0.689, 0.698, 0.707, 0.716, & - & 0.725, 0.734, 0.743, 0.752, 0.761, 0.770, 0.779, 0.788, 0.796, & - & 0.805, 0.814, 0.823, 0.832, 0.841, 0.850, 0.859, 0.867, 0.876, & - & 0.885, 0.894, 0.903, 0.911, 0.920, 0.929, 0.937, 0.946, 0.955, & - & 0.964, 0.972, 0.981, 0.989, 0.998, 1.007, 1.015, 1.024, 1.032, & - & 1.041, 1.049, 1.058, 1.066, 1.075, 1.083, 1.092, 1.100, 1.109, & - & 1.117, 1.125, 1.134, 1.142, 1.150, 1.159, 1.167, 1.175, 1.183, & - & 1.192, 1.200, 1.208, 1.216, 1.224, 1.233, 1.241, 1.249, 1.257, & - & 1.265, 1.273, 1.281, 1.289, 1.297, 1.305, 1.313, 1.321, 1.329, & - & 1.337, 1.345, 1.353, 1.361, 1.369, 1.377, 1.384, 1.392, 1.400, & - & 1.408, 1.416, 1.423, 1.431, 1.439, 1.447, 1.454, 1.462, 1.470, & - & 1.477, 1.485, 1.493, 1.500, 1.508, 1.515, 1.523, 1.530, 1.538, & - & 1.545, 1.553, 1.560, 1.568, 1.575, 1.583, 1.590, 1.598, 1.605, & - & 1.612, 1.620, 1.627, 1.634, 1.642, 1.649, 1.656, 1.663, 1.671, & - & 1.678, 1.685, 1.692, 1.699, 1.707, 1.714, 1.721, 1.728, 1.735, & - & 1.742, 1.749, 1.756, 1.763, 1.770, 1.778, 1.785, 1.791, 1.798, & - & 1.805, 1.812, 1.819, 1.826, 1.833, 1.840, 1.847, 1.854, 1.861, & - & 1.867, 1.874, 1.881, 1.888, 1.895, 1.901, 1.908, 1.915, 1.922, & - & 1.928, 1.935, 1.942, 1.948, 1.955, 1.962, 1.968, 1.975, 1.981, & - & 1.988, 1.995, 2.001, 2.008, 2.014, 2.021, 2.027, 2.034, 2.040, & - & 2.047, 2.053, 2.060, 2.066, 2.072, 2.079, 2.085, 2.092, 2.098, & - & 2.104, 2.111, 2.117, 2.123, 2.130, 2.136, 2.142, 2.148, 2.155, & - & 2.161, 2.167, 2.173, 2.180, 2.186, 2.192, 2.198, 2.204, 2.210, & - & 2.216, 2.223, 2.229, 2.235, 2.241, 2.247, 2.253, 2.259, 2.265, & - & 2.271, 2.277, 2.283, 2.289, 2.295, 2.301, 2.307, 2.313, 2.319, & - & 2.325, 2.331, 2.337, 2.343, 2.348, 2.354, 2.360, 2.366, 2.372, & - & 2.378, 2.383, 2.389, 2.395, 2.401, 2.407, 2.412, 2.418, 2.424, & - & 2.430, 2.435, 2.441, 2.447, 2.452, 2.458, 2.464, 2.469, 2.475, & - & 2.481, 2.486, 2.492, 2.497, 2.503, 2.509, 2.514, 2.520, 2.525, & - & 2.531, 2.536, 2.542, 2.547, 2.553, 2.558, 2.564, 2.569, 2.575, & - & 2.580, 2.586, 2.591, 2.597, 2.602, 2.607, 2.613, 2.618, 2.624, & - & 2.629, 2.634, 2.640, 2.645, 2.702, 2.754, 2.805, 2.855, 2.904, & - & 2.953, 3.001, 3.048, 3.094, 3.139, 3.184, 3.228, 3.272, 3.315, & - & 3.357, 3.399, 3.440, 3.480, 3.520, 3.559, 3.598, 3.636, 3.674, & - & 3.711, 3.748, 3.784, 3.820, 3.855, 3.890, 3.925, 3.959, 3.992, & - & 4.026, 4.058, 4.091, 4.123, 4.155, 4.186, 4.217, 4.247, 4.278, & - & 4.308, 4.337, 4.366, 4.395, 4.424, 4.452, 4.480, 4.508, 4.535, & - & 4.562, 4.589, 4.616, 4.642, 4.668, 4.694, 4.719, 4.745, 4.770, & - & 4.794, 4.819, 4.843, 4.867, 4.891, 4.915, 4.938, 4.961, 4.984, & - & 5.007, 5.029, 5.052, 5.074, 5.096, 5.117, 5.139, 5.160, 5.181, & - & 5.202, 5.223, 5.244, 5.264, 5.285, 5.305, 5.324, 5.344, 5.364, & - & 5.383, 5.402, 5.422, 5.441, 5.459, 5.478, 5.496, 5.515, 5.533, & - & 5.551, 5.569, 5.587, 5.604, 5.622, 5.639, 5.656, 5.673, 5.690, & - & 5.707, 5.724, 5.740, 5.757, 5.773, 5.789, 5.806, 5.821, 5.837, & - & 5.853, 5.869, 5.884, 5.900, 5.915, 5.930, 5.945, 5.960, 5.975, & - & 5.990, 6.004, 6.019, 6.033, 6.048, 6.062, 6.076, 6.090, 6.104, & - & 6.118, 6.132, 6.145, 6.159, 6.172, 6.186, 6.199, 6.212, 6.225, & - & 6.238, 6.251, 6.264, 6.277, 6.290, 6.302, 6.315, 6.327, 6.340, & - & 6.352, 6.364, 6.377, 6.389, 6.401, 6.413, 6.424, 6.436, 6.448, & - & 6.459, 6.471, 6.482 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.048,-0.099,-0.122,-0.137,-0.148,-0.156,-0.163,-0.168,-0.172, & - -0.175,-0.178,-0.180,-0.182,-0.183,-0.184,-0.184,-0.184,-0.184, & - -0.184,-0.183,-0.182,-0.181,-0.180,-0.179,-0.177,-0.176,-0.174, & - -0.172,-0.170,-0.167,-0.165,-0.163,-0.160,-0.157,-0.155,-0.152, & - -0.149,-0.146,-0.143,-0.139,-0.136,-0.133,-0.129,-0.126,-0.122, & - -0.118,-0.115,-0.111,-0.107,-0.103,-0.099,-0.095,-0.091,-0.087, & - -0.083,-0.079,-0.075,-0.071,-0.066,-0.062,-0.058,-0.053,-0.049, & - -0.044,-0.040,-0.035,-0.031,-0.026,-0.022,-0.017,-0.012,-0.007, & - -0.003, 0.002, 0.007, 0.012, 0.017, 0.022, 0.027, 0.032, 0.037, & - & 0.042, 0.047, 0.052, 0.058, 0.063, 0.068, 0.073, 0.079, 0.084, & - & 0.090, 0.095, 0.101, 0.106, 0.112, 0.117, 0.123, 0.128, 0.134, & - & 0.140, 0.146, 0.151, 0.157, 0.163, 0.169, 0.175, 0.180, 0.186, & - & 0.192, 0.198, 0.204, 0.210, 0.216, 0.222, 0.228, 0.234, 0.240, & - & 0.246, 0.252, 0.258, 0.264, 0.270, 0.276, 0.282, 0.288, 0.294, & - & 0.300, 0.306, 0.312, 0.318, 0.323, 0.329, 0.335, 0.341, 0.347, & - & 0.353, 0.359, 0.365, 0.371, 0.377, 0.383, 0.389, 0.394, 0.400, & - & 0.406, 0.412, 0.418, 0.424, 0.429, 0.435, 0.441, 0.447, 0.453, & - & 0.458, 0.464, 0.470, 0.476, 0.481, 0.487, 0.493, 0.498, 0.504, & - & 0.510, 0.515, 0.521, 0.526, 0.532, 0.538, 0.543, 0.549, 0.554, & - & 0.560, 0.565, 0.571, 0.576, 0.582, 0.587, 0.593, 0.598, 0.604, & - & 0.609, 0.615, 0.620, 0.625, 0.631, 0.636, 0.641, 0.647, 0.652, & - & 0.657, 0.663, 0.668, 0.673, 0.679, 0.684, 0.689, 0.694, 0.700, & - & 0.705, 0.710, 0.715, 0.720, 0.726, 0.731, 0.736, 0.741, 0.746, & - & 0.751, 0.756, 0.761, 0.766, 0.772, 0.777, 0.782, 0.787, 0.792, & - & 0.797, 0.802, 0.807, 0.812, 0.817, 0.822, 0.826, 0.831, 0.836, & - & 0.841, 0.846, 0.851, 0.856, 0.861, 0.866, 0.870, 0.875, 0.880, & - & 0.885, 0.890, 0.894, 0.899, 0.904, 0.909, 0.914, 0.918, 0.923, & - & 0.928, 0.932, 0.937, 0.942, 0.946, 0.951, 0.956, 0.960, 0.965, & - & 0.970, 0.974, 0.979, 0.984, 0.988, 0.993, 0.997, 1.002, 1.006, & - & 1.011, 1.015, 1.020, 1.024, 1.029, 1.033, 1.038, 1.042, 1.047, & - & 1.051, 1.056, 1.060, 1.065, 1.069, 1.073, 1.078, 1.082, 1.087, & - & 1.091, 1.095, 1.100, 1.104, 1.108, 1.113, 1.117, 1.121, 1.126, & - & 1.130, 1.134, 1.138, 1.143, 1.147, 1.151, 1.155, 1.160, 1.164, & - & 1.168, 1.172, 1.177, 1.181, 1.185, 1.189, 1.193, 1.197, 1.202, & - & 1.206, 1.210, 1.214, 1.218, 1.222, 1.226, 1.230, 1.234, 1.238, & - & 1.243, 1.247, 1.251, 1.255, 1.259, 1.263, 1.267, 1.271, 1.275, & - & 1.279, 1.283, 1.287, 1.291, 1.295, 1.299, 1.303, 1.306, 1.310, & - & 1.314, 1.318, 1.322, 1.326, 1.330, 1.334, 1.338, 1.342, 1.345, & - & 1.349, 1.353, 1.357, 1.361, 1.365, 1.368, 1.372, 1.376, 1.380, & - & 1.384, 1.387, 1.391, 1.395, 1.399, 1.403, 1.406, 1.410, 1.414, & - & 1.418, 1.421, 1.425, 1.429, 1.432, 1.436, 1.440, 1.443, 1.447, & - & 1.451, 1.454, 1.458, 1.462, 1.465, 1.469, 1.473, 1.476, 1.480, & - & 1.484, 1.487, 1.491, 1.494, 1.498, 1.501, 1.505, 1.509, 1.512, & - & 1.516, 1.519, 1.523, 1.526, 1.530, 1.533, 1.537, 1.540, 1.544, & - & 1.547, 1.551, 1.554, 1.558, 1.595, 1.629, 1.662, 1.695, 1.727, & - & 1.759, 1.790, 1.820, 1.850, 1.880, 1.909, 1.938, 1.966, 1.994, & - & 2.022, 2.049, 2.076, 2.102, 2.128, 2.153, 2.179, 2.203, 2.228, & - & 2.252, 2.276, 2.300, 2.323, 2.346, 2.368, 2.391, 2.413, 2.435, & - & 2.456, 2.477, 2.498, 2.519, 2.539, 2.560, 2.580, 2.599, 2.619, & - & 2.638, 2.657, 2.676, 2.695, 2.713, 2.731, 2.749, 2.767, 2.785, & - & 2.802, 2.819, 2.836, 2.853, 2.870, 2.886, 2.902, 2.918, 2.934, & - & 2.950, 2.966, 2.981, 2.997, 3.012, 3.027, 3.042, 3.056, 3.071, & - & 3.085, 3.099, 3.114, 3.128, 3.141, 3.155, 3.169, 3.182, 3.195, & - & 3.209, 3.222, 3.235, 3.247, 3.260, 3.273, 3.285, 3.298, 3.310, & - & 3.322, 3.334, 3.346, 3.358, 3.369, 3.381, 3.392, 3.404, 3.415, & - & 3.426, 3.437, 3.448, 3.459, 3.470, 3.481, 3.491, 3.502, 3.512, & - & 3.523, 3.533, 3.543, 3.553, 3.563, 3.573, 3.583, 3.593, 3.603, & - & 3.612, 3.622, 3.631, 3.640, 3.650, 3.659, 3.668, 3.677, 3.686, & - & 3.695, 3.704, 3.713, 3.721, 3.730, 3.739, 3.747, 3.756, 3.764, & - & 3.772, 3.781, 3.789, 3.797, 3.805, 3.813, 3.821, 3.829, 3.836, & - & 3.844, 3.852, 3.860, 3.867, 3.875, 3.882, 3.889, 3.897, 3.904, & - & 3.911, 3.919, 3.926, 3.933, 3.940, 3.947, 3.954, 3.961, 3.967, & - & 3.974, 3.981, 3.988 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.080,-0.174,-0.221,-0.254,-0.280,-0.302,-0.321,-0.337,-0.352, & - -0.365,-0.377,-0.388,-0.398,-0.408,-0.417,-0.425,-0.433,-0.440, & - -0.447,-0.454,-0.461,-0.467,-0.472,-0.478,-0.483,-0.488,-0.493, & - -0.498,-0.503,-0.507,-0.511,-0.515,-0.519,-0.523,-0.527,-0.530, & - -0.533,-0.537,-0.540,-0.543,-0.546,-0.549,-0.551,-0.554,-0.557, & - -0.559,-0.562,-0.564,-0.566,-0.569,-0.571,-0.573,-0.575,-0.577, & - -0.579,-0.580,-0.582,-0.584,-0.586,-0.587,-0.589,-0.590,-0.592, & - -0.593,-0.595,-0.596,-0.597,-0.599,-0.600,-0.601,-0.602,-0.603, & - -0.604,-0.605,-0.607,-0.608,-0.609,-0.609,-0.610,-0.611,-0.612, & - -0.613,-0.614,-0.614,-0.615,-0.616,-0.617,-0.617,-0.618,-0.619, & - -0.619,-0.620,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623,-0.623, & - -0.624,-0.624,-0.624,-0.625,-0.625,-0.626,-0.626,-0.626,-0.626, & - -0.627,-0.627,-0.627,-0.628,-0.628,-0.628,-0.628,-0.628,-0.629, & - -0.629,-0.629,-0.629,-0.629,-0.629,-0.630,-0.630,-0.630,-0.630, & - -0.630,-0.630,-0.630,-0.630,-0.630,-0.631,-0.631,-0.631,-0.631, & - -0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631, & - -0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.631,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632, & - -0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.632,-0.633,-0.633, & - -0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633, & - -0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633,-0.633, & - -0.633,-0.633,-0.633,-0.633,-0.634,-0.634,-0.634,-0.634,-0.634, & - -0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634,-0.634, & - -0.634,-0.634,-0.634,-0.634,-0.635,-0.635,-0.635,-0.635,-0.635, & - -0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635,-0.635, & - -0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636,-0.636, & - -0.636,-0.636,-0.636,-0.637,-0.637,-0.637,-0.637,-0.637,-0.637, & - -0.637,-0.637,-0.637,-0.637,-0.637,-0.638,-0.638,-0.638,-0.638, & - -0.638,-0.638,-0.638,-0.638,-0.638,-0.638,-0.639,-0.639,-0.639, & - -0.639,-0.639,-0.639,-0.639,-0.639,-0.639,-0.639,-0.640,-0.640, & - -0.640,-0.640,-0.640,-0.640,-0.640,-0.640,-0.640,-0.641,-0.641, & - -0.641,-0.641,-0.641,-0.641,-0.641,-0.641,-0.642,-0.642,-0.642, & - -0.642,-0.642,-0.642,-0.642,-0.642,-0.643,-0.643,-0.643,-0.643, & - -0.643,-0.643,-0.643,-0.643,-0.644,-0.644,-0.644,-0.644,-0.644, & - -0.644,-0.644,-0.645,-0.645,-0.645,-0.645,-0.645,-0.645,-0.645, & - -0.646,-0.646,-0.646,-0.646,-0.648,-0.649,-0.651,-0.652,-0.654, & - -0.656,-0.658,-0.660,-0.662,-0.664,-0.666,-0.668,-0.670,-0.673, & - -0.675,-0.677,-0.680,-0.682,-0.685,-0.687,-0.690,-0.693,-0.695, & - -0.698,-0.701,-0.704,-0.707,-0.709,-0.712,-0.715,-0.718,-0.722, & - -0.725,-0.728,-0.731,-0.734,-0.737,-0.741,-0.744,-0.747,-0.751, & - -0.754,-0.758,-0.761,-0.764,-0.768,-0.772,-0.775,-0.779,-0.782, & - -0.786,-0.790,-0.793,-0.797,-0.801,-0.805,-0.809,-0.812,-0.816, & - -0.820,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848,-0.852, & - -0.856,-0.860,-0.864,-0.868,-0.873,-0.877,-0.881,-0.885,-0.889, & - -0.894,-0.898,-0.902,-0.906,-0.911,-0.915,-0.919,-0.924,-0.928, & - -0.932,-0.937,-0.941,-0.946,-0.950,-0.955,-0.959,-0.964,-0.968, & - -0.973,-0.977,-0.982,-0.986,-0.991,-0.995,-1.000,-1.005,-1.009, & - -1.014,-1.019,-1.023,-1.028,-1.033,-1.037,-1.042,-1.047,-1.051, & - -1.056,-1.061,-1.066,-1.071,-1.075,-1.080,-1.085,-1.090,-1.095, & - -1.099,-1.104,-1.109,-1.114,-1.119,-1.124,-1.129,-1.134,-1.138, & - -1.143,-1.148,-1.153,-1.158,-1.163,-1.168,-1.173,-1.178,-1.183, & - -1.188,-1.193,-1.198,-1.203,-1.208,-1.213,-1.218,-1.223,-1.228, & - -1.233,-1.238,-1.244,-1.249,-1.254,-1.259,-1.264,-1.269,-1.274, & - -1.279,-1.284,-1.290 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.099,-0.211,-0.264,-0.301,-0.329,-0.351,-0.370,-0.386,-0.399, & - -0.411,-0.422,-0.432,-0.440,-0.448,-0.455,-0.462,-0.468,-0.473, & - -0.478,-0.483,-0.487,-0.491,-0.495,-0.499,-0.502,-0.505,-0.508, & - -0.511,-0.513,-0.516,-0.518,-0.520,-0.522,-0.524,-0.526,-0.528, & - -0.529,-0.531,-0.532,-0.534,-0.535,-0.536,-0.537,-0.539,-0.540, & - -0.541,-0.542,-0.543,-0.544,-0.545,-0.545,-0.546,-0.547,-0.548, & - -0.549,-0.549,-0.550,-0.551,-0.551,-0.552,-0.552,-0.553,-0.553, & - -0.554,-0.554,-0.555,-0.555,-0.556,-0.556,-0.556,-0.557,-0.557, & - -0.557,-0.558,-0.558,-0.558,-0.558,-0.559,-0.559,-0.559,-0.559, & - -0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559,-0.559, & - -0.559,-0.559,-0.559,-0.559,-0.558,-0.558,-0.558,-0.558,-0.557, & - -0.557,-0.557,-0.556,-0.556,-0.556,-0.555,-0.555,-0.555,-0.554, & - -0.554,-0.553,-0.553,-0.552,-0.552,-0.551,-0.551,-0.550,-0.550, & - -0.549,-0.549,-0.548,-0.548,-0.547,-0.547,-0.546,-0.545,-0.545, & - -0.544,-0.544,-0.543,-0.542,-0.542,-0.541,-0.541,-0.540,-0.539, & - -0.539,-0.538,-0.538,-0.537,-0.536,-0.536,-0.535,-0.534,-0.534, & - -0.533,-0.533,-0.532,-0.531,-0.531,-0.530,-0.529,-0.529,-0.528, & - -0.527,-0.527,-0.526,-0.525,-0.525,-0.524,-0.524,-0.523,-0.522, & - -0.522,-0.521,-0.520,-0.520,-0.519,-0.518,-0.518,-0.517,-0.516, & - -0.516,-0.515,-0.514,-0.514,-0.513,-0.513,-0.512,-0.511,-0.511, & - -0.510,-0.509,-0.509,-0.508,-0.507,-0.507,-0.506,-0.505,-0.505, & - -0.504,-0.504,-0.503,-0.502,-0.502,-0.501,-0.500,-0.500,-0.499, & - -0.499,-0.498,-0.497,-0.497,-0.496,-0.495,-0.495,-0.494,-0.494, & - -0.493,-0.492,-0.492,-0.491,-0.490,-0.490,-0.489,-0.489,-0.488, & - -0.487,-0.487,-0.486,-0.486,-0.485,-0.484,-0.484,-0.483,-0.483, & - -0.482,-0.481,-0.481,-0.480,-0.480,-0.479,-0.478,-0.478,-0.477, & - -0.477,-0.476,-0.475,-0.475,-0.474,-0.474,-0.473,-0.473,-0.472, & - -0.471,-0.471,-0.470,-0.470,-0.469,-0.469,-0.468,-0.468,-0.467, & - -0.466,-0.466,-0.465,-0.465,-0.464,-0.464,-0.463,-0.463,-0.462, & - -0.461,-0.461,-0.460,-0.460,-0.459,-0.459,-0.458,-0.458,-0.457, & - -0.457,-0.456,-0.456,-0.455,-0.455,-0.454,-0.453,-0.453,-0.452, & - -0.452,-0.451,-0.451,-0.450,-0.450,-0.449,-0.449,-0.448,-0.448, & - -0.447,-0.447,-0.446,-0.446,-0.445,-0.445,-0.444,-0.444,-0.443, & - -0.443,-0.442,-0.442,-0.441,-0.441,-0.440,-0.440,-0.440,-0.439, & - -0.439,-0.438,-0.438,-0.437,-0.437,-0.436,-0.436,-0.435,-0.435, & - -0.434,-0.434,-0.433,-0.433,-0.433,-0.432,-0.432,-0.431,-0.431, & - -0.430,-0.430,-0.429,-0.429,-0.429,-0.428,-0.428,-0.427,-0.427, & - -0.426,-0.426,-0.426,-0.425,-0.425,-0.424,-0.424,-0.423,-0.423, & - -0.423,-0.422,-0.422,-0.421,-0.421,-0.421,-0.420,-0.420,-0.419, & - -0.419,-0.419,-0.418,-0.418,-0.417,-0.417,-0.417,-0.416,-0.416, & - -0.415,-0.415,-0.415,-0.414,-0.414,-0.413,-0.413,-0.413,-0.412, & - -0.412,-0.412,-0.411,-0.411,-0.410,-0.410,-0.410,-0.409,-0.409, & - -0.409,-0.408,-0.408,-0.408,-0.407,-0.407,-0.407,-0.406,-0.406, & - -0.405,-0.405,-0.405,-0.404,-0.404,-0.404,-0.403,-0.403,-0.403, & - -0.402,-0.402,-0.402,-0.401,-0.398,-0.395,-0.392,-0.389,-0.386, & - -0.384,-0.381,-0.379,-0.377,-0.375,-0.373,-0.371,-0.369,-0.368, & - -0.366,-0.365,-0.364,-0.363,-0.362,-0.361,-0.360,-0.359,-0.358, & - -0.358,-0.357,-0.357,-0.357,-0.356,-0.356,-0.356,-0.356,-0.356, & - -0.356,-0.357,-0.357,-0.357,-0.358,-0.358,-0.359,-0.360,-0.361, & - -0.361,-0.362,-0.363,-0.364,-0.365,-0.367,-0.368,-0.369,-0.370, & - -0.372,-0.373,-0.375,-0.376,-0.378,-0.380,-0.381,-0.383,-0.385, & - -0.387,-0.389,-0.391,-0.393,-0.395,-0.397,-0.399,-0.401,-0.404, & - -0.406,-0.408,-0.411,-0.413,-0.416,-0.418,-0.421,-0.423,-0.426, & - -0.429,-0.431,-0.434,-0.437,-0.440,-0.442,-0.445,-0.448,-0.451, & - -0.454,-0.457,-0.460,-0.463,-0.467,-0.470,-0.473,-0.476,-0.480, & - -0.483,-0.486,-0.490,-0.493,-0.496,-0.500,-0.503,-0.507,-0.510, & - -0.514,-0.517,-0.521,-0.525,-0.528,-0.532,-0.536,-0.540,-0.543, & - -0.547,-0.551,-0.555,-0.559,-0.563,-0.566,-0.570,-0.574,-0.578, & - -0.582,-0.586,-0.590,-0.595,-0.599,-0.603,-0.607,-0.611,-0.615, & - -0.619,-0.624,-0.628,-0.632,-0.637,-0.641,-0.645,-0.650,-0.654, & - -0.658,-0.663,-0.667,-0.672,-0.676,-0.680,-0.685,-0.689,-0.694, & - -0.699,-0.703,-0.708,-0.712,-0.717,-0.722,-0.726,-0.731,-0.736, & - -0.740,-0.745,-0.750 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.097,-0.201,-0.247,-0.277,-0.298,-0.314,-0.327,-0.337,-0.345, & - -0.351,-0.356,-0.359,-0.362,-0.365,-0.366,-0.367,-0.367,-0.367, & - -0.367,-0.366,-0.365,-0.364,-0.362,-0.361,-0.359,-0.356,-0.354, & - -0.352,-0.349,-0.346,-0.343,-0.340,-0.337,-0.334,-0.331,-0.328, & - -0.324,-0.321,-0.317,-0.314,-0.310,-0.307,-0.303,-0.300,-0.296, & - -0.292,-0.289,-0.285,-0.281,-0.277,-0.274,-0.270,-0.266,-0.262, & - -0.259,-0.255,-0.251,-0.247,-0.244,-0.240,-0.236,-0.232,-0.228, & - -0.224,-0.221,-0.217,-0.213,-0.209,-0.205,-0.201,-0.197,-0.193, & - -0.189,-0.185,-0.181,-0.177,-0.173,-0.169,-0.165,-0.161,-0.157, & - -0.152,-0.148,-0.144,-0.139,-0.135,-0.131,-0.126,-0.122,-0.117, & - -0.113,-0.108,-0.104,-0.099,-0.095,-0.090,-0.085,-0.080,-0.076, & - -0.071,-0.066,-0.061,-0.056,-0.051,-0.047,-0.042,-0.037,-0.032, & - -0.027,-0.022,-0.017,-0.012,-0.006,-0.001, 0.004, 0.009, 0.014, & - & 0.019, 0.024, 0.029, 0.034, 0.040, 0.045, 0.050, 0.055, 0.060, & - & 0.065, 0.071, 0.076, 0.081, 0.086, 0.091, 0.096, 0.102, 0.107, & - & 0.112, 0.117, 0.122, 0.127, 0.133, 0.138, 0.143, 0.148, 0.153, & - & 0.158, 0.163, 0.168, 0.174, 0.179, 0.184, 0.189, 0.194, 0.199, & - & 0.204, 0.209, 0.214, 0.219, 0.224, 0.229, 0.234, 0.239, 0.244, & - & 0.249, 0.254, 0.259, 0.264, 0.269, 0.274, 0.279, 0.284, 0.289, & - & 0.294, 0.299, 0.304, 0.309, 0.314, 0.319, 0.324, 0.329, 0.334, & - & 0.338, 0.343, 0.348, 0.353, 0.358, 0.363, 0.368, 0.372, 0.377, & - & 0.382, 0.387, 0.392, 0.396, 0.401, 0.406, 0.411, 0.415, 0.420, & - & 0.425, 0.430, 0.434, 0.439, 0.444, 0.449, 0.453, 0.458, 0.463, & - & 0.467, 0.472, 0.477, 0.481, 0.486, 0.491, 0.495, 0.500, 0.504, & - & 0.509, 0.514, 0.518, 0.523, 0.527, 0.532, 0.536, 0.541, 0.545, & - & 0.550, 0.555, 0.559, 0.564, 0.568, 0.573, 0.577, 0.581, 0.586, & - & 0.590, 0.595, 0.599, 0.604, 0.608, 0.613, 0.617, 0.621, 0.626, & - & 0.630, 0.635, 0.639, 0.643, 0.648, 0.652, 0.656, 0.661, 0.665, & - & 0.669, 0.674, 0.678, 0.682, 0.686, 0.691, 0.695, 0.699, 0.703, & - & 0.708, 0.712, 0.716, 0.720, 0.725, 0.729, 0.733, 0.737, 0.741, & - & 0.746, 0.750, 0.754, 0.758, 0.762, 0.766, 0.770, 0.775, 0.779, & - & 0.783, 0.787, 0.791, 0.795, 0.799, 0.803, 0.807, 0.811, 0.815, & - & 0.819, 0.823, 0.827, 0.831, 0.835, 0.839, 0.843, 0.847, 0.851, & - & 0.855, 0.859, 0.863, 0.867, 0.871, 0.875, 0.879, 0.883, 0.887, & - & 0.891, 0.895, 0.899, 0.902, 0.906, 0.910, 0.914, 0.918, 0.922, & - & 0.926, 0.929, 0.933, 0.937, 0.941, 0.945, 0.949, 0.952, 0.956, & - & 0.960, 0.964, 0.967, 0.971, 0.975, 0.979, 0.982, 0.986, 0.990, & - & 0.994, 0.997, 1.001, 1.005, 1.008, 1.012, 1.016, 1.019, 1.023, & - & 1.027, 1.030, 1.034, 1.038, 1.041, 1.045, 1.049, 1.052, 1.056, & - & 1.059, 1.063, 1.067, 1.070, 1.074, 1.077, 1.081, 1.084, 1.088, & - & 1.091, 1.095, 1.098, 1.102, 1.106, 1.109, 1.113, 1.116, 1.119, & - & 1.123, 1.126, 1.130, 1.133, 1.137, 1.140, 1.144, 1.147, 1.151, & - & 1.154, 1.157, 1.161, 1.164, 1.168, 1.171, 1.174, 1.178, 1.181, & - & 1.185, 1.188, 1.191, 1.195, 1.198, 1.201, 1.205, 1.208, 1.211, & - & 1.215, 1.218, 1.221, 1.225, 1.260, 1.292, 1.323, 1.354, 1.385, & - & 1.415, 1.444, 1.473, 1.501, 1.529, 1.557, 1.584, 1.610, 1.636, & - & 1.662, 1.687, 1.712, 1.737, 1.761, 1.784, 1.808, 1.831, 1.853, & - & 1.876, 1.898, 1.919, 1.940, 1.961, 1.982, 2.002, 2.022, 2.042, & - & 2.062, 2.081, 2.100, 2.118, 2.137, 2.155, 2.172, 2.190, 2.207, & - & 2.224, 2.241, 2.258, 2.274, 2.290, 2.306, 2.322, 2.337, 2.353, & - & 2.368, 2.382, 2.397, 2.412, 2.426, 2.440, 2.454, 2.467, 2.481, & - & 2.494, 2.507, 2.520, 2.533, 2.546, 2.558, 2.571, 2.583, 2.595, & - & 2.606, 2.618, 2.630, 2.641, 2.652, 2.663, 2.674, 2.685, 2.696, & - & 2.706, 2.717, 2.727, 2.737, 2.747, 2.757, 2.767, 2.776, 2.786, & - & 2.795, 2.804, 2.813, 2.822, 2.831, 2.840, 2.849, 2.857, 2.866, & - & 2.874, 2.882, 2.891, 2.899, 2.907, 2.914, 2.922, 2.930, 2.937, & - & 2.945, 2.952, 2.959, 2.966, 2.973, 2.980, 2.987, 2.994, 3.001, & - & 3.007, 3.014, 3.020, 3.027, 3.033, 3.039, 3.045, 3.051, 3.057, & - & 3.063, 3.069, 3.075, 3.081, 3.086, 3.092, 3.097, 3.102, 3.108, & - & 3.113, 3.118, 3.123, 3.128, 3.133, 3.138, 3.143, 3.147, 3.152, & - & 3.157, 3.161, 3.166, 3.170, 3.175, 3.179, 3.183, 3.187, 3.191, & - & 3.195, 3.199, 3.203, 3.207, 3.211, 3.215, 3.219, 3.222, 3.226, & - & 3.229, 3.233, 3.236 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.101,-0.220,-0.281,-0.324,-0.358,-0.387,-0.412,-0.434,-0.453, & - -0.471,-0.487,-0.503,-0.517,-0.530,-0.543,-0.555,-0.566,-0.577, & - -0.587,-0.597,-0.606,-0.615,-0.624,-0.632,-0.641,-0.649,-0.656, & - -0.664,-0.671,-0.678,-0.685,-0.692,-0.698,-0.705,-0.711,-0.717, & - -0.723,-0.729,-0.735,-0.740,-0.746,-0.752,-0.757,-0.762,-0.767, & - -0.772,-0.777,-0.782,-0.787,-0.792,-0.797,-0.801,-0.806,-0.810, & - -0.815,-0.819,-0.824,-0.828,-0.832,-0.836,-0.840,-0.844,-0.848, & - -0.852,-0.856,-0.860,-0.864,-0.868,-0.872,-0.876,-0.879,-0.883, & - -0.887,-0.890,-0.894,-0.897,-0.901,-0.904,-0.908,-0.911,-0.915, & - -0.918,-0.922,-0.925,-0.928,-0.932,-0.935,-0.938,-0.942,-0.945, & - -0.948,-0.951,-0.954,-0.958,-0.961,-0.964,-0.967,-0.970,-0.973, & - -0.976,-0.979,-0.982,-0.985,-0.988,-0.991,-0.994,-0.997,-1.000, & - -1.003,-1.006,-1.009,-1.012,-1.015,-1.018,-1.021,-1.024,-1.026, & - -1.029,-1.032,-1.035,-1.038,-1.040,-1.043,-1.046,-1.049,-1.051, & - -1.054,-1.057,-1.060,-1.062,-1.065,-1.068,-1.070,-1.073,-1.076, & - -1.078,-1.081,-1.083,-1.086,-1.089,-1.091,-1.094,-1.096,-1.099, & - -1.102,-1.104,-1.107,-1.109,-1.112,-1.114,-1.117,-1.119,-1.122, & - -1.124,-1.127,-1.129,-1.131,-1.134,-1.136,-1.139,-1.141,-1.144, & - -1.146,-1.148,-1.151,-1.153,-1.155,-1.158,-1.160,-1.163,-1.165, & - -1.167,-1.170,-1.172,-1.174,-1.177,-1.179,-1.181,-1.183,-1.186, & - -1.188,-1.190,-1.193,-1.195,-1.197,-1.199,-1.202,-1.204,-1.206, & - -1.208,-1.210,-1.213,-1.215,-1.217,-1.219,-1.221,-1.224,-1.226, & - -1.228,-1.230,-1.232,-1.235,-1.237,-1.239,-1.241,-1.243,-1.245, & - -1.247,-1.250,-1.252,-1.254,-1.256,-1.258,-1.260,-1.262,-1.264, & - -1.266,-1.269,-1.271,-1.273,-1.275,-1.277,-1.279,-1.281,-1.283, & - -1.285,-1.287,-1.289,-1.291,-1.293,-1.295,-1.297,-1.299,-1.301, & - -1.303,-1.305,-1.307,-1.309,-1.311,-1.313,-1.315,-1.317,-1.319, & - -1.321,-1.323,-1.325,-1.327,-1.329,-1.331,-1.333,-1.335,-1.337, & - -1.339,-1.341,-1.343,-1.345,-1.347,-1.349,-1.351,-1.353,-1.355, & - -1.357,-1.358,-1.360,-1.362,-1.364,-1.366,-1.368,-1.370,-1.372, & - -1.374,-1.376,-1.377,-1.379,-1.381,-1.383,-1.385,-1.387,-1.389, & - -1.391,-1.392,-1.394,-1.396,-1.398,-1.400,-1.402,-1.404,-1.405, & - -1.407,-1.409,-1.411,-1.413,-1.415,-1.417,-1.418,-1.420,-1.422, & - -1.424,-1.426,-1.427,-1.429,-1.431,-1.433,-1.435,-1.437,-1.438, & - -1.440,-1.442,-1.444,-1.445,-1.447,-1.449,-1.451,-1.453,-1.454, & - -1.456,-1.458,-1.460,-1.462,-1.463,-1.465,-1.467,-1.469,-1.470, & - -1.472,-1.474,-1.476,-1.477,-1.479,-1.481,-1.483,-1.484,-1.486, & - -1.488,-1.490,-1.491,-1.493,-1.495,-1.496,-1.498,-1.500,-1.502, & - -1.503,-1.505,-1.507,-1.509,-1.510,-1.512,-1.514,-1.515,-1.517, & - -1.519,-1.520,-1.522,-1.524,-1.526,-1.527,-1.529,-1.531,-1.532, & - -1.534,-1.536,-1.537,-1.539,-1.541,-1.542,-1.544,-1.546,-1.547, & - -1.549,-1.551,-1.552,-1.554,-1.556,-1.557,-1.559,-1.561,-1.562, & - -1.564,-1.566,-1.567,-1.569,-1.571,-1.572,-1.574,-1.576,-1.577, & - -1.579,-1.580,-1.582,-1.584,-1.585,-1.587,-1.589,-1.590,-1.592, & - -1.594,-1.595,-1.597,-1.598,-1.616,-1.632,-1.648,-1.663,-1.679, & - -1.694,-1.710,-1.725,-1.740,-1.755,-1.770,-1.785,-1.799,-1.814, & - -1.828,-1.843,-1.857,-1.871,-1.885,-1.900,-1.914,-1.928,-1.941, & - -1.955,-1.969,-1.983,-1.996,-2.010,-2.023,-2.037,-2.050,-2.063, & - -2.077,-2.090,-2.103,-2.116,-2.129,-2.142,-2.155,-2.168,-2.181, & - -2.194,-2.206,-2.219,-2.232,-2.244,-2.257,-2.269,-2.282,-2.294, & - -2.307,-2.319,-2.332,-2.344,-2.356,-2.369,-2.381,-2.393,-2.405, & - -2.417,-2.429,-2.441,-2.454,-2.466,-2.478,-2.489,-2.501,-2.513, & - -2.525,-2.537,-2.549,-2.561,-2.572,-2.584,-2.596,-2.608,-2.619, & - -2.631,-2.642,-2.654,-2.666,-2.677,-2.689,-2.700,-2.712,-2.723, & - -2.735,-2.746,-2.757,-2.769,-2.780,-2.792,-2.803,-2.814,-2.825, & - -2.837,-2.848,-2.859,-2.870,-2.882,-2.893,-2.904,-2.915,-2.926, & - -2.937,-2.948,-2.959,-2.971,-2.982,-2.993,-3.004,-3.015,-3.026, & - -3.037,-3.048,-3.058,-3.069,-3.080,-3.091,-3.102,-3.113,-3.124, & - -3.135,-3.145,-3.156,-3.167,-3.178,-3.189,-3.199,-3.210,-3.221, & - -3.232,-3.242,-3.253,-3.264,-3.274,-3.285,-3.296,-3.306,-3.317, & - -3.327,-3.338,-3.349,-3.359,-3.370,-3.380,-3.391,-3.401,-3.412, & - -3.422,-3.433,-3.443,-3.454,-3.464,-3.475,-3.485,-3.496,-3.506, & - -3.517,-3.527,-3.537 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.049,-0.104,-0.130,-0.148,-0.162,-0.173,-0.182,-0.190,-0.197, & - -0.203,-0.208,-0.213,-0.217,-0.221,-0.224,-0.227,-0.230,-0.232, & - -0.234,-0.236,-0.238,-0.239,-0.240,-0.241,-0.242,-0.243,-0.243, & - -0.244,-0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.242,-0.242, & - -0.241,-0.240,-0.239,-0.238,-0.237,-0.236,-0.235,-0.233,-0.232, & - -0.230,-0.229,-0.227,-0.225,-0.223,-0.222,-0.220,-0.218,-0.216, & - -0.214,-0.211,-0.209,-0.207,-0.205,-0.202,-0.200,-0.197,-0.195, & - -0.192,-0.190,-0.187,-0.185,-0.182,-0.179,-0.176,-0.174,-0.171, & - -0.168,-0.165,-0.162,-0.159,-0.156,-0.153,-0.150,-0.147,-0.143, & - -0.140,-0.137,-0.134,-0.131,-0.127,-0.124,-0.120,-0.117,-0.114, & - -0.110,-0.107,-0.103,-0.100,-0.096,-0.092,-0.089,-0.085,-0.081, & - -0.078,-0.074,-0.070,-0.066,-0.063,-0.059,-0.055,-0.051,-0.047, & - -0.043,-0.040,-0.036,-0.032,-0.028,-0.024,-0.020,-0.016,-0.012, & - -0.008,-0.004, 0.000, 0.004, 0.008, 0.012, 0.015, 0.019, 0.023, & - & 0.027, 0.031, 0.035, 0.039, 0.043, 0.047, 0.051, 0.055, 0.059, & - & 0.063, 0.067, 0.071, 0.075, 0.078, 0.082, 0.086, 0.090, 0.094, & - & 0.098, 0.102, 0.106, 0.109, 0.113, 0.117, 0.121, 0.125, 0.128, & - & 0.132, 0.136, 0.140, 0.144, 0.147, 0.151, 0.155, 0.159, 0.162, & - & 0.166, 0.170, 0.173, 0.177, 0.181, 0.184, 0.188, 0.192, 0.195, & - & 0.199, 0.203, 0.206, 0.210, 0.213, 0.217, 0.221, 0.224, 0.228, & - & 0.231, 0.235, 0.238, 0.242, 0.245, 0.249, 0.252, 0.256, 0.259, & - & 0.263, 0.266, 0.270, 0.273, 0.277, 0.280, 0.284, 0.287, 0.290, & - & 0.294, 0.297, 0.301, 0.304, 0.307, 0.311, 0.314, 0.317, 0.321, & - & 0.324, 0.327, 0.331, 0.334, 0.337, 0.340, 0.344, 0.347, 0.350, & - & 0.353, 0.357, 0.360, 0.363, 0.366, 0.369, 0.373, 0.376, 0.379, & - & 0.382, 0.385, 0.389, 0.392, 0.395, 0.398, 0.401, 0.404, 0.407, & - & 0.410, 0.413, 0.417, 0.420, 0.423, 0.426, 0.429, 0.432, 0.435, & - & 0.438, 0.441, 0.444, 0.447, 0.450, 0.453, 0.456, 0.459, 0.462, & - & 0.465, 0.468, 0.471, 0.474, 0.477, 0.480, 0.482, 0.485, 0.488, & - & 0.491, 0.494, 0.497, 0.500, 0.503, 0.506, 0.508, 0.511, 0.514, & - & 0.517, 0.520, 0.523, 0.525, 0.528, 0.531, 0.534, 0.537, 0.539, & - & 0.542, 0.545, 0.548, 0.551, 0.553, 0.556, 0.559, 0.562, 0.564, & - & 0.567, 0.570, 0.572, 0.575, 0.578, 0.581, 0.583, 0.586, 0.589, & - & 0.591, 0.594, 0.597, 0.599, 0.602, 0.604, 0.607, 0.610, 0.612, & - & 0.615, 0.618, 0.620, 0.623, 0.625, 0.628, 0.631, 0.633, 0.636, & - & 0.638, 0.641, 0.643, 0.646, 0.648, 0.651, 0.654, 0.656, 0.659, & - & 0.661, 0.664, 0.666, 0.669, 0.671, 0.674, 0.676, 0.679, 0.681, & - & 0.684, 0.686, 0.688, 0.691, 0.693, 0.696, 0.698, 0.701, 0.703, & - & 0.706, 0.708, 0.710, 0.713, 0.715, 0.718, 0.720, 0.722, 0.725, & - & 0.727, 0.729, 0.732, 0.734, 0.737, 0.739, 0.741, 0.744, 0.746, & - & 0.748, 0.751, 0.753, 0.755, 0.758, 0.760, 0.762, 0.764, 0.767, & - & 0.769, 0.771, 0.774, 0.776, 0.778, 0.780, 0.783, 0.785, 0.787, & - & 0.789, 0.792, 0.794, 0.796, 0.798, 0.801, 0.803, 0.805, 0.807, & - & 0.810, 0.812, 0.814, 0.816, 0.818, 0.821, 0.823, 0.825, 0.827, & - & 0.829, 0.831, 0.834, 0.836, 0.859, 0.880, 0.900, 0.921, 0.940, & - & 0.960, 0.979, 0.998, 1.016, 1.034, 1.052, 1.070, 1.087, 1.104, & - & 1.121, 1.137, 1.154, 1.169, 1.185, 1.201, 1.216, 1.231, 1.246, & - & 1.260, 1.274, 1.289, 1.302, 1.316, 1.330, 1.343, 1.356, 1.369, & - & 1.382, 1.394, 1.407, 1.419, 1.431, 1.443, 1.455, 1.466, 1.478, & - & 1.489, 1.500, 1.511, 1.522, 1.533, 1.543, 1.554, 1.564, 1.574, & - & 1.584, 1.594, 1.604, 1.614, 1.623, 1.633, 1.642, 1.651, 1.660, & - & 1.670, 1.678, 1.687, 1.696, 1.704, 1.713, 1.721, 1.730, 1.738, & - & 1.746, 1.754, 1.762, 1.770, 1.777, 1.785, 1.793, 1.800, 1.807, & - & 1.815, 1.822, 1.829, 1.836, 1.843, 1.850, 1.857, 1.864, 1.870, & - & 1.877, 1.883, 1.890, 1.896, 1.903, 1.909, 1.915, 1.921, 1.927, & - & 1.933, 1.939, 1.945, 1.951, 1.957, 1.962, 1.968, 1.973, 1.979, & - & 1.984, 1.990, 1.995, 2.000, 2.006, 2.011, 2.016, 2.021, 2.026, & - & 2.031, 2.036, 2.041, 2.045, 2.050, 2.055, 2.059, 2.064, 2.069, & - & 2.073, 2.078, 2.082, 2.086, 2.091, 2.095, 2.099, 2.103, 2.108, & - & 2.112, 2.116, 2.120, 2.124, 2.128, 2.132, 2.135, 2.139, 2.143, & - & 2.147, 2.150, 2.154, 2.158, 2.161, 2.165, 2.168, 2.172, 2.175, & - & 2.179, 2.182, 2.185, 2.189, 2.192, 2.195, 2.198, 2.201, 2.205, & - & 2.208, 2.211, 2.214 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.052,-0.120,-0.158,-0.187,-0.211,-0.232,-0.251,-0.269,-0.285, & - -0.300,-0.315,-0.329,-0.342,-0.354,-0.367,-0.378,-0.390,-0.401, & - -0.412,-0.422,-0.432,-0.443,-0.452,-0.462,-0.471,-0.481,-0.490, & - -0.498,-0.507,-0.516,-0.524,-0.532,-0.540,-0.548,-0.556,-0.564, & - -0.572,-0.579,-0.587,-0.594,-0.601,-0.608,-0.615,-0.622,-0.629, & - -0.636,-0.642,-0.649,-0.655,-0.661,-0.668,-0.674,-0.680,-0.686, & - -0.692,-0.698,-0.704,-0.710,-0.715,-0.721,-0.727,-0.732,-0.738, & - -0.743,-0.749,-0.754,-0.759,-0.765,-0.770,-0.775,-0.780,-0.785, & - -0.790,-0.796,-0.801,-0.806,-0.811,-0.816,-0.820,-0.825,-0.830, & - -0.835,-0.840,-0.845,-0.850,-0.854,-0.859,-0.864,-0.869,-0.873, & - -0.878,-0.883,-0.888,-0.892,-0.897,-0.902,-0.906,-0.911,-0.916, & - -0.920,-0.925,-0.929,-0.934,-0.938,-0.943,-0.948,-0.952,-0.957, & - -0.961,-0.966,-0.970,-0.974,-0.979,-0.983,-0.988,-0.992,-0.996, & - -1.001,-1.005,-1.009,-1.014,-1.018,-1.022,-1.026,-1.031,-1.035, & - -1.039,-1.043,-1.047,-1.052,-1.056,-1.060,-1.064,-1.068,-1.072, & - -1.076,-1.080,-1.084,-1.088,-1.092,-1.096,-1.100,-1.104,-1.108, & - -1.112,-1.115,-1.119,-1.123,-1.127,-1.131,-1.134,-1.138,-1.142, & - -1.146,-1.149,-1.153,-1.157,-1.160,-1.164,-1.168,-1.171,-1.175, & - -1.178,-1.182,-1.185,-1.189,-1.192,-1.196,-1.199,-1.203,-1.206, & - -1.210,-1.213,-1.217,-1.220,-1.223,-1.227,-1.230,-1.234,-1.237, & - -1.240,-1.243,-1.247,-1.250,-1.253,-1.257,-1.260,-1.263,-1.266, & - -1.269,-1.273,-1.276,-1.279,-1.282,-1.285,-1.288,-1.291,-1.295, & - -1.298,-1.301,-1.304,-1.307,-1.310,-1.313,-1.316,-1.319,-1.322, & - -1.325,-1.328,-1.331,-1.334,-1.337,-1.340,-1.342,-1.345,-1.348, & - -1.351,-1.354,-1.357,-1.360,-1.362,-1.365,-1.368,-1.371,-1.374, & - -1.376,-1.379,-1.382,-1.385,-1.387,-1.390,-1.393,-1.396,-1.398, & - -1.401,-1.404,-1.406,-1.409,-1.412,-1.414,-1.417,-1.420,-1.422, & - -1.425,-1.427,-1.430,-1.432,-1.435,-1.438,-1.440,-1.443,-1.445, & - -1.448,-1.450,-1.453,-1.455,-1.458,-1.460,-1.463,-1.465,-1.468, & - -1.470,-1.472,-1.475,-1.477,-1.480,-1.482,-1.484,-1.487,-1.489, & - -1.492,-1.494,-1.496,-1.499,-1.501,-1.503,-1.506,-1.508,-1.510, & - -1.512,-1.515,-1.517,-1.519,-1.522,-1.524,-1.526,-1.528,-1.531, & - -1.533,-1.535,-1.537,-1.539,-1.542,-1.544,-1.546,-1.548,-1.550, & - -1.552,-1.555,-1.557,-1.559,-1.561,-1.563,-1.565,-1.567,-1.569, & - -1.572,-1.574,-1.576,-1.578,-1.580,-1.582,-1.584,-1.586,-1.588, & - -1.590,-1.592,-1.594,-1.596,-1.598,-1.600,-1.602,-1.604,-1.606, & - -1.608,-1.610,-1.612,-1.614,-1.616,-1.618,-1.620,-1.622,-1.624, & - -1.626,-1.628,-1.630,-1.632,-1.633,-1.635,-1.637,-1.639,-1.641, & - -1.643,-1.645,-1.647,-1.648,-1.650,-1.652,-1.654,-1.656,-1.658, & - -1.660,-1.661,-1.663,-1.665,-1.667,-1.669,-1.670,-1.672,-1.674, & - -1.676,-1.678,-1.679,-1.681,-1.683,-1.685,-1.686,-1.688,-1.690, & - -1.692,-1.693,-1.695,-1.697,-1.698,-1.700,-1.702,-1.704,-1.705, & - -1.707,-1.709,-1.710,-1.712,-1.714,-1.715,-1.717,-1.719,-1.720, & - -1.722,-1.724,-1.725,-1.727,-1.729,-1.730,-1.732,-1.733,-1.735, & - -1.737,-1.738,-1.740,-1.741,-1.758,-1.774,-1.789,-1.803,-1.817, & - -1.831,-1.845,-1.858,-1.871,-1.884,-1.896,-1.908,-1.920,-1.932, & - -1.943,-1.954,-1.965,-1.976,-1.987,-1.997,-2.008,-2.018,-2.028, & - -2.037,-2.047,-2.056,-2.066,-2.075,-2.084,-2.093,-2.102,-2.111, & - -2.119,-2.128,-2.136,-2.144,-2.152,-2.161,-2.169,-2.176,-2.184, & - -2.192,-2.200,-2.207,-2.215,-2.222,-2.230,-2.237,-2.244,-2.251, & - -2.259,-2.266,-2.273,-2.280,-2.287,-2.293,-2.300,-2.307,-2.314, & - -2.320,-2.327,-2.334,-2.340,-2.347,-2.353,-2.360,-2.366,-2.372, & - -2.379,-2.385,-2.391,-2.397,-2.403,-2.410,-2.416,-2.422,-2.428, & - -2.434,-2.440,-2.446,-2.452,-2.458,-2.464,-2.470,-2.475,-2.481, & - -2.487,-2.493,-2.499,-2.504,-2.510,-2.516,-2.522,-2.527,-2.533, & - -2.539,-2.544,-2.550,-2.555,-2.561,-2.566,-2.572,-2.578,-2.583, & - -2.588,-2.594,-2.599,-2.605,-2.610,-2.616,-2.621,-2.627,-2.632, & - -2.637,-2.643,-2.648,-2.653,-2.659,-2.664,-2.669,-2.675,-2.680, & - -2.685,-2.690,-2.696,-2.701,-2.706,-2.711,-2.716,-2.722,-2.727, & - -2.732,-2.737,-2.742,-2.748,-2.753,-2.758,-2.763,-2.768,-2.773, & - -2.778,-2.783,-2.788,-2.794,-2.799,-2.804,-2.809,-2.814,-2.819, & - -2.824,-2.829,-2.834,-2.839,-2.844,-2.849,-2.854,-2.859,-2.864, & - -2.869,-2.874,-2.879 & - / - -! *** KCL - - DATA BNC20M/ & - -0.049,-0.105,-0.132,-0.151,-0.164,-0.176,-0.185,-0.193,-0.200, & - -0.206,-0.211,-0.216,-0.221,-0.224,-0.228,-0.231,-0.234,-0.237, & - -0.240,-0.242,-0.244,-0.246,-0.248,-0.250,-0.252,-0.253,-0.255, & - -0.256,-0.257,-0.258,-0.260,-0.261,-0.262,-0.263,-0.264,-0.265, & - -0.265,-0.266,-0.267,-0.268,-0.268,-0.269,-0.270,-0.270,-0.271, & - -0.271,-0.272,-0.272,-0.273,-0.273,-0.274,-0.274,-0.275,-0.275, & - -0.275,-0.276,-0.276,-0.276,-0.277,-0.277,-0.277,-0.278,-0.278, & - -0.278,-0.278,-0.279,-0.279,-0.279,-0.279,-0.280,-0.280,-0.280, & - -0.280,-0.280,-0.280,-0.280,-0.281,-0.281,-0.281,-0.281,-0.281, & - -0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, & - -0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.280,-0.280, & - -0.280,-0.280,-0.280,-0.280,-0.280,-0.279,-0.279,-0.279,-0.279, & - -0.279,-0.278,-0.278,-0.278,-0.278,-0.278,-0.277,-0.277,-0.277, & - -0.277,-0.276,-0.276,-0.276,-0.276,-0.275,-0.275,-0.275,-0.275, & - -0.274,-0.274,-0.274,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272, & - -0.272,-0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.269, & - -0.269,-0.269,-0.268,-0.268,-0.268,-0.267,-0.267,-0.267,-0.267, & - -0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.264,-0.264,-0.264, & - -0.263,-0.263,-0.263,-0.262,-0.262,-0.262,-0.262,-0.261,-0.261, & - -0.261,-0.260,-0.260,-0.260,-0.259,-0.259,-0.259,-0.258,-0.258, & - -0.258,-0.258,-0.257,-0.257,-0.257,-0.256,-0.256,-0.256,-0.255, & - -0.255,-0.255,-0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253, & - -0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.251,-0.250,-0.250, & - -0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.248,-0.247, & - -0.247,-0.247,-0.246,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245, & - -0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.243,-0.242,-0.242, & - -0.242,-0.242,-0.241,-0.241,-0.241,-0.241,-0.240,-0.240,-0.240, & - -0.239,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238,-0.238,-0.237, & - -0.237,-0.237,-0.236,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235, & - -0.235,-0.234,-0.234,-0.234,-0.234,-0.233,-0.233,-0.233,-0.233, & - -0.232,-0.232,-0.232,-0.232,-0.231,-0.231,-0.231,-0.231,-0.230, & - -0.230,-0.230,-0.230,-0.229,-0.229,-0.229,-0.229,-0.228,-0.228, & - -0.228,-0.228,-0.227,-0.227,-0.227,-0.227,-0.226,-0.226,-0.226, & - -0.226,-0.226,-0.225,-0.225,-0.225,-0.225,-0.224,-0.224,-0.224, & - -0.224,-0.223,-0.223,-0.223,-0.223,-0.223,-0.222,-0.222,-0.222, & - -0.222,-0.221,-0.221,-0.221,-0.221,-0.221,-0.220,-0.220,-0.220, & - -0.220,-0.220,-0.219,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218, & - -0.218,-0.218,-0.217,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216, & - -0.216,-0.216,-0.216,-0.215,-0.215,-0.215,-0.215,-0.215,-0.215, & - -0.214,-0.214,-0.214,-0.214,-0.214,-0.213,-0.213,-0.213,-0.213, & - -0.213,-0.212,-0.212,-0.212,-0.212,-0.212,-0.212,-0.211,-0.211, & - -0.211,-0.211,-0.211,-0.210,-0.210,-0.210,-0.210,-0.210,-0.210, & - -0.209,-0.209,-0.209,-0.209,-0.209,-0.209,-0.208,-0.208,-0.208, & - -0.208,-0.208,-0.208,-0.207,-0.207,-0.207,-0.207,-0.207,-0.207, & - -0.206,-0.206,-0.206,-0.206,-0.204,-0.203,-0.202,-0.200,-0.199, & - -0.198,-0.197,-0.196,-0.195,-0.194,-0.193,-0.192,-0.191,-0.190, & - -0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.187,-0.187,-0.186, & - -0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186,-0.186, & - -0.186,-0.186,-0.187,-0.187,-0.187,-0.187,-0.188,-0.188,-0.189, & - -0.189,-0.190,-0.190,-0.191,-0.191,-0.192,-0.193,-0.193,-0.194, & - -0.195,-0.196,-0.196,-0.197,-0.198,-0.199,-0.200,-0.201,-0.202, & - -0.203,-0.204,-0.205,-0.206,-0.207,-0.208,-0.209,-0.210,-0.212, & - -0.213,-0.214,-0.215,-0.217,-0.218,-0.219,-0.220,-0.222,-0.223, & - -0.225,-0.226,-0.227,-0.229,-0.230,-0.232,-0.233,-0.235,-0.236, & - -0.238,-0.239,-0.241,-0.243,-0.244,-0.246,-0.247,-0.249,-0.251, & - -0.252,-0.254,-0.256,-0.258,-0.259,-0.261,-0.263,-0.265,-0.266, & - -0.268,-0.270,-0.272,-0.274,-0.276,-0.278,-0.280,-0.281,-0.283, & - -0.285,-0.287,-0.289,-0.291,-0.293,-0.295,-0.297,-0.299,-0.301, & - -0.303,-0.305,-0.307,-0.309,-0.311,-0.314,-0.316,-0.318,-0.320, & - -0.322,-0.324,-0.326,-0.329,-0.331,-0.333,-0.335,-0.337,-0.340, & - -0.342,-0.344,-0.346,-0.348,-0.351,-0.353,-0.355,-0.358,-0.360, & - -0.362,-0.364,-0.367,-0.369,-0.371,-0.374,-0.376,-0.379,-0.381, & - -0.383,-0.386,-0.388 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.200,-0.434,-0.550,-0.632,-0.696,-0.748,-0.793,-0.833,-0.868, & - -0.900,-0.928,-0.955,-0.979,-1.002,-1.023,-1.043,-1.062,-1.079, & - -1.096,-1.112,-1.127,-1.142,-1.156,-1.170,-1.182,-1.195,-1.207, & - -1.218,-1.230,-1.241,-1.251,-1.261,-1.271,-1.281,-1.290,-1.300, & - -1.309,-1.317,-1.326,-1.334,-1.342,-1.350,-1.358,-1.366,-1.373, & - -1.381,-1.388,-1.395,-1.402,-1.409,-1.416,-1.422,-1.429,-1.435, & - -1.442,-1.448,-1.454,-1.460,-1.466,-1.472,-1.478,-1.484,-1.489, & - -1.495,-1.500,-1.506,-1.511,-1.517,-1.522,-1.527,-1.532,-1.537, & - -1.542,-1.547,-1.552,-1.557,-1.562,-1.567,-1.571,-1.576,-1.581, & - -1.585,-1.590,-1.594,-1.599,-1.603,-1.608,-1.612,-1.616,-1.620, & - -1.625,-1.629,-1.633,-1.637,-1.641,-1.645,-1.649,-1.653,-1.657, & - -1.661,-1.665,-1.669,-1.672,-1.676,-1.680,-1.684,-1.687,-1.691, & - -1.695,-1.698,-1.702,-1.706,-1.709,-1.713,-1.716,-1.720,-1.723, & - -1.727,-1.730,-1.733,-1.737,-1.740,-1.744,-1.747,-1.750,-1.753, & - -1.757,-1.760,-1.763,-1.766,-1.770,-1.773,-1.776,-1.779,-1.782, & - -1.786,-1.789,-1.792,-1.795,-1.798,-1.801,-1.804,-1.807,-1.810, & - -1.813,-1.816,-1.819,-1.822,-1.825,-1.828,-1.831,-1.834,-1.837, & - -1.840,-1.843,-1.846,-1.849,-1.851,-1.854,-1.857,-1.860,-1.863, & - -1.866,-1.868,-1.871,-1.874,-1.877,-1.880,-1.882,-1.885,-1.888, & - -1.891,-1.894,-1.896,-1.899,-1.902,-1.904,-1.907,-1.910,-1.913, & - -1.915,-1.918,-1.921,-1.923,-1.926,-1.929,-1.931,-1.934,-1.936, & - -1.939,-1.942,-1.944,-1.947,-1.950,-1.952,-1.955,-1.957,-1.960, & - -1.962,-1.965,-1.968,-1.970,-1.973,-1.975,-1.978,-1.980,-1.983, & - -1.985,-1.988,-1.990,-1.993,-1.995,-1.998,-2.000,-2.003,-2.005, & - -2.008,-2.010,-2.013,-2.015,-2.018,-2.020,-2.023,-2.025,-2.028, & - -2.030,-2.032,-2.035,-2.037,-2.040,-2.042,-2.044,-2.047,-2.049, & - -2.052,-2.054,-2.057,-2.059,-2.061,-2.064,-2.066,-2.068,-2.071, & - -2.073,-2.076,-2.078,-2.080,-2.083,-2.085,-2.087,-2.090,-2.092, & - -2.094,-2.097,-2.099,-2.101,-2.104,-2.106,-2.108,-2.111,-2.113, & - -2.115,-2.118,-2.120,-2.122,-2.124,-2.127,-2.129,-2.131,-2.134, & - -2.136,-2.138,-2.141,-2.143,-2.145,-2.147,-2.150,-2.152,-2.154, & - -2.156,-2.159,-2.161,-2.163,-2.165,-2.168,-2.170,-2.172,-2.174, & - -2.177,-2.179,-2.181,-2.183,-2.186,-2.188,-2.190,-2.192,-2.195, & - -2.197,-2.199,-2.201,-2.203,-2.206,-2.208,-2.210,-2.212,-2.214, & - -2.217,-2.219,-2.221,-2.223,-2.225,-2.228,-2.230,-2.232,-2.234, & - -2.236,-2.239,-2.241,-2.243,-2.245,-2.247,-2.249,-2.252,-2.254, & - -2.256,-2.258,-2.260,-2.262,-2.265,-2.267,-2.269,-2.271,-2.273, & - -2.275,-2.278,-2.280,-2.282,-2.284,-2.286,-2.288,-2.290,-2.293, & - -2.295,-2.297,-2.299,-2.301,-2.303,-2.305,-2.308,-2.310,-2.312, & - -2.314,-2.316,-2.318,-2.320,-2.322,-2.325,-2.327,-2.329,-2.331, & - -2.333,-2.335,-2.337,-2.339,-2.341,-2.344,-2.346,-2.348,-2.350, & - -2.352,-2.354,-2.356,-2.358,-2.360,-2.362,-2.365,-2.367,-2.369, & - -2.371,-2.373,-2.375,-2.377,-2.379,-2.381,-2.383,-2.385,-2.388, & - -2.390,-2.392,-2.394,-2.396,-2.398,-2.400,-2.402,-2.404,-2.406, & - -2.408,-2.410,-2.412,-2.415,-2.437,-2.457,-2.478,-2.498,-2.518, & - -2.539,-2.559,-2.579,-2.599,-2.619,-2.638,-2.658,-2.678,-2.698, & - -2.717,-2.737,-2.756,-2.776,-2.795,-2.815,-2.834,-2.854,-2.873, & - -2.892,-2.911,-2.931,-2.950,-2.969,-2.988,-3.007,-3.026,-3.045, & - -3.064,-3.083,-3.102,-3.121,-3.140,-3.159,-3.178,-3.197,-3.215, & - -3.234,-3.253,-3.272,-3.291,-3.309,-3.328,-3.347,-3.365,-3.384, & - -3.403,-3.421,-3.440,-3.459,-3.477,-3.496,-3.514,-3.533,-3.551, & - -3.570,-3.588,-3.607,-3.625,-3.644,-3.662,-3.681,-3.699,-3.718, & - -3.736,-3.754,-3.773,-3.791,-3.810,-3.828,-3.846,-3.865,-3.883, & - -3.901,-3.920,-3.938,-3.956,-3.974,-3.993,-4.011,-4.029,-4.047, & - -4.066,-4.084,-4.102,-4.120,-4.139,-4.157,-4.175,-4.193,-4.211, & - -4.229,-4.248,-4.266,-4.284,-4.302,-4.320,-4.338,-4.356,-4.374, & - -4.392,-4.411,-4.429,-4.447,-4.465,-4.483,-4.501,-4.519,-4.537, & - -4.555,-4.573,-4.591,-4.609,-4.627,-4.645,-4.663,-4.681,-4.699, & - -4.717,-4.735,-4.753,-4.771,-4.789,-4.807,-4.825,-4.842,-4.860, & - -4.878,-4.896,-4.914,-4.932,-4.950,-4.968,-4.986,-5.004,-5.021, & - -5.039,-5.057,-5.075,-5.093,-5.111,-5.129,-5.146,-5.164,-5.182, & - -5.200,-5.218,-5.235,-5.253,-5.271,-5.289,-5.307,-5.324,-5.342, & - -5.360,-5.378,-5.395 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.097,-0.201,-0.248,-0.278,-0.300,-0.316,-0.329,-0.339,-0.347, & - -0.354,-0.359,-0.363,-0.366,-0.369,-0.370,-0.372,-0.372,-0.373, & - -0.372,-0.372,-0.371,-0.370,-0.369,-0.367,-0.366,-0.364,-0.362, & - -0.359,-0.357,-0.354,-0.352,-0.349,-0.346,-0.344,-0.341,-0.338, & - -0.334,-0.331,-0.328,-0.325,-0.322,-0.318,-0.315,-0.312,-0.308, & - -0.305,-0.301,-0.298,-0.294,-0.291,-0.287,-0.284,-0.280,-0.277, & - -0.273,-0.270,-0.266,-0.263,-0.259,-0.256,-0.252,-0.248,-0.245, & - -0.241,-0.238,-0.234,-0.230,-0.227,-0.223,-0.219,-0.216,-0.212, & - -0.208,-0.204,-0.201,-0.197,-0.193,-0.189,-0.185,-0.181,-0.177, & - -0.173,-0.169,-0.165,-0.161,-0.157,-0.153,-0.149,-0.145,-0.141, & - -0.136,-0.132,-0.128,-0.123,-0.119,-0.115,-0.110,-0.106,-0.101, & - -0.097,-0.092,-0.087,-0.083,-0.078,-0.073,-0.069,-0.064,-0.059, & - -0.055,-0.050,-0.045,-0.040,-0.035,-0.031,-0.026,-0.021,-0.016, & - -0.011,-0.006,-0.001, 0.003, 0.008, 0.013, 0.018, 0.023, 0.028, & - & 0.033, 0.038, 0.043, 0.048, 0.052, 0.057, 0.062, 0.067, 0.072, & - & 0.077, 0.082, 0.087, 0.092, 0.097, 0.101, 0.106, 0.111, 0.116, & - & 0.121, 0.126, 0.131, 0.135, 0.140, 0.145, 0.150, 0.155, 0.160, & - & 0.164, 0.169, 0.174, 0.179, 0.184, 0.188, 0.193, 0.198, 0.203, & - & 0.207, 0.212, 0.217, 0.222, 0.226, 0.231, 0.236, 0.241, 0.245, & - & 0.250, 0.255, 0.259, 0.264, 0.269, 0.273, 0.278, 0.283, 0.287, & - & 0.292, 0.297, 0.301, 0.306, 0.311, 0.315, 0.320, 0.324, 0.329, & - & 0.333, 0.338, 0.343, 0.347, 0.352, 0.356, 0.361, 0.365, 0.370, & - & 0.374, 0.379, 0.383, 0.388, 0.392, 0.397, 0.401, 0.406, 0.410, & - & 0.414, 0.419, 0.423, 0.428, 0.432, 0.437, 0.441, 0.445, 0.450, & - & 0.454, 0.458, 0.463, 0.467, 0.472, 0.476, 0.480, 0.484, 0.489, & - & 0.493, 0.497, 0.502, 0.506, 0.510, 0.514, 0.519, 0.523, 0.527, & - & 0.531, 0.536, 0.540, 0.544, 0.548, 0.553, 0.557, 0.561, 0.565, & - & 0.569, 0.573, 0.578, 0.582, 0.586, 0.590, 0.594, 0.598, 0.602, & - & 0.606, 0.610, 0.615, 0.619, 0.623, 0.627, 0.631, 0.635, 0.639, & - & 0.643, 0.647, 0.651, 0.655, 0.659, 0.663, 0.667, 0.671, 0.675, & - & 0.679, 0.683, 0.687, 0.691, 0.695, 0.699, 0.703, 0.706, 0.710, & - & 0.714, 0.718, 0.722, 0.726, 0.730, 0.734, 0.738, 0.741, 0.745, & - & 0.749, 0.753, 0.757, 0.761, 0.764, 0.768, 0.772, 0.776, 0.779, & - & 0.783, 0.787, 0.791, 0.795, 0.798, 0.802, 0.806, 0.809, 0.813, & - & 0.817, 0.821, 0.824, 0.828, 0.832, 0.835, 0.839, 0.843, 0.846, & - & 0.850, 0.854, 0.857, 0.861, 0.865, 0.868, 0.872, 0.875, 0.879, & - & 0.883, 0.886, 0.890, 0.893, 0.897, 0.900, 0.904, 0.907, 0.911, & - & 0.915, 0.918, 0.922, 0.925, 0.929, 0.932, 0.936, 0.939, 0.943, & - & 0.946, 0.950, 0.953, 0.956, 0.960, 0.963, 0.967, 0.970, 0.974, & - & 0.977, 0.980, 0.984, 0.987, 0.991, 0.994, 0.997, 1.001, 1.004, & - & 1.007, 1.011, 1.014, 1.018, 1.021, 1.024, 1.028, 1.031, 1.034, & - & 1.037, 1.041, 1.044, 1.047, 1.051, 1.054, 1.057, 1.060, 1.064, & - & 1.067, 1.070, 1.073, 1.077, 1.080, 1.083, 1.086, 1.090, 1.093, & - & 1.096, 1.099, 1.102, 1.106, 1.109, 1.112, 1.115, 1.118, 1.121, & - & 1.125, 1.128, 1.131, 1.134, 1.167, 1.198, 1.228, 1.257, 1.286, & - & 1.314, 1.342, 1.370, 1.397, 1.423, 1.449, 1.475, 1.500, 1.525, & - & 1.549, 1.573, 1.597, 1.620, 1.643, 1.665, 1.687, 1.709, 1.730, & - & 1.751, 1.772, 1.793, 1.813, 1.833, 1.852, 1.871, 1.890, 1.909, & - & 1.927, 1.945, 1.963, 1.981, 1.998, 2.015, 2.032, 2.049, 2.065, & - & 2.081, 2.097, 2.112, 2.128, 2.143, 2.158, 2.173, 2.187, 2.202, & - & 2.216, 2.230, 2.244, 2.257, 2.271, 2.284, 2.297, 2.310, 2.322, & - & 2.335, 2.347, 2.359, 2.371, 2.383, 2.395, 2.406, 2.418, 2.429, & - & 2.440, 2.451, 2.462, 2.472, 2.483, 2.493, 2.503, 2.513, 2.523, & - & 2.533, 2.543, 2.552, 2.562, 2.571, 2.580, 2.589, 2.598, 2.607, & - & 2.616, 2.624, 2.633, 2.641, 2.650, 2.658, 2.666, 2.674, 2.681, & - & 2.689, 2.697, 2.704, 2.712, 2.719, 2.726, 2.733, 2.740, 2.747, & - & 2.754, 2.761, 2.768, 2.774, 2.781, 2.787, 2.793, 2.800, 2.806, & - & 2.812, 2.818, 2.824, 2.830, 2.835, 2.841, 2.847, 2.852, 2.858, & - & 2.863, 2.868, 2.873, 2.879, 2.884, 2.889, 2.893, 2.898, 2.903, & - & 2.908, 2.912, 2.917, 2.922, 2.926, 2.930, 2.935, 2.939, 2.943, & - & 2.947, 2.951, 2.955, 2.959, 2.963, 2.967, 2.971, 2.974, 2.978, & - & 2.982, 2.985, 2.989, 2.992, 2.996, 2.999, 3.002, 3.005, 3.009, & - & 3.012, 3.015, 3.018 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.096,-0.198,-0.242,-0.270,-0.290,-0.304,-0.315,-0.323,-0.329, & - -0.333,-0.337,-0.339,-0.340,-0.341,-0.340,-0.340,-0.339,-0.337, & - -0.335,-0.333,-0.330,-0.327,-0.324,-0.320,-0.317,-0.313,-0.309, & - -0.305,-0.301,-0.296,-0.292,-0.287,-0.283,-0.278,-0.273,-0.268, & - -0.263,-0.258,-0.253,-0.248,-0.243,-0.238,-0.233,-0.228,-0.222, & - -0.217,-0.212,-0.207,-0.202,-0.196,-0.191,-0.186,-0.180,-0.175, & - -0.170,-0.164,-0.159,-0.154,-0.149,-0.143,-0.138,-0.133,-0.127, & - -0.122,-0.117,-0.111,-0.106,-0.100,-0.095,-0.090,-0.084,-0.079, & - -0.073,-0.068,-0.062,-0.057,-0.051,-0.045,-0.040,-0.034,-0.028, & - -0.023,-0.017,-0.011,-0.005, 0.001, 0.007, 0.013, 0.019, 0.025, & - & 0.031, 0.037, 0.043, 0.049, 0.055, 0.062, 0.068, 0.074, 0.081, & - & 0.087, 0.094, 0.100, 0.107, 0.113, 0.120, 0.126, 0.133, 0.140, & - & 0.146, 0.153, 0.160, 0.166, 0.173, 0.180, 0.187, 0.193, 0.200, & - & 0.207, 0.214, 0.220, 0.227, 0.234, 0.241, 0.248, 0.255, 0.261, & - & 0.268, 0.275, 0.282, 0.289, 0.296, 0.302, 0.309, 0.316, 0.323, & - & 0.330, 0.337, 0.343, 0.350, 0.357, 0.364, 0.371, 0.377, 0.384, & - & 0.391, 0.398, 0.404, 0.411, 0.418, 0.425, 0.431, 0.438, 0.445, & - & 0.451, 0.458, 0.465, 0.471, 0.478, 0.485, 0.491, 0.498, 0.505, & - & 0.511, 0.518, 0.524, 0.531, 0.537, 0.544, 0.551, 0.557, 0.564, & - & 0.570, 0.577, 0.583, 0.590, 0.596, 0.603, 0.609, 0.616, 0.622, & - & 0.628, 0.635, 0.641, 0.648, 0.654, 0.660, 0.667, 0.673, 0.679, & - & 0.686, 0.692, 0.698, 0.705, 0.711, 0.717, 0.724, 0.730, 0.736, & - & 0.742, 0.749, 0.755, 0.761, 0.767, 0.773, 0.780, 0.786, 0.792, & - & 0.798, 0.804, 0.810, 0.816, 0.823, 0.829, 0.835, 0.841, 0.847, & - & 0.853, 0.859, 0.865, 0.871, 0.877, 0.883, 0.889, 0.895, 0.901, & - & 0.907, 0.913, 0.919, 0.925, 0.931, 0.937, 0.942, 0.948, 0.954, & - & 0.960, 0.966, 0.972, 0.978, 0.983, 0.989, 0.995, 1.001, 1.007, & - & 1.012, 1.018, 1.024, 1.030, 1.035, 1.041, 1.047, 1.052, 1.058, & - & 1.064, 1.069, 1.075, 1.081, 1.086, 1.092, 1.098, 1.103, 1.109, & - & 1.114, 1.120, 1.125, 1.131, 1.136, 1.142, 1.148, 1.153, 1.159, & - & 1.164, 1.169, 1.175, 1.180, 1.186, 1.191, 1.197, 1.202, 1.208, & - & 1.213, 1.218, 1.224, 1.229, 1.234, 1.240, 1.245, 1.250, 1.256, & - & 1.261, 1.266, 1.272, 1.277, 1.282, 1.287, 1.293, 1.298, 1.303, & - & 1.308, 1.314, 1.319, 1.324, 1.329, 1.334, 1.339, 1.345, 1.350, & - & 1.355, 1.360, 1.365, 1.370, 1.375, 1.380, 1.385, 1.390, 1.396, & - & 1.401, 1.406, 1.411, 1.416, 1.421, 1.426, 1.431, 1.436, 1.441, & - & 1.446, 1.451, 1.456, 1.460, 1.465, 1.470, 1.475, 1.480, 1.485, & - & 1.490, 1.495, 1.500, 1.504, 1.509, 1.514, 1.519, 1.524, 1.529, & - & 1.533, 1.538, 1.543, 1.548, 1.553, 1.557, 1.562, 1.567, 1.572, & - & 1.576, 1.581, 1.586, 1.590, 1.595, 1.600, 1.604, 1.609, 1.614, & - & 1.618, 1.623, 1.628, 1.632, 1.637, 1.642, 1.646, 1.651, 1.655, & - & 1.660, 1.664, 1.669, 1.674, 1.678, 1.683, 1.687, 1.692, 1.696, & - & 1.701, 1.705, 1.710, 1.714, 1.719, 1.723, 1.728, 1.732, 1.736, & - & 1.741, 1.745, 1.750, 1.754, 1.759, 1.763, 1.767, 1.772, 1.776, & - & 1.780, 1.785, 1.789, 1.793, 1.840, 1.882, 1.923, 1.964, 2.004, & - & 2.044, 2.082, 2.120, 2.158, 2.195, 2.231, 2.267, 2.302, 2.336, & - & 2.370, 2.404, 2.437, 2.469, 2.501, 2.533, 2.564, 2.594, 2.624, & - & 2.654, 2.683, 2.712, 2.741, 2.768, 2.796, 2.823, 2.850, 2.877, & - & 2.903, 2.928, 2.954, 2.979, 3.003, 3.028, 3.052, 3.076, 3.099, & - & 3.122, 3.145, 3.167, 3.190, 3.211, 3.233, 3.254, 3.276, 3.296, & - & 3.317, 3.337, 3.357, 3.377, 3.397, 3.416, 3.435, 3.454, 3.473, & - & 3.491, 3.509, 3.527, 3.545, 3.563, 3.580, 3.597, 3.614, 3.631, & - & 3.647, 3.664, 3.680, 3.696, 3.712, 3.727, 3.743, 3.758, 3.773, & - & 3.788, 3.803, 3.817, 3.832, 3.846, 3.860, 3.874, 3.888, 3.902, & - & 3.915, 3.928, 3.942, 3.955, 3.968, 3.980, 3.993, 4.006, 4.018, & - & 4.030, 4.042, 4.054, 4.066, 4.078, 4.089, 4.101, 4.112, 4.123, & - & 4.134, 4.145, 4.156, 4.167, 4.178, 4.188, 4.199, 4.209, 4.219, & - & 4.229, 4.239, 4.249, 4.259, 4.269, 4.278, 4.288, 4.297, 4.306, & - & 4.316, 4.325, 4.334, 4.343, 4.351, 4.360, 4.369, 4.377, 4.386, & - & 4.394, 4.402, 4.411, 4.419, 4.427, 4.435, 4.442, 4.450, 4.458, & - & 4.466, 4.473, 4.480, 4.488, 4.495, 4.502, 4.510, 4.517, 4.524, & - & 4.531, 4.537, 4.544, 4.551, 4.558, 4.564, 4.571, 4.577, 4.583, & - & 4.590, 4.596, 4.602 & - / - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM248 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 248K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM248 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC248/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM248 - - - BLOCK DATA KMCF248 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC248/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.047,-0.099,-0.122,-0.137,-0.148,-0.156,-0.163,-0.168,-0.172, & - -0.176,-0.178,-0.181,-0.182,-0.184,-0.185,-0.186,-0.186,-0.187, & - -0.187,-0.187,-0.187,-0.187,-0.186,-0.186,-0.185,-0.184,-0.184, & - -0.183,-0.182,-0.181,-0.180,-0.179,-0.178,-0.176,-0.175,-0.174, & - -0.173,-0.171,-0.170,-0.168,-0.167,-0.166,-0.164,-0.163,-0.161, & - -0.160,-0.158,-0.157,-0.155,-0.154,-0.152,-0.151,-0.149,-0.148, & - -0.146,-0.145,-0.143,-0.141,-0.140,-0.138,-0.137,-0.135,-0.134, & - -0.132,-0.130,-0.129,-0.127,-0.126,-0.124,-0.122,-0.121,-0.119, & - -0.117,-0.116,-0.114,-0.112,-0.111,-0.109,-0.107,-0.105,-0.104, & - -0.102,-0.100,-0.098,-0.096,-0.095,-0.093,-0.091,-0.089,-0.087, & - -0.085,-0.083,-0.081,-0.079,-0.077,-0.075,-0.073,-0.071,-0.069, & - -0.067,-0.065,-0.063,-0.061,-0.059,-0.057,-0.055,-0.053,-0.051, & - -0.048,-0.046,-0.044,-0.042,-0.040,-0.038,-0.036,-0.033,-0.031, & - -0.029,-0.027,-0.025,-0.022,-0.020,-0.018,-0.016,-0.014,-0.011, & - -0.009,-0.007,-0.005,-0.003, 0.000, 0.002, 0.004, 0.006, 0.008, & - & 0.011, 0.013, 0.015, 0.017, 0.020, 0.022, 0.024, 0.026, 0.028, & - & 0.030, 0.033, 0.035, 0.037, 0.039, 0.041, 0.044, 0.046, 0.048, & - & 0.050, 0.052, 0.054, 0.057, 0.059, 0.061, 0.063, 0.065, 0.067, & - & 0.070, 0.072, 0.074, 0.076, 0.078, 0.080, 0.082, 0.085, 0.087, & - & 0.089, 0.091, 0.093, 0.095, 0.097, 0.099, 0.102, 0.104, 0.106, & - & 0.108, 0.110, 0.112, 0.114, 0.116, 0.118, 0.120, 0.122, 0.125, & - & 0.127, 0.129, 0.131, 0.133, 0.135, 0.137, 0.139, 0.141, 0.143, & - & 0.145, 0.147, 0.149, 0.151, 0.153, 0.155, 0.157, 0.159, 0.161, & - & 0.163, 0.165, 0.167, 0.169, 0.171, 0.173, 0.175, 0.177, 0.179, & - & 0.181, 0.183, 0.185, 0.187, 0.189, 0.191, 0.193, 0.195, 0.197, & - & 0.199, 0.201, 0.203, 0.205, 0.207, 0.209, 0.211, 0.213, 0.215, & - & 0.217, 0.219, 0.221, 0.223, 0.224, 0.226, 0.228, 0.230, 0.232, & - & 0.234, 0.236, 0.238, 0.240, 0.242, 0.243, 0.245, 0.247, 0.249, & - & 0.251, 0.253, 0.255, 0.257, 0.258, 0.260, 0.262, 0.264, 0.266, & - & 0.268, 0.270, 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.282, & - & 0.284, 0.286, 0.288, 0.290, 0.291, 0.293, 0.295, 0.297, 0.299, & - & 0.300, 0.302, 0.304, 0.306, 0.308, 0.309, 0.311, 0.313, 0.315, & - & 0.316, 0.318, 0.320, 0.322, 0.323, 0.325, 0.327, 0.329, 0.330, & - & 0.332, 0.334, 0.336, 0.337, 0.339, 0.341, 0.342, 0.344, 0.346, & - & 0.348, 0.349, 0.351, 0.353, 0.354, 0.356, 0.358, 0.359, 0.361, & - & 0.363, 0.364, 0.366, 0.368, 0.370, 0.371, 0.373, 0.374, 0.376, & - & 0.378, 0.379, 0.381, 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, & - & 0.393, 0.394, 0.396, 0.397, 0.399, 0.401, 0.402, 0.404, 0.406, & - & 0.407, 0.409, 0.410, 0.412, 0.414, 0.415, 0.417, 0.418, 0.420, & - & 0.421, 0.423, 0.425, 0.426, 0.428, 0.429, 0.431, 0.433, 0.434, & - & 0.436, 0.437, 0.439, 0.440, 0.442, 0.443, 0.445, 0.446, 0.448, & - & 0.450, 0.451, 0.453, 0.454, 0.456, 0.457, 0.459, 0.460, 0.462, & - & 0.463, 0.465, 0.466, 0.468, 0.469, 0.471, 0.472, 0.474, 0.475, & - & 0.477, 0.478, 0.480, 0.481, 0.483, 0.484, 0.486, 0.487, 0.489, & - & 0.490, 0.491, 0.493, 0.494, 0.510, 0.524, 0.538, 0.552, 0.566, & - & 0.579, 0.592, 0.605, 0.618, 0.630, 0.642, 0.655, 0.667, 0.678, & - & 0.690, 0.701, 0.713, 0.724, 0.735, 0.745, 0.756, 0.766, 0.777, & - & 0.787, 0.797, 0.807, 0.817, 0.826, 0.836, 0.845, 0.854, 0.864, & - & 0.873, 0.881, 0.890, 0.899, 0.907, 0.916, 0.924, 0.932, 0.940, & - & 0.948, 0.956, 0.964, 0.972, 0.979, 0.987, 0.994, 1.002, 1.009, & - & 1.016, 1.023, 1.030, 1.037, 1.044, 1.051, 1.057, 1.064, 1.070, & - & 1.077, 1.083, 1.089, 1.096, 1.102, 1.108, 1.114, 1.120, 1.126, & - & 1.132, 1.137, 1.143, 1.149, 1.154, 1.160, 1.165, 1.170, 1.176, & - & 1.181, 1.186, 1.191, 1.196, 1.201, 1.206, 1.211, 1.216, 1.221, & - & 1.226, 1.231, 1.235, 1.240, 1.244, 1.249, 1.253, 1.258, 1.262, & - & 1.267, 1.271, 1.275, 1.279, 1.284, 1.288, 1.292, 1.296, 1.300, & - & 1.304, 1.308, 1.312, 1.315, 1.319, 1.323, 1.327, 1.330, 1.334, & - & 1.338, 1.341, 1.345, 1.348, 1.352, 1.355, 1.358, 1.362, 1.365, & - & 1.368, 1.372, 1.375, 1.378, 1.381, 1.384, 1.388, 1.391, 1.394, & - & 1.397, 1.400, 1.403, 1.406, 1.409, 1.411, 1.414, 1.417, 1.420, & - & 1.423, 1.425, 1.428, 1.431, 1.433, 1.436, 1.439, 1.441, 1.444, & - & 1.446, 1.449, 1.451, 1.454, 1.456, 1.458, 1.461, 1.463, 1.466, & - & 1.468, 1.470, 1.472 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.098,-0.214,-0.272,-0.313,-0.346,-0.373,-0.396,-0.417,-0.435, & - -0.452,-0.467,-0.481,-0.494,-0.506,-0.518,-0.529,-0.539,-0.549, & - -0.558,-0.567,-0.575,-0.583,-0.591,-0.599,-0.606,-0.613,-0.620, & - -0.627,-0.633,-0.639,-0.645,-0.651,-0.657,-0.662,-0.668,-0.673, & - -0.678,-0.683,-0.688,-0.693,-0.698,-0.703,-0.707,-0.712,-0.716, & - -0.721,-0.725,-0.729,-0.733,-0.737,-0.741,-0.745,-0.749,-0.753, & - -0.756,-0.760,-0.764,-0.767,-0.771,-0.774,-0.778,-0.781,-0.784, & - -0.788,-0.791,-0.794,-0.797,-0.801,-0.804,-0.807,-0.810,-0.813, & - -0.816,-0.819,-0.822,-0.825,-0.827,-0.830,-0.833,-0.836,-0.839, & - -0.841,-0.844,-0.847,-0.850,-0.852,-0.855,-0.858,-0.860,-0.863, & - -0.865,-0.868,-0.871,-0.873,-0.876,-0.878,-0.881,-0.883,-0.885, & - -0.888,-0.890,-0.893,-0.895,-0.897,-0.900,-0.902,-0.905,-0.907, & - -0.909,-0.911,-0.914,-0.916,-0.918,-0.921,-0.923,-0.925,-0.927, & - -0.929,-0.932,-0.934,-0.936,-0.938,-0.940,-0.942,-0.945,-0.947, & - -0.949,-0.951,-0.953,-0.955,-0.957,-0.959,-0.961,-0.963,-0.965, & - -0.967,-0.969,-0.971,-0.973,-0.975,-0.977,-0.979,-0.981,-0.983, & - -0.985,-0.987,-0.989,-0.991,-0.993,-0.995,-0.997,-0.999,-1.001, & - -1.002,-1.004,-1.006,-1.008,-1.010,-1.012,-1.014,-1.015,-1.017, & - -1.019,-1.021,-1.023,-1.025,-1.026,-1.028,-1.030,-1.032,-1.033, & - -1.035,-1.037,-1.039,-1.040,-1.042,-1.044,-1.046,-1.047,-1.049, & - -1.051,-1.053,-1.054,-1.056,-1.058,-1.059,-1.061,-1.063,-1.064, & - -1.066,-1.068,-1.069,-1.071,-1.073,-1.074,-1.076,-1.078,-1.079, & - -1.081,-1.082,-1.084,-1.086,-1.087,-1.089,-1.090,-1.092,-1.094, & - -1.095,-1.097,-1.098,-1.100,-1.102,-1.103,-1.105,-1.106,-1.108, & - -1.109,-1.111,-1.112,-1.114,-1.116,-1.117,-1.119,-1.120,-1.122, & - -1.123,-1.125,-1.126,-1.128,-1.129,-1.131,-1.132,-1.134,-1.135, & - -1.137,-1.138,-1.140,-1.141,-1.143,-1.144,-1.146,-1.147,-1.148, & - -1.150,-1.151,-1.153,-1.154,-1.156,-1.157,-1.159,-1.160,-1.161, & - -1.163,-1.164,-1.166,-1.167,-1.169,-1.170,-1.171,-1.173,-1.174, & - -1.176,-1.177,-1.178,-1.180,-1.181,-1.183,-1.184,-1.185,-1.187, & - -1.188,-1.190,-1.191,-1.192,-1.194,-1.195,-1.196,-1.198,-1.199, & - -1.201,-1.202,-1.203,-1.205,-1.206,-1.207,-1.209,-1.210,-1.211, & - -1.213,-1.214,-1.215,-1.217,-1.218,-1.219,-1.221,-1.222,-1.223, & - -1.225,-1.226,-1.227,-1.229,-1.230,-1.231,-1.233,-1.234,-1.235, & - -1.236,-1.238,-1.239,-1.240,-1.242,-1.243,-1.244,-1.246,-1.247, & - -1.248,-1.249,-1.251,-1.252,-1.253,-1.255,-1.256,-1.257,-1.258, & - -1.260,-1.261,-1.262,-1.263,-1.265,-1.266,-1.267,-1.268,-1.270, & - -1.271,-1.272,-1.273,-1.275,-1.276,-1.277,-1.278,-1.280,-1.281, & - -1.282,-1.283,-1.285,-1.286,-1.287,-1.288,-1.290,-1.291,-1.292, & - -1.293,-1.294,-1.296,-1.297,-1.298,-1.299,-1.301,-1.302,-1.303, & - -1.304,-1.305,-1.307,-1.308,-1.309,-1.310,-1.311,-1.313,-1.314, & - -1.315,-1.316,-1.317,-1.319,-1.320,-1.321,-1.322,-1.323,-1.324, & - -1.326,-1.327,-1.328,-1.329,-1.330,-1.332,-1.333,-1.334,-1.335, & - -1.336,-1.337,-1.339,-1.340,-1.341,-1.342,-1.343,-1.344,-1.346, & - -1.347,-1.348,-1.349,-1.350,-1.363,-1.374,-1.385,-1.396,-1.407, & - -1.418,-1.429,-1.440,-1.451,-1.461,-1.472,-1.482,-1.492,-1.503, & - -1.513,-1.523,-1.533,-1.543,-1.553,-1.563,-1.573,-1.582,-1.592, & - -1.602,-1.611,-1.621,-1.630,-1.640,-1.649,-1.658,-1.668,-1.677, & - -1.686,-1.695,-1.704,-1.714,-1.723,-1.732,-1.741,-1.750,-1.758, & - -1.767,-1.776,-1.785,-1.794,-1.802,-1.811,-1.820,-1.828,-1.837, & - -1.846,-1.854,-1.863,-1.871,-1.880,-1.888,-1.897,-1.905,-1.913, & - -1.922,-1.930,-1.938,-1.947,-1.955,-1.963,-1.971,-1.979,-1.988, & - -1.996,-2.004,-2.012,-2.020,-2.028,-2.036,-2.044,-2.052,-2.060, & - -2.068,-2.076,-2.084,-2.092,-2.100,-2.108,-2.116,-2.124,-2.131, & - -2.139,-2.147,-2.155,-2.163,-2.170,-2.178,-2.186,-2.194,-2.201, & - -2.209,-2.217,-2.224,-2.232,-2.240,-2.247,-2.255,-2.262,-2.270, & - -2.278,-2.285,-2.293,-2.300,-2.308,-2.315,-2.323,-2.330,-2.338, & - -2.345,-2.353,-2.360,-2.368,-2.375,-2.382,-2.390,-2.397,-2.405, & - -2.412,-2.419,-2.427,-2.434,-2.441,-2.449,-2.456,-2.463,-2.471, & - -2.478,-2.485,-2.492,-2.500,-2.507,-2.514,-2.521,-2.529,-2.536, & - -2.543,-2.550,-2.557,-2.565,-2.572,-2.579,-2.586,-2.593,-2.600, & - -2.608,-2.615,-2.622,-2.629,-2.636,-2.643,-2.650,-2.657,-2.664, & - -2.671,-2.679,-2.686 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.049,-0.108,-0.137,-0.159,-0.175,-0.190,-0.202,-0.212,-0.222, & - -0.231,-0.239,-0.247,-0.254,-0.260,-0.266,-0.272,-0.278,-0.283, & - -0.288,-0.293,-0.298,-0.302,-0.306,-0.311,-0.315,-0.319,-0.322, & - -0.326,-0.330,-0.333,-0.337,-0.340,-0.343,-0.346,-0.349,-0.352, & - -0.355,-0.358,-0.361,-0.364,-0.367,-0.369,-0.372,-0.374,-0.377, & - -0.379,-0.382,-0.384,-0.387,-0.389,-0.391,-0.394,-0.396,-0.398, & - -0.400,-0.402,-0.404,-0.406,-0.408,-0.410,-0.412,-0.414,-0.416, & - -0.418,-0.420,-0.422,-0.424,-0.426,-0.428,-0.429,-0.431,-0.433, & - -0.435,-0.436,-0.438,-0.440,-0.442,-0.443,-0.445,-0.447,-0.448, & - -0.450,-0.452,-0.453,-0.455,-0.456,-0.458,-0.459,-0.461,-0.463, & - -0.464,-0.466,-0.467,-0.469,-0.470,-0.472,-0.473,-0.475,-0.476, & - -0.478,-0.479,-0.481,-0.482,-0.483,-0.485,-0.486,-0.488,-0.489, & - -0.491,-0.492,-0.493,-0.495,-0.496,-0.498,-0.499,-0.500,-0.502, & - -0.503,-0.504,-0.506,-0.507,-0.508,-0.510,-0.511,-0.512,-0.514, & - -0.515,-0.516,-0.518,-0.519,-0.520,-0.521,-0.523,-0.524,-0.525, & - -0.526,-0.528,-0.529,-0.530,-0.531,-0.533,-0.534,-0.535,-0.536, & - -0.537,-0.539,-0.540,-0.541,-0.542,-0.543,-0.545,-0.546,-0.547, & - -0.548,-0.549,-0.550,-0.552,-0.553,-0.554,-0.555,-0.556,-0.557, & - -0.558,-0.559,-0.561,-0.562,-0.563,-0.564,-0.565,-0.566,-0.567, & - -0.568,-0.569,-0.570,-0.572,-0.573,-0.574,-0.575,-0.576,-0.577, & - -0.578,-0.579,-0.580,-0.581,-0.582,-0.583,-0.584,-0.585,-0.586, & - -0.587,-0.588,-0.589,-0.590,-0.592,-0.593,-0.594,-0.595,-0.596, & - -0.597,-0.598,-0.599,-0.600,-0.601,-0.602,-0.603,-0.604,-0.605, & - -0.606,-0.607,-0.607,-0.608,-0.609,-0.610,-0.611,-0.612,-0.613, & - -0.614,-0.615,-0.616,-0.617,-0.618,-0.619,-0.620,-0.621,-0.622, & - -0.623,-0.624,-0.625,-0.626,-0.627,-0.627,-0.628,-0.629,-0.630, & - -0.631,-0.632,-0.633,-0.634,-0.635,-0.636,-0.637,-0.638,-0.638, & - -0.639,-0.640,-0.641,-0.642,-0.643,-0.644,-0.645,-0.646,-0.646, & - -0.647,-0.648,-0.649,-0.650,-0.651,-0.652,-0.653,-0.654,-0.654, & - -0.655,-0.656,-0.657,-0.658,-0.659,-0.660,-0.660,-0.661,-0.662, & - -0.663,-0.664,-0.665,-0.666,-0.666,-0.667,-0.668,-0.669,-0.670, & - -0.671,-0.671,-0.672,-0.673,-0.674,-0.675,-0.676,-0.676,-0.677, & - -0.678,-0.679,-0.680,-0.681,-0.681,-0.682,-0.683,-0.684,-0.685, & - -0.685,-0.686,-0.687,-0.688,-0.689,-0.689,-0.690,-0.691,-0.692, & - -0.693,-0.693,-0.694,-0.695,-0.696,-0.697,-0.697,-0.698,-0.699, & - -0.700,-0.701,-0.701,-0.702,-0.703,-0.704,-0.704,-0.705,-0.706, & - -0.707,-0.708,-0.708,-0.709,-0.710,-0.711,-0.711,-0.712,-0.713, & - -0.714,-0.714,-0.715,-0.716,-0.717,-0.718,-0.718,-0.719,-0.720, & - -0.721,-0.721,-0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727, & - -0.727,-0.728,-0.729,-0.729,-0.730,-0.731,-0.732,-0.732,-0.733, & - -0.734,-0.735,-0.735,-0.736,-0.737,-0.738,-0.738,-0.739,-0.740, & - -0.740,-0.741,-0.742,-0.743,-0.743,-0.744,-0.745,-0.746,-0.746, & - -0.747,-0.748,-0.748,-0.749,-0.750,-0.751,-0.751,-0.752,-0.753, & - -0.753,-0.754,-0.755,-0.756,-0.756,-0.757,-0.758,-0.758,-0.759, & - -0.760,-0.760,-0.761,-0.762,-0.769,-0.776,-0.783,-0.790,-0.796, & - -0.803,-0.809,-0.816,-0.822,-0.828,-0.835,-0.841,-0.847,-0.853, & - -0.859,-0.865,-0.871,-0.877,-0.883,-0.888,-0.894,-0.900,-0.905, & - -0.911,-0.917,-0.922,-0.928,-0.933,-0.939,-0.944,-0.949,-0.955, & - -0.960,-0.965,-0.971,-0.976,-0.981,-0.986,-0.991,-0.997,-1.002, & - -1.007,-1.012,-1.017,-1.022,-1.027,-1.032,-1.037,-1.042,-1.046, & - -1.051,-1.056,-1.061,-1.066,-1.071,-1.075,-1.080,-1.085,-1.089, & - -1.094,-1.099,-1.104,-1.108,-1.113,-1.117,-1.122,-1.127,-1.131, & - -1.136,-1.140,-1.145,-1.149,-1.154,-1.158,-1.163,-1.167,-1.172, & - -1.176,-1.180,-1.185,-1.189,-1.194,-1.198,-1.202,-1.207,-1.211, & - -1.215,-1.220,-1.224,-1.228,-1.232,-1.237,-1.241,-1.245,-1.249, & - -1.254,-1.258,-1.262,-1.266,-1.270,-1.275,-1.279,-1.283,-1.287, & - -1.291,-1.295,-1.299,-1.304,-1.308,-1.312,-1.316,-1.320,-1.324, & - -1.328,-1.332,-1.336,-1.340,-1.344,-1.348,-1.352,-1.356,-1.360, & - -1.364,-1.368,-1.372,-1.376,-1.380,-1.384,-1.388,-1.392,-1.396, & - -1.400,-1.404,-1.408,-1.412,-1.415,-1.419,-1.423,-1.427,-1.431, & - -1.435,-1.439,-1.443,-1.446,-1.450,-1.454,-1.458,-1.462,-1.466, & - -1.469,-1.473,-1.477,-1.481,-1.485,-1.488,-1.492,-1.496,-1.500, & - -1.504,-1.507,-1.511 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.098,-0.214,-0.273,-0.315,-0.347,-0.375,-0.399,-0.419,-0.438, & - -0.455,-0.470,-0.485,-0.498,-0.511,-0.522,-0.533,-0.544,-0.554, & - -0.563,-0.572,-0.581,-0.590,-0.598,-0.605,-0.613,-0.620,-0.627, & - -0.634,-0.641,-0.647,-0.653,-0.660,-0.666,-0.671,-0.677,-0.683, & - -0.688,-0.693,-0.698,-0.703,-0.708,-0.713,-0.718,-0.723,-0.727, & - -0.732,-0.736,-0.741,-0.745,-0.749,-0.753,-0.757,-0.762,-0.765, & - -0.769,-0.773,-0.777,-0.781,-0.784,-0.788,-0.792,-0.795,-0.799, & - -0.802,-0.806,-0.809,-0.812,-0.816,-0.819,-0.822,-0.825,-0.829, & - -0.832,-0.835,-0.838,-0.841,-0.844,-0.847,-0.850,-0.853,-0.856, & - -0.859,-0.862,-0.865,-0.867,-0.870,-0.873,-0.876,-0.879,-0.881, & - -0.884,-0.887,-0.890,-0.892,-0.895,-0.898,-0.900,-0.903,-0.905, & - -0.908,-0.911,-0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928, & - -0.931,-0.933,-0.936,-0.938,-0.940,-0.943,-0.945,-0.948,-0.950, & - -0.952,-0.955,-0.957,-0.959,-0.962,-0.964,-0.966,-0.969,-0.971, & - -0.973,-0.975,-0.978,-0.980,-0.982,-0.984,-0.986,-0.989,-0.991, & - -0.993,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006,-1.008,-1.010, & - -1.012,-1.014,-1.016,-1.018,-1.020,-1.022,-1.024,-1.026,-1.028, & - -1.030,-1.032,-1.034,-1.036,-1.038,-1.040,-1.042,-1.044,-1.046, & - -1.048,-1.050,-1.052,-1.054,-1.056,-1.058,-1.060,-1.062,-1.064, & - -1.066,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079,-1.080, & - -1.082,-1.084,-1.086,-1.088,-1.090,-1.091,-1.093,-1.095,-1.097, & - -1.099,-1.100,-1.102,-1.104,-1.106,-1.107,-1.109,-1.111,-1.113, & - -1.114,-1.116,-1.118,-1.120,-1.121,-1.123,-1.125,-1.127,-1.128, & - -1.130,-1.132,-1.133,-1.135,-1.137,-1.138,-1.140,-1.142,-1.143, & - -1.145,-1.147,-1.148,-1.150,-1.152,-1.153,-1.155,-1.157,-1.158, & - -1.160,-1.162,-1.163,-1.165,-1.166,-1.168,-1.170,-1.171,-1.173, & - -1.174,-1.176,-1.178,-1.179,-1.181,-1.182,-1.184,-1.185,-1.187, & - -1.189,-1.190,-1.192,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201, & - -1.203,-1.204,-1.206,-1.207,-1.209,-1.210,-1.212,-1.213,-1.215, & - -1.216,-1.218,-1.219,-1.221,-1.222,-1.224,-1.225,-1.227,-1.228, & - -1.230,-1.231,-1.233,-1.234,-1.236,-1.237,-1.238,-1.240,-1.241, & - -1.243,-1.244,-1.246,-1.247,-1.249,-1.250,-1.252,-1.253,-1.254, & - -1.256,-1.257,-1.259,-1.260,-1.262,-1.263,-1.264,-1.266,-1.267, & - -1.269,-1.270,-1.271,-1.273,-1.274,-1.276,-1.277,-1.278,-1.280, & - -1.281,-1.283,-1.284,-1.285,-1.287,-1.288,-1.290,-1.291,-1.292, & - -1.294,-1.295,-1.296,-1.298,-1.299,-1.301,-1.302,-1.303,-1.305, & - -1.306,-1.307,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.317, & - -1.318,-1.319,-1.321,-1.322,-1.323,-1.325,-1.326,-1.327,-1.329, & - -1.330,-1.331,-1.333,-1.334,-1.335,-1.337,-1.338,-1.339,-1.341, & - -1.342,-1.343,-1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352, & - -1.354,-1.355,-1.356,-1.357,-1.359,-1.360,-1.361,-1.363,-1.364, & - -1.365,-1.366,-1.368,-1.369,-1.370,-1.371,-1.373,-1.374,-1.375, & - -1.376,-1.378,-1.379,-1.380,-1.381,-1.383,-1.384,-1.385,-1.387, & - -1.388,-1.389,-1.390,-1.391,-1.393,-1.394,-1.395,-1.396,-1.398, & - -1.399,-1.400,-1.401,-1.403,-1.416,-1.428,-1.440,-1.452,-1.463, & - -1.475,-1.487,-1.498,-1.509,-1.520,-1.532,-1.543,-1.554,-1.564, & - -1.575,-1.586,-1.596,-1.607,-1.617,-1.628,-1.638,-1.648,-1.659, & - -1.669,-1.679,-1.689,-1.699,-1.709,-1.719,-1.729,-1.738,-1.748, & - -1.758,-1.767,-1.777,-1.786,-1.796,-1.805,-1.815,-1.824,-1.833, & - -1.843,-1.852,-1.861,-1.870,-1.879,-1.888,-1.897,-1.906,-1.915, & - -1.924,-1.933,-1.942,-1.951,-1.960,-1.969,-1.977,-1.986,-1.995, & - -2.004,-2.012,-2.021,-2.029,-2.038,-2.047,-2.055,-2.064,-2.072, & - -2.081,-2.089,-2.097,-2.106,-2.114,-2.123,-2.131,-2.139,-2.147, & - -2.156,-2.164,-2.172,-2.180,-2.189,-2.197,-2.205,-2.213,-2.221, & - -2.229,-2.237,-2.245,-2.253,-2.261,-2.269,-2.277,-2.285,-2.293, & - -2.301,-2.309,-2.317,-2.325,-2.333,-2.341,-2.349,-2.356,-2.364, & - -2.372,-2.380,-2.388,-2.395,-2.403,-2.411,-2.419,-2.426,-2.434, & - -2.442,-2.449,-2.457,-2.465,-2.472,-2.480,-2.488,-2.495,-2.503, & - -2.510,-2.518,-2.525,-2.533,-2.541,-2.548,-2.556,-2.563,-2.571, & - -2.578,-2.586,-2.593,-2.600,-2.608,-2.615,-2.623,-2.630,-2.638, & - -2.645,-2.652,-2.660,-2.667,-2.674,-2.682,-2.689,-2.696,-2.704, & - -2.711,-2.718,-2.726,-2.733,-2.740,-2.747,-2.755,-2.762,-2.769, & - -2.776,-2.784,-2.791 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.050,-0.111,-0.143,-0.166,-0.185,-0.202,-0.216,-0.229,-0.240, & - -0.251,-0.261,-0.271,-0.279,-0.288,-0.296,-0.304,-0.311,-0.318, & - -0.325,-0.331,-0.338,-0.344,-0.350,-0.356,-0.361,-0.367,-0.372, & - -0.378,-0.383,-0.388,-0.393,-0.398,-0.402,-0.407,-0.412,-0.416, & - -0.420,-0.425,-0.429,-0.433,-0.437,-0.441,-0.445,-0.449,-0.453, & - -0.457,-0.460,-0.464,-0.468,-0.471,-0.475,-0.478,-0.482,-0.485, & - -0.488,-0.491,-0.495,-0.498,-0.501,-0.504,-0.507,-0.510,-0.513, & - -0.516,-0.519,-0.522,-0.525,-0.528,-0.531,-0.534,-0.537,-0.539, & - -0.542,-0.545,-0.548,-0.550,-0.553,-0.556,-0.558,-0.561,-0.564, & - -0.566,-0.569,-0.572,-0.574,-0.577,-0.579,-0.582,-0.584,-0.587, & - -0.589,-0.592,-0.594,-0.597,-0.599,-0.602,-0.604,-0.607,-0.609, & - -0.612,-0.614,-0.617,-0.619,-0.621,-0.624,-0.626,-0.629,-0.631, & - -0.633,-0.636,-0.638,-0.640,-0.643,-0.645,-0.647,-0.650,-0.652, & - -0.654,-0.656,-0.659,-0.661,-0.663,-0.665,-0.668,-0.670,-0.672, & - -0.674,-0.677,-0.679,-0.681,-0.683,-0.685,-0.687,-0.690,-0.692, & - -0.694,-0.696,-0.698,-0.700,-0.702,-0.704,-0.706,-0.709,-0.711, & - -0.713,-0.715,-0.717,-0.719,-0.721,-0.723,-0.725,-0.727,-0.729, & - -0.731,-0.733,-0.735,-0.737,-0.739,-0.741,-0.742,-0.744,-0.746, & - -0.748,-0.750,-0.752,-0.754,-0.756,-0.758,-0.760,-0.761,-0.763, & - -0.765,-0.767,-0.769,-0.771,-0.772,-0.774,-0.776,-0.778,-0.780, & - -0.782,-0.783,-0.785,-0.787,-0.789,-0.790,-0.792,-0.794,-0.796, & - -0.797,-0.799,-0.801,-0.803,-0.804,-0.806,-0.808,-0.809,-0.811, & - -0.813,-0.814,-0.816,-0.818,-0.820,-0.821,-0.823,-0.824,-0.826, & - -0.828,-0.829,-0.831,-0.833,-0.834,-0.836,-0.838,-0.839,-0.841, & - -0.842,-0.844,-0.846,-0.847,-0.849,-0.850,-0.852,-0.853,-0.855, & - -0.857,-0.858,-0.860,-0.861,-0.863,-0.864,-0.866,-0.867,-0.869, & - -0.870,-0.872,-0.873,-0.875,-0.876,-0.878,-0.879,-0.881,-0.882, & - -0.884,-0.885,-0.887,-0.888,-0.890,-0.891,-0.893,-0.894,-0.896, & - -0.897,-0.898,-0.900,-0.901,-0.903,-0.904,-0.906,-0.907,-0.908, & - -0.910,-0.911,-0.913,-0.914,-0.915,-0.917,-0.918,-0.920,-0.921, & - -0.922,-0.924,-0.925,-0.926,-0.928,-0.929,-0.931,-0.932,-0.933, & - -0.935,-0.936,-0.937,-0.939,-0.940,-0.941,-0.943,-0.944,-0.945, & - -0.947,-0.948,-0.949,-0.951,-0.952,-0.953,-0.954,-0.956,-0.957, & - -0.958,-0.960,-0.961,-0.962,-0.963,-0.965,-0.966,-0.967,-0.969, & - -0.970,-0.971,-0.972,-0.974,-0.975,-0.976,-0.977,-0.979,-0.980, & - -0.981,-0.982,-0.984,-0.985,-0.986,-0.987,-0.988,-0.990,-0.991, & - -0.992,-0.993,-0.995,-0.996,-0.997,-0.998,-0.999,-1.001,-1.002, & - -1.003,-1.004,-1.005,-1.007,-1.008,-1.009,-1.010,-1.011,-1.012, & - -1.014,-1.015,-1.016,-1.017,-1.018,-1.019,-1.021,-1.022,-1.023, & - -1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.033, & - -1.034,-1.035,-1.037,-1.038,-1.039,-1.040,-1.041,-1.042,-1.043, & - -1.044,-1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053, & - -1.054,-1.055,-1.056,-1.058,-1.059,-1.060,-1.061,-1.062,-1.063, & - -1.064,-1.065,-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.072, & - -1.074,-1.075,-1.076,-1.077,-1.088,-1.098,-1.108,-1.118,-1.128, & - -1.137,-1.147,-1.156,-1.165,-1.174,-1.183,-1.192,-1.200,-1.209, & - -1.217,-1.225,-1.233,-1.241,-1.249,-1.257,-1.265,-1.273,-1.280, & - -1.288,-1.295,-1.303,-1.310,-1.317,-1.324,-1.331,-1.338,-1.345, & - -1.352,-1.359,-1.365,-1.372,-1.379,-1.385,-1.392,-1.398,-1.404, & - -1.411,-1.417,-1.423,-1.429,-1.435,-1.441,-1.447,-1.453,-1.459, & - -1.465,-1.471,-1.477,-1.483,-1.488,-1.494,-1.500,-1.505,-1.511, & - -1.516,-1.522,-1.527,-1.533,-1.538,-1.544,-1.549,-1.554,-1.560, & - -1.565,-1.570,-1.575,-1.580,-1.586,-1.591,-1.596,-1.601,-1.606, & - -1.611,-1.616,-1.621,-1.626,-1.631,-1.635,-1.640,-1.645,-1.650, & - -1.655,-1.660,-1.664,-1.669,-1.674,-1.679,-1.683,-1.688,-1.693, & - -1.697,-1.702,-1.706,-1.711,-1.716,-1.720,-1.725,-1.729,-1.734, & - -1.738,-1.743,-1.747,-1.751,-1.756,-1.760,-1.765,-1.769,-1.773, & - -1.778,-1.782,-1.786,-1.791,-1.795,-1.799,-1.803,-1.808,-1.812, & - -1.816,-1.820,-1.825,-1.829,-1.833,-1.837,-1.841,-1.845,-1.850, & - -1.854,-1.858,-1.862,-1.866,-1.870,-1.874,-1.878,-1.882,-1.886, & - -1.890,-1.894,-1.898,-1.902,-1.906,-1.910,-1.914,-1.918,-1.922, & - -1.926,-1.930,-1.934,-1.938,-1.942,-1.946,-1.950,-1.954,-1.958, & - -1.961,-1.965,-1.969 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.048,-0.103,-0.130,-0.148,-0.161,-0.173,-0.182,-0.190,-0.197, & - -0.203,-0.208,-0.213,-0.217,-0.221,-0.225,-0.228,-0.231,-0.234, & - -0.237,-0.239,-0.241,-0.243,-0.245,-0.247,-0.249,-0.251,-0.252, & - -0.254,-0.255,-0.256,-0.257,-0.259,-0.260,-0.261,-0.262,-0.263, & - -0.263,-0.264,-0.265,-0.266,-0.267,-0.267,-0.268,-0.269,-0.269, & - -0.270,-0.270,-0.271,-0.272,-0.272,-0.273,-0.273,-0.273,-0.274, & - -0.274,-0.275,-0.275,-0.275,-0.276,-0.276,-0.277,-0.277,-0.277, & - -0.277,-0.278,-0.278,-0.278,-0.279,-0.279,-0.279,-0.279,-0.279, & - -0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.281,-0.281, & - -0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, & - -0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281,-0.281, & - -0.281,-0.281,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280,-0.280, & - -0.279,-0.279,-0.279,-0.279,-0.279,-0.279,-0.278,-0.278,-0.278, & - -0.278,-0.278,-0.277,-0.277,-0.277,-0.277,-0.277,-0.276,-0.276, & - -0.276,-0.276,-0.275,-0.275,-0.275,-0.275,-0.274,-0.274,-0.274, & - -0.274,-0.273,-0.273,-0.273,-0.273,-0.272,-0.272,-0.272,-0.272, & - -0.271,-0.271,-0.271,-0.271,-0.270,-0.270,-0.270,-0.270,-0.269, & - -0.269,-0.269,-0.269,-0.268,-0.268,-0.268,-0.267,-0.267,-0.267, & - -0.267,-0.266,-0.266,-0.266,-0.266,-0.265,-0.265,-0.265,-0.264, & - -0.264,-0.264,-0.264,-0.263,-0.263,-0.263,-0.263,-0.262,-0.262, & - -0.262,-0.261,-0.261,-0.261,-0.261,-0.260,-0.260,-0.260,-0.259, & - -0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.258,-0.257,-0.257, & - -0.257,-0.256,-0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.255, & - -0.254,-0.254,-0.254,-0.253,-0.253,-0.253,-0.253,-0.252,-0.252, & - -0.252,-0.252,-0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250, & - -0.249,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247,-0.247, & - -0.247,-0.247,-0.246,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245, & - -0.245,-0.244,-0.244,-0.244,-0.244,-0.243,-0.243,-0.243,-0.243, & - -0.242,-0.242,-0.242,-0.241,-0.241,-0.241,-0.241,-0.240,-0.240, & - -0.240,-0.240,-0.239,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238, & - -0.238,-0.237,-0.237,-0.237,-0.237,-0.236,-0.236,-0.236,-0.236, & - -0.236,-0.235,-0.235,-0.235,-0.235,-0.234,-0.234,-0.234,-0.234, & - -0.233,-0.233,-0.233,-0.233,-0.232,-0.232,-0.232,-0.232,-0.231, & - -0.231,-0.231,-0.231,-0.231,-0.230,-0.230,-0.230,-0.230,-0.229, & - -0.229,-0.229,-0.229,-0.228,-0.228,-0.228,-0.228,-0.228,-0.227, & - -0.227,-0.227,-0.227,-0.226,-0.226,-0.226,-0.226,-0.226,-0.225, & - -0.225,-0.225,-0.225,-0.224,-0.224,-0.224,-0.224,-0.224,-0.223, & - -0.223,-0.223,-0.223,-0.223,-0.222,-0.222,-0.222,-0.222,-0.221, & - -0.221,-0.221,-0.221,-0.221,-0.220,-0.220,-0.220,-0.220,-0.220, & - -0.219,-0.219,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218,-0.218, & - -0.218,-0.217,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216,-0.216, & - -0.216,-0.216,-0.215,-0.215,-0.215,-0.215,-0.215,-0.215,-0.214, & - -0.214,-0.214,-0.214,-0.214,-0.213,-0.213,-0.213,-0.213,-0.213, & - -0.212,-0.212,-0.212,-0.212,-0.212,-0.212,-0.211,-0.211,-0.211, & - -0.211,-0.211,-0.210,-0.210,-0.208,-0.207,-0.205,-0.203,-0.202, & - -0.200,-0.199,-0.198,-0.196,-0.195,-0.194,-0.192,-0.191,-0.190, & - -0.189,-0.188,-0.187,-0.186,-0.185,-0.184,-0.183,-0.182,-0.182, & - -0.181,-0.180,-0.179,-0.179,-0.178,-0.178,-0.177,-0.176,-0.176, & - -0.176,-0.175,-0.175,-0.174,-0.174,-0.174,-0.173,-0.173,-0.173, & - -0.173,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172, & - -0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.172,-0.173, & - -0.173,-0.173,-0.173,-0.173,-0.174,-0.174,-0.174,-0.175,-0.175, & - -0.175,-0.176,-0.176,-0.176,-0.177,-0.177,-0.178,-0.178,-0.179, & - -0.179,-0.180,-0.180,-0.181,-0.181,-0.182,-0.183,-0.183,-0.184, & - -0.184,-0.185,-0.186,-0.186,-0.187,-0.188,-0.188,-0.189,-0.190, & - -0.191,-0.191,-0.192,-0.193,-0.194,-0.194,-0.195,-0.196,-0.197, & - -0.198,-0.199,-0.200,-0.200,-0.201,-0.202,-0.203,-0.204,-0.205, & - -0.206,-0.207,-0.208,-0.209,-0.210,-0.211,-0.212,-0.213,-0.214, & - -0.215,-0.216,-0.217,-0.218,-0.219,-0.220,-0.221,-0.222,-0.223, & - -0.224,-0.226,-0.227,-0.228,-0.229,-0.230,-0.231,-0.232,-0.234, & - -0.235,-0.236,-0.237,-0.238,-0.239,-0.241,-0.242,-0.243,-0.244, & - -0.246,-0.247,-0.248,-0.249,-0.251,-0.252,-0.253,-0.254,-0.256, & - -0.257,-0.258,-0.260 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.098,-0.213,-0.271,-0.312,-0.344,-0.370,-0.393,-0.413,-0.431, & - -0.448,-0.462,-0.476,-0.489,-0.500,-0.511,-0.522,-0.532,-0.541, & - -0.550,-0.558,-0.567,-0.574,-0.582,-0.589,-0.596,-0.603,-0.609, & - -0.615,-0.621,-0.627,-0.633,-0.638,-0.644,-0.649,-0.654,-0.659, & - -0.664,-0.669,-0.674,-0.678,-0.683,-0.687,-0.691,-0.695,-0.700, & - -0.704,-0.708,-0.711,-0.715,-0.719,-0.723,-0.726,-0.730,-0.733, & - -0.737,-0.740,-0.744,-0.747,-0.750,-0.753,-0.757,-0.760,-0.763, & - -0.766,-0.769,-0.772,-0.775,-0.778,-0.781,-0.784,-0.786,-0.789, & - -0.792,-0.795,-0.797,-0.800,-0.803,-0.805,-0.808,-0.811,-0.813, & - -0.816,-0.818,-0.821,-0.823,-0.825,-0.828,-0.830,-0.833,-0.835, & - -0.837,-0.840,-0.842,-0.844,-0.847,-0.849,-0.851,-0.853,-0.856, & - -0.858,-0.860,-0.862,-0.864,-0.867,-0.869,-0.871,-0.873,-0.875, & - -0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.889,-0.891,-0.893, & - -0.895,-0.897,-0.899,-0.901,-0.903,-0.905,-0.907,-0.909,-0.911, & - -0.913,-0.915,-0.916,-0.918,-0.920,-0.922,-0.924,-0.926,-0.928, & - -0.929,-0.931,-0.933,-0.935,-0.936,-0.938,-0.940,-0.942,-0.944, & - -0.945,-0.947,-0.949,-0.950,-0.952,-0.954,-0.956,-0.957,-0.959, & - -0.961,-0.962,-0.964,-0.966,-0.967,-0.969,-0.971,-0.972,-0.974, & - -0.975,-0.977,-0.979,-0.980,-0.982,-0.983,-0.985,-0.987,-0.988, & - -0.990,-0.991,-0.993,-0.994,-0.996,-0.998,-0.999,-1.001,-1.002, & - -1.004,-1.005,-1.007,-1.008,-1.010,-1.011,-1.013,-1.014,-1.016, & - -1.017,-1.019,-1.020,-1.022,-1.023,-1.024,-1.026,-1.027,-1.029, & - -1.030,-1.032,-1.033,-1.035,-1.036,-1.037,-1.039,-1.040,-1.042, & - -1.043,-1.045,-1.046,-1.047,-1.049,-1.050,-1.052,-1.053,-1.054, & - -1.056,-1.057,-1.058,-1.060,-1.061,-1.063,-1.064,-1.065,-1.067, & - -1.068,-1.069,-1.071,-1.072,-1.073,-1.075,-1.076,-1.077,-1.079, & - -1.080,-1.081,-1.083,-1.084,-1.085,-1.087,-1.088,-1.089,-1.090, & - -1.092,-1.093,-1.094,-1.096,-1.097,-1.098,-1.100,-1.101,-1.102, & - -1.103,-1.105,-1.106,-1.107,-1.108,-1.110,-1.111,-1.112,-1.113, & - -1.115,-1.116,-1.117,-1.118,-1.120,-1.121,-1.122,-1.123,-1.125, & - -1.126,-1.127,-1.128,-1.130,-1.131,-1.132,-1.133,-1.134,-1.136, & - -1.137,-1.138,-1.139,-1.141,-1.142,-1.143,-1.144,-1.145,-1.147, & - -1.148,-1.149,-1.150,-1.151,-1.153,-1.154,-1.155,-1.156,-1.157, & - -1.158,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165,-1.167,-1.168, & - -1.169,-1.170,-1.171,-1.172,-1.174,-1.175,-1.176,-1.177,-1.178, & - -1.179,-1.181,-1.182,-1.183,-1.184,-1.185,-1.186,-1.187,-1.189, & - -1.190,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196,-1.198,-1.199, & - -1.200,-1.201,-1.202,-1.203,-1.204,-1.205,-1.207,-1.208,-1.209, & - -1.210,-1.211,-1.212,-1.213,-1.214,-1.215,-1.216,-1.218,-1.219, & - -1.220,-1.221,-1.222,-1.223,-1.224,-1.225,-1.226,-1.227,-1.228, & - -1.230,-1.231,-1.232,-1.233,-1.234,-1.235,-1.236,-1.237,-1.238, & - -1.239,-1.240,-1.241,-1.242,-1.244,-1.245,-1.246,-1.247,-1.248, & - -1.249,-1.250,-1.251,-1.252,-1.253,-1.254,-1.255,-1.256,-1.257, & - -1.258,-1.259,-1.261,-1.262,-1.263,-1.264,-1.265,-1.266,-1.267, & - -1.268,-1.269,-1.270,-1.271,-1.282,-1.292,-1.303,-1.313,-1.323, & - -1.332,-1.342,-1.352,-1.362,-1.371,-1.381,-1.390,-1.400,-1.409, & - -1.418,-1.427,-1.437,-1.446,-1.455,-1.464,-1.473,-1.482,-1.491, & - -1.499,-1.508,-1.517,-1.526,-1.534,-1.543,-1.552,-1.560,-1.569, & - -1.577,-1.586,-1.594,-1.602,-1.611,-1.619,-1.627,-1.636,-1.644, & - -1.652,-1.660,-1.668,-1.677,-1.685,-1.693,-1.701,-1.709,-1.717, & - -1.725,-1.733,-1.741,-1.749,-1.757,-1.764,-1.772,-1.780,-1.788, & - -1.796,-1.804,-1.811,-1.819,-1.827,-1.835,-1.842,-1.850,-1.858, & - -1.865,-1.873,-1.880,-1.888,-1.896,-1.903,-1.911,-1.918,-1.926, & - -1.933,-1.941,-1.948,-1.956,-1.963,-1.971,-1.978,-1.986,-1.993, & - -2.000,-2.008,-2.015,-2.022,-2.030,-2.037,-2.044,-2.052,-2.059, & - -2.066,-2.074,-2.081,-2.088,-2.095,-2.103,-2.110,-2.117,-2.124, & - -2.131,-2.139,-2.146,-2.153,-2.160,-2.167,-2.174,-2.181,-2.189, & - -2.196,-2.203,-2.210,-2.217,-2.224,-2.231,-2.238,-2.245,-2.252, & - -2.259,-2.266,-2.273,-2.280,-2.287,-2.294,-2.301,-2.308,-2.315, & - -2.322,-2.329,-2.336,-2.343,-2.350,-2.357,-2.364,-2.371,-2.378, & - -2.385,-2.391,-2.398,-2.405,-2.412,-2.419,-2.426,-2.433,-2.439, & - -2.446,-2.453,-2.460,-2.467,-2.474,-2.480,-2.487,-2.494,-2.501, & - -2.508,-2.514,-2.521 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.046,-0.090,-0.108,-0.118,-0.124,-0.128,-0.130,-0.132,-0.132, & - -0.131,-0.130,-0.128,-0.125,-0.122,-0.119,-0.116,-0.112,-0.108, & - -0.103,-0.098,-0.093,-0.088,-0.083,-0.077,-0.071,-0.065,-0.059, & - -0.053,-0.046,-0.040,-0.033,-0.026,-0.019,-0.012,-0.004, 0.003, & - & 0.011, 0.018, 0.026, 0.034, 0.042, 0.050, 0.058, 0.066, 0.075, & - & 0.083, 0.091, 0.100, 0.109, 0.117, 0.126, 0.135, 0.144, 0.153, & - & 0.162, 0.171, 0.180, 0.189, 0.198, 0.207, 0.216, 0.226, 0.235, & - & 0.244, 0.254, 0.263, 0.273, 0.282, 0.292, 0.302, 0.311, 0.321, & - & 0.331, 0.341, 0.351, 0.361, 0.371, 0.381, 0.391, 0.401, 0.411, & - & 0.421, 0.432, 0.442, 0.452, 0.463, 0.473, 0.484, 0.495, 0.505, & - & 0.516, 0.527, 0.538, 0.549, 0.560, 0.571, 0.582, 0.593, 0.604, & - & 0.615, 0.626, 0.638, 0.649, 0.660, 0.672, 0.683, 0.694, 0.706, & - & 0.717, 0.729, 0.740, 0.752, 0.763, 0.775, 0.787, 0.798, 0.810, & - & 0.821, 0.833, 0.845, 0.856, 0.868, 0.879, 0.891, 0.903, 0.914, & - & 0.926, 0.937, 0.949, 0.961, 0.972, 0.984, 0.995, 1.007, 1.018, & - & 1.030, 1.041, 1.053, 1.064, 1.076, 1.087, 1.099, 1.110, 1.121, & - & 1.133, 1.144, 1.155, 1.167, 1.178, 1.189, 1.200, 1.212, 1.223, & - & 1.234, 1.245, 1.256, 1.267, 1.278, 1.289, 1.300, 1.311, 1.322, & - & 1.333, 1.344, 1.355, 1.366, 1.377, 1.388, 1.399, 1.409, 1.420, & - & 1.431, 1.442, 1.452, 1.463, 1.474, 1.485, 1.495, 1.506, 1.516, & - & 1.527, 1.537, 1.548, 1.558, 1.569, 1.579, 1.590, 1.600, 1.611, & - & 1.621, 1.631, 1.642, 1.652, 1.662, 1.672, 1.683, 1.693, 1.703, & - & 1.713, 1.723, 1.733, 1.743, 1.753, 1.763, 1.774, 1.784, 1.793, & - & 1.803, 1.813, 1.823, 1.833, 1.843, 1.853, 1.863, 1.872, 1.882, & - & 1.892, 1.902, 1.911, 1.921, 1.931, 1.940, 1.950, 1.960, 1.969, & - & 1.979, 1.988, 1.998, 2.007, 2.017, 2.026, 2.036, 2.045, 2.055, & - & 2.064, 2.073, 2.083, 2.092, 2.101, 2.111, 2.120, 2.129, 2.138, & - & 2.147, 2.157, 2.166, 2.175, 2.184, 2.193, 2.202, 2.211, 2.220, & - & 2.229, 2.238, 2.247, 2.256, 2.265, 2.274, 2.283, 2.292, 2.301, & - & 2.310, 2.318, 2.327, 2.336, 2.345, 2.354, 2.362, 2.371, 2.380, & - & 2.388, 2.397, 2.406, 2.414, 2.423, 2.432, 2.440, 2.449, 2.457, & - & 2.466, 2.474, 2.483, 2.491, 2.500, 2.508, 2.517, 2.525, 2.533, & - & 2.542, 2.550, 2.558, 2.567, 2.575, 2.583, 2.591, 2.600, 2.608, & - & 2.616, 2.624, 2.633, 2.641, 2.649, 2.657, 2.665, 2.673, 2.681, & - & 2.689, 2.697, 2.705, 2.713, 2.721, 2.729, 2.737, 2.745, 2.753, & - & 2.761, 2.769, 2.777, 2.785, 2.793, 2.801, 2.809, 2.816, 2.824, & - & 2.832, 2.840, 2.847, 2.855, 2.863, 2.871, 2.878, 2.886, 2.894, & - & 2.901, 2.909, 2.917, 2.924, 2.932, 2.939, 2.947, 2.955, 2.962, & - & 2.970, 2.977, 2.985, 2.992, 3.000, 3.007, 3.014, 3.022, 3.029, & - & 3.037, 3.044, 3.051, 3.059, 3.066, 3.074, 3.081, 3.088, 3.095, & - & 3.103, 3.110, 3.117, 3.125, 3.132, 3.139, 3.146, 3.153, 3.161, & - & 3.168, 3.175, 3.182, 3.189, 3.196, 3.203, 3.210, 3.217, 3.225, & - & 3.232, 3.239, 3.246, 3.253, 3.260, 3.267, 3.274, 3.281, 3.288, & - & 3.294, 3.301, 3.308, 3.315, 3.322, 3.329, 3.336, 3.343, 3.350, & - & 3.356, 3.363, 3.370, 3.377, 3.450, 3.516, 3.581, 3.645, 3.708, & - & 3.770, 3.831, 3.891, 3.950, 4.008, 4.065, 4.122, 4.178, 4.233, & - & 4.287, 4.340, 4.393, 4.445, 4.496, 4.547, 4.597, 4.646, 4.695, & - & 4.743, 4.790, 4.837, 4.884, 4.929, 4.974, 5.019, 5.063, 5.107, & - & 5.150, 5.193, 5.235, 5.277, 5.318, 5.359, 5.399, 5.439, 5.478, & - & 5.517, 5.556, 5.594, 5.632, 5.670, 5.707, 5.743, 5.780, 5.816, & - & 5.852, 5.887, 5.922, 5.956, 5.991, 6.025, 6.058, 6.092, 6.125, & - & 6.158, 6.190, 6.222, 6.254, 6.286, 6.317, 6.348, 6.379, 6.410, & - & 6.440, 6.470, 6.500, 6.529, 6.559, 6.588, 6.616, 6.645, 6.673, & - & 6.701, 6.729, 6.757, 6.784, 6.812, 6.839, 6.865, 6.892, 6.919, & - & 6.945, 6.971, 6.997, 7.022, 7.048, 7.073, 7.098, 7.123, 7.148, & - & 7.172, 7.196, 7.221, 7.245, 7.269, 7.292, 7.316, 7.339, 7.362, & - & 7.385, 7.408, 7.431, 7.454, 7.476, 7.498, 7.520, 7.542, 7.564, & - & 7.586, 7.607, 7.629, 7.650, 7.671, 7.692, 7.713, 7.734, 7.755, & - & 7.775, 7.795, 7.816, 7.836, 7.856, 7.876, 7.895, 7.915, 7.935, & - & 7.954, 7.973, 7.992, 8.012, 8.030, 8.049, 8.068, 8.087, 8.105, & - & 8.124, 8.142, 8.160, 8.178, 8.196, 8.214, 8.232, 8.250, 8.267, & - & 8.285, 8.302, 8.319, 8.337, 8.354, 8.371, 8.388, 8.404, 8.421, & - & 8.438, 8.454, 8.471 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.048,-0.102,-0.128,-0.146,-0.159,-0.170,-0.179,-0.187,-0.194, & - -0.200,-0.205,-0.210,-0.214,-0.218,-0.221,-0.224,-0.227,-0.230, & - -0.232,-0.234,-0.235,-0.237,-0.238,-0.239,-0.240,-0.241,-0.242, & - -0.242,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.242,-0.242, & - -0.241,-0.241,-0.240,-0.239,-0.238,-0.237,-0.236,-0.235,-0.234, & - -0.233,-0.231,-0.230,-0.228,-0.227,-0.225,-0.224,-0.222,-0.220, & - -0.218,-0.216,-0.214,-0.212,-0.210,-0.208,-0.206,-0.204,-0.202, & - -0.199,-0.197,-0.195,-0.192,-0.190,-0.188,-0.185,-0.183,-0.180, & - -0.178,-0.175,-0.172,-0.170,-0.167,-0.164,-0.161,-0.159,-0.156, & - -0.153,-0.150,-0.147,-0.144,-0.141,-0.138,-0.135,-0.132,-0.129, & - -0.126,-0.123,-0.119,-0.116,-0.113,-0.110,-0.106,-0.103,-0.100, & - -0.096,-0.093,-0.090,-0.086,-0.083,-0.080,-0.076,-0.073,-0.069, & - -0.066,-0.062,-0.059,-0.055,-0.052,-0.048,-0.045,-0.041,-0.037, & - -0.034,-0.030,-0.027,-0.023,-0.020,-0.016,-0.012,-0.009,-0.005, & - -0.002, 0.002, 0.005, 0.009, 0.013, 0.016, 0.020, 0.023, 0.027, & - & 0.030, 0.034, 0.037, 0.041, 0.044, 0.048, 0.051, 0.055, 0.058, & - & 0.062, 0.065, 0.069, 0.072, 0.076, 0.079, 0.083, 0.086, 0.090, & - & 0.093, 0.097, 0.100, 0.103, 0.107, 0.110, 0.114, 0.117, 0.120, & - & 0.124, 0.127, 0.130, 0.134, 0.137, 0.140, 0.144, 0.147, 0.150, & - & 0.154, 0.157, 0.160, 0.164, 0.167, 0.170, 0.173, 0.177, 0.180, & - & 0.183, 0.186, 0.189, 0.193, 0.196, 0.199, 0.202, 0.205, 0.209, & - & 0.212, 0.215, 0.218, 0.221, 0.224, 0.227, 0.231, 0.234, 0.237, & - & 0.240, 0.243, 0.246, 0.249, 0.252, 0.255, 0.258, 0.261, 0.264, & - & 0.267, 0.270, 0.273, 0.276, 0.279, 0.282, 0.285, 0.288, 0.291, & - & 0.294, 0.297, 0.300, 0.303, 0.306, 0.309, 0.312, 0.315, 0.317, & - & 0.320, 0.323, 0.326, 0.329, 0.332, 0.335, 0.338, 0.340, 0.343, & - & 0.346, 0.349, 0.352, 0.354, 0.357, 0.360, 0.363, 0.366, 0.368, & - & 0.371, 0.374, 0.377, 0.379, 0.382, 0.385, 0.388, 0.390, 0.393, & - & 0.396, 0.398, 0.401, 0.404, 0.407, 0.409, 0.412, 0.415, 0.417, & - & 0.420, 0.422, 0.425, 0.428, 0.430, 0.433, 0.436, 0.438, 0.441, & - & 0.443, 0.446, 0.449, 0.451, 0.454, 0.456, 0.459, 0.461, 0.464, & - & 0.467, 0.469, 0.472, 0.474, 0.477, 0.479, 0.482, 0.484, 0.487, & - & 0.489, 0.492, 0.494, 0.497, 0.499, 0.502, 0.504, 0.507, 0.509, & - & 0.511, 0.514, 0.516, 0.519, 0.521, 0.524, 0.526, 0.528, 0.531, & - & 0.533, 0.536, 0.538, 0.540, 0.543, 0.545, 0.548, 0.550, 0.552, & - & 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.569, 0.571, 0.573, & - & 0.576, 0.578, 0.580, 0.583, 0.585, 0.587, 0.589, 0.592, 0.594, & - & 0.596, 0.599, 0.601, 0.603, 0.605, 0.608, 0.610, 0.612, 0.614, & - & 0.617, 0.619, 0.621, 0.623, 0.625, 0.628, 0.630, 0.632, 0.634, & - & 0.636, 0.639, 0.641, 0.643, 0.645, 0.647, 0.649, 0.652, 0.654, & - & 0.656, 0.658, 0.660, 0.662, 0.665, 0.667, 0.669, 0.671, 0.673, & - & 0.675, 0.677, 0.679, 0.681, 0.684, 0.686, 0.688, 0.690, 0.692, & - & 0.694, 0.696, 0.698, 0.700, 0.702, 0.704, 0.706, 0.708, 0.710, & - & 0.713, 0.715, 0.717, 0.719, 0.721, 0.723, 0.725, 0.727, 0.729, & - & 0.731, 0.733, 0.735, 0.737, 0.758, 0.778, 0.797, 0.815, 0.834, & - & 0.852, 0.870, 0.887, 0.905, 0.922, 0.938, 0.955, 0.971, 0.987, & - & 1.003, 1.018, 1.033, 1.048, 1.063, 1.078, 1.092, 1.106, 1.120, & - & 1.134, 1.148, 1.161, 1.174, 1.187, 1.200, 1.213, 1.225, 1.238, & - & 1.250, 1.262, 1.274, 1.286, 1.297, 1.309, 1.320, 1.331, 1.342, & - & 1.353, 1.364, 1.374, 1.385, 1.395, 1.406, 1.416, 1.426, 1.436, & - & 1.446, 1.455, 1.465, 1.475, 1.484, 1.493, 1.502, 1.512, 1.521, & - & 1.529, 1.538, 1.547, 1.556, 1.564, 1.572, 1.581, 1.589, 1.597, & - & 1.605, 1.613, 1.621, 1.629, 1.637, 1.645, 1.652, 1.660, 1.667, & - & 1.675, 1.682, 1.689, 1.696, 1.704, 1.711, 1.718, 1.725, 1.731, & - & 1.738, 1.745, 1.752, 1.758, 1.765, 1.771, 1.778, 1.784, 1.790, & - & 1.796, 1.803, 1.809, 1.815, 1.821, 1.827, 1.833, 1.839, 1.844, & - & 1.850, 1.856, 1.861, 1.867, 1.873, 1.878, 1.884, 1.889, 1.894, & - & 1.900, 1.905, 1.910, 1.915, 1.920, 1.926, 1.931, 1.936, 1.941, & - & 1.946, 1.950, 1.955, 1.960, 1.965, 1.970, 1.974, 1.979, 1.983, & - & 1.988, 1.993, 1.997, 2.001, 2.006, 2.010, 2.015, 2.019, 2.023, & - & 2.027, 2.032, 2.036, 2.040, 2.044, 2.048, 2.052, 2.056, 2.060, & - & 2.064, 2.068, 2.072, 2.076, 2.080, 2.083, 2.087, 2.091, 2.095, & - & 2.098, 2.102, 2.106 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.047,-0.098,-0.120,-0.135,-0.145,-0.153,-0.158,-0.163,-0.167, & - -0.169,-0.172,-0.173,-0.175,-0.176,-0.176,-0.176,-0.176,-0.176, & - -0.176,-0.175,-0.175,-0.174,-0.173,-0.172,-0.170,-0.169,-0.168, & - -0.166,-0.165,-0.163,-0.162,-0.160,-0.159,-0.157,-0.155,-0.153, & - -0.151,-0.149,-0.148,-0.146,-0.144,-0.142,-0.140,-0.138,-0.136, & - -0.134,-0.132,-0.130,-0.128,-0.126,-0.124,-0.122,-0.120,-0.118, & - -0.115,-0.113,-0.111,-0.109,-0.107,-0.105,-0.103,-0.101,-0.099, & - -0.097,-0.095,-0.093,-0.090,-0.088,-0.086,-0.084,-0.082,-0.080, & - -0.078,-0.075,-0.073,-0.071,-0.069,-0.067,-0.064,-0.062,-0.060, & - -0.057,-0.055,-0.053,-0.051,-0.048,-0.046,-0.043,-0.041,-0.039, & - -0.036,-0.034,-0.031,-0.029,-0.026,-0.024,-0.021,-0.019,-0.016, & - -0.014,-0.011,-0.008,-0.006,-0.003, 0.000, 0.002, 0.005, 0.007, & - & 0.010, 0.013, 0.016, 0.018, 0.021, 0.024, 0.026, 0.029, 0.032, & - & 0.035, 0.037, 0.040, 0.043, 0.046, 0.048, 0.051, 0.054, 0.057, & - & 0.059, 0.062, 0.065, 0.068, 0.070, 0.073, 0.076, 0.079, 0.081, & - & 0.084, 0.087, 0.090, 0.092, 0.095, 0.098, 0.101, 0.103, 0.106, & - & 0.109, 0.112, 0.114, 0.117, 0.120, 0.123, 0.125, 0.128, 0.131, & - & 0.133, 0.136, 0.139, 0.142, 0.144, 0.147, 0.150, 0.152, 0.155, & - & 0.158, 0.160, 0.163, 0.166, 0.168, 0.171, 0.174, 0.176, 0.179, & - & 0.182, 0.184, 0.187, 0.190, 0.192, 0.195, 0.198, 0.200, 0.203, & - & 0.205, 0.208, 0.211, 0.213, 0.216, 0.218, 0.221, 0.224, 0.226, & - & 0.229, 0.231, 0.234, 0.236, 0.239, 0.242, 0.244, 0.247, 0.249, & - & 0.252, 0.254, 0.257, 0.259, 0.262, 0.264, 0.267, 0.269, 0.272, & - & 0.275, 0.277, 0.280, 0.282, 0.285, 0.287, 0.289, 0.292, 0.294, & - & 0.297, 0.299, 0.302, 0.304, 0.307, 0.309, 0.312, 0.314, 0.317, & - & 0.319, 0.321, 0.324, 0.326, 0.329, 0.331, 0.334, 0.336, 0.338, & - & 0.341, 0.343, 0.346, 0.348, 0.350, 0.353, 0.355, 0.357, 0.360, & - & 0.362, 0.364, 0.367, 0.369, 0.372, 0.374, 0.376, 0.379, 0.381, & - & 0.383, 0.386, 0.388, 0.390, 0.392, 0.395, 0.397, 0.399, 0.402, & - & 0.404, 0.406, 0.409, 0.411, 0.413, 0.415, 0.418, 0.420, 0.422, & - & 0.424, 0.427, 0.429, 0.431, 0.433, 0.436, 0.438, 0.440, 0.442, & - & 0.445, 0.447, 0.449, 0.451, 0.453, 0.456, 0.458, 0.460, 0.462, & - & 0.464, 0.467, 0.469, 0.471, 0.473, 0.475, 0.477, 0.480, 0.482, & - & 0.484, 0.486, 0.488, 0.490, 0.492, 0.495, 0.497, 0.499, 0.501, & - & 0.503, 0.505, 0.507, 0.509, 0.511, 0.514, 0.516, 0.518, 0.520, & - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.539, & - & 0.541, 0.543, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, 0.557, & - & 0.559, 0.561, 0.563, 0.565, 0.567, 0.569, 0.571, 0.573, 0.575, & - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.589, 0.591, 0.593, & - & 0.595, 0.597, 0.599, 0.601, 0.603, 0.604, 0.606, 0.608, 0.610, & - & 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, 0.624, 0.626, 0.628, & - & 0.629, 0.631, 0.633, 0.635, 0.637, 0.639, 0.641, 0.643, 0.645, & - & 0.646, 0.648, 0.650, 0.652, 0.654, 0.656, 0.658, 0.659, 0.661, & - & 0.663, 0.665, 0.667, 0.669, 0.671, 0.672, 0.674, 0.676, 0.678, & - & 0.680, 0.681, 0.683, 0.685, 0.704, 0.722, 0.739, 0.756, 0.773, & - & 0.790, 0.806, 0.822, 0.838, 0.853, 0.869, 0.884, 0.899, 0.913, & - & 0.928, 0.942, 0.956, 0.970, 0.983, 0.996, 1.010, 1.023, 1.036, & - & 1.048, 1.061, 1.073, 1.085, 1.097, 1.109, 1.121, 1.132, 1.144, & - & 1.155, 1.166, 1.177, 1.188, 1.198, 1.209, 1.219, 1.230, 1.240, & - & 1.250, 1.260, 1.270, 1.279, 1.289, 1.298, 1.308, 1.317, 1.326, & - & 1.335, 1.344, 1.353, 1.362, 1.370, 1.379, 1.387, 1.396, 1.404, & - & 1.412, 1.420, 1.428, 1.436, 1.444, 1.451, 1.459, 1.467, 1.474, & - & 1.481, 1.489, 1.496, 1.503, 1.510, 1.517, 1.524, 1.531, 1.538, & - & 1.545, 1.551, 1.558, 1.565, 1.571, 1.578, 1.584, 1.590, 1.596, & - & 1.603, 1.609, 1.615, 1.621, 1.627, 1.632, 1.638, 1.644, 1.650, & - & 1.655, 1.661, 1.667, 1.672, 1.678, 1.683, 1.688, 1.694, 1.699, & - & 1.704, 1.709, 1.714, 1.719, 1.724, 1.729, 1.734, 1.739, 1.744, & - & 1.749, 1.753, 1.758, 1.763, 1.767, 1.772, 1.776, 1.781, 1.785, & - & 1.790, 1.794, 1.799, 1.803, 1.807, 1.811, 1.815, 1.820, 1.824, & - & 1.828, 1.832, 1.836, 1.840, 1.844, 1.848, 1.852, 1.855, 1.859, & - & 1.863, 1.867, 1.870, 1.874, 1.878, 1.881, 1.885, 1.888, 1.892, & - & 1.895, 1.899, 1.902, 1.906, 1.909, 1.913, 1.916, 1.919, 1.922, & - & 1.926, 1.929, 1.932 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.046,-0.091,-0.110,-0.120,-0.127,-0.131,-0.133,-0.134,-0.134, & - -0.134,-0.132,-0.131,-0.128,-0.126,-0.123,-0.120,-0.116,-0.112, & - -0.108,-0.104,-0.099,-0.095,-0.090,-0.085,-0.080,-0.075,-0.070, & - -0.064,-0.059,-0.053,-0.047,-0.042,-0.036,-0.030,-0.024,-0.018, & - -0.011,-0.005, 0.001, 0.007, 0.014, 0.020, 0.026, 0.033, 0.039, & - & 0.046, 0.052, 0.059, 0.065, 0.072, 0.079, 0.085, 0.092, 0.099, & - & 0.105, 0.112, 0.119, 0.126, 0.132, 0.139, 0.146, 0.153, 0.160, & - & 0.166, 0.173, 0.180, 0.187, 0.194, 0.201, 0.208, 0.215, 0.222, & - & 0.229, 0.236, 0.243, 0.250, 0.257, 0.264, 0.272, 0.279, 0.286, & - & 0.293, 0.301, 0.308, 0.316, 0.323, 0.330, 0.338, 0.346, 0.353, & - & 0.361, 0.368, 0.376, 0.384, 0.392, 0.399, 0.407, 0.415, 0.423, & - & 0.431, 0.439, 0.447, 0.455, 0.463, 0.471, 0.479, 0.487, 0.495, & - & 0.503, 0.512, 0.520, 0.528, 0.536, 0.544, 0.553, 0.561, 0.569, & - & 0.577, 0.586, 0.594, 0.602, 0.610, 0.619, 0.627, 0.635, 0.643, & - & 0.652, 0.660, 0.668, 0.676, 0.685, 0.693, 0.701, 0.709, 0.718, & - & 0.726, 0.734, 0.742, 0.750, 0.759, 0.767, 0.775, 0.783, 0.791, & - & 0.799, 0.807, 0.815, 0.823, 0.832, 0.840, 0.848, 0.856, 0.864, & - & 0.872, 0.880, 0.888, 0.896, 0.903, 0.911, 0.919, 0.927, 0.935, & - & 0.943, 0.951, 0.959, 0.966, 0.974, 0.982, 0.990, 0.998, 1.005, & - & 1.013, 1.021, 1.029, 1.036, 1.044, 1.052, 1.059, 1.067, 1.075, & - & 1.082, 1.090, 1.097, 1.105, 1.112, 1.120, 1.128, 1.135, 1.143, & - & 1.150, 1.157, 1.165, 1.172, 1.180, 1.187, 1.195, 1.202, 1.209, & - & 1.217, 1.224, 1.231, 1.239, 1.246, 1.253, 1.260, 1.268, 1.275, & - & 1.282, 1.289, 1.296, 1.303, 1.311, 1.318, 1.325, 1.332, 1.339, & - & 1.346, 1.353, 1.360, 1.367, 1.374, 1.381, 1.388, 1.395, 1.402, & - & 1.409, 1.416, 1.423, 1.430, 1.437, 1.444, 1.451, 1.457, 1.464, & - & 1.471, 1.478, 1.485, 1.491, 1.498, 1.505, 1.512, 1.518, 1.525, & - & 1.532, 1.538, 1.545, 1.552, 1.558, 1.565, 1.572, 1.578, 1.585, & - & 1.591, 1.598, 1.604, 1.611, 1.617, 1.624, 1.630, 1.637, 1.643, & - & 1.650, 1.656, 1.663, 1.669, 1.675, 1.682, 1.688, 1.695, 1.701, & - & 1.707, 1.714, 1.720, 1.726, 1.732, 1.739, 1.745, 1.751, 1.757, & - & 1.764, 1.770, 1.776, 1.782, 1.788, 1.795, 1.801, 1.807, 1.813, & - & 1.819, 1.825, 1.831, 1.837, 1.843, 1.849, 1.855, 1.861, 1.867, & - & 1.873, 1.879, 1.885, 1.891, 1.897, 1.903, 1.909, 1.915, 1.921, & - & 1.927, 1.933, 1.939, 1.945, 1.950, 1.956, 1.962, 1.968, 1.974, & - & 1.979, 1.985, 1.991, 1.997, 2.003, 2.008, 2.014, 2.020, 2.025, & - & 2.031, 2.037, 2.042, 2.048, 2.054, 2.059, 2.065, 2.071, 2.076, & - & 2.082, 2.087, 2.093, 2.099, 2.104, 2.110, 2.115, 2.121, 2.126, & - & 2.132, 2.137, 2.143, 2.148, 2.154, 2.159, 2.165, 2.170, 2.175, & - & 2.181, 2.186, 2.192, 2.197, 2.202, 2.208, 2.213, 2.219, 2.224, & - & 2.229, 2.235, 2.240, 2.245, 2.250, 2.256, 2.261, 2.266, 2.271, & - & 2.277, 2.282, 2.287, 2.292, 2.298, 2.303, 2.308, 2.313, 2.318, & - & 2.323, 2.329, 2.334, 2.339, 2.344, 2.349, 2.354, 2.359, 2.364, & - & 2.369, 2.375, 2.380, 2.385, 2.390, 2.395, 2.400, 2.405, 2.410, & - & 2.415, 2.420, 2.425, 2.430, 2.483, 2.531, 2.579, 2.626, 2.672, & - & 2.717, 2.762, 2.806, 2.849, 2.891, 2.933, 2.975, 3.015, 3.056, & - & 3.095, 3.134, 3.173, 3.211, 3.248, 3.285, 3.322, 3.358, 3.393, & - & 3.428, 3.463, 3.497, 3.531, 3.564, 3.597, 3.629, 3.662, 3.693, & - & 3.725, 3.756, 3.786, 3.817, 3.847, 3.876, 3.906, 3.935, 3.963, & - & 3.992, 4.020, 4.048, 4.075, 4.102, 4.129, 4.156, 4.182, 4.208, & - & 4.234, 4.260, 4.285, 4.310, 4.335, 4.359, 4.384, 4.408, 4.432, & - & 4.456, 4.479, 4.502, 4.525, 4.548, 4.571, 4.593, 4.615, 4.637, & - & 4.659, 4.681, 4.702, 4.724, 4.745, 4.766, 4.786, 4.807, 4.827, & - & 4.847, 4.868, 4.887, 4.907, 4.927, 4.946, 4.965, 4.984, 5.003, & - & 5.022, 5.041, 5.059, 5.078, 5.096, 5.114, 5.132, 5.150, 5.168, & - & 5.185, 5.203, 5.220, 5.237, 5.254, 5.271, 5.288, 5.304, 5.321, & - & 5.337, 5.354, 5.370, 5.386, 5.402, 5.418, 5.434, 5.449, 5.465, & - & 5.480, 5.496, 5.511, 5.526, 5.541, 5.556, 5.571, 5.586, 5.600, & - & 5.615, 5.629, 5.644, 5.658, 5.672, 5.686, 5.700, 5.714, 5.728, & - & 5.742, 5.755, 5.769, 5.782, 5.796, 5.809, 5.822, 5.835, 5.848, & - & 5.861, 5.874, 5.887, 5.900, 5.913, 5.925, 5.938, 5.950, 5.963, & - & 5.975, 5.987, 5.999, 6.011, 6.023, 6.035, 6.047, 6.059, 6.071, & - & 6.083, 6.094, 6.106 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.047,-0.097,-0.120,-0.135,-0.146,-0.154,-0.160,-0.165,-0.170, & - -0.173,-0.176,-0.178,-0.179,-0.181,-0.181,-0.182,-0.182,-0.182, & - -0.182,-0.182,-0.181,-0.180,-0.179,-0.178,-0.176,-0.175,-0.173, & - -0.172,-0.170,-0.168,-0.165,-0.163,-0.161,-0.158,-0.156,-0.153, & - -0.150,-0.148,-0.145,-0.142,-0.139,-0.136,-0.132,-0.129,-0.126, & - -0.123,-0.119,-0.116,-0.112,-0.109,-0.105,-0.101,-0.098,-0.094, & - -0.090,-0.086,-0.082,-0.078,-0.074,-0.070,-0.066,-0.062,-0.058, & - -0.054,-0.050,-0.046,-0.041,-0.037,-0.033,-0.028,-0.024,-0.020, & - -0.015,-0.011,-0.006,-0.002, 0.003, 0.007, 0.012, 0.017, 0.021, & - & 0.026, 0.031, 0.036, 0.041, 0.045, 0.050, 0.055, 0.060, 0.065, & - & 0.070, 0.075, 0.080, 0.086, 0.091, 0.096, 0.101, 0.106, 0.112, & - & 0.117, 0.122, 0.128, 0.133, 0.138, 0.144, 0.149, 0.154, 0.160, & - & 0.165, 0.171, 0.176, 0.182, 0.187, 0.193, 0.198, 0.204, 0.209, & - & 0.215, 0.221, 0.226, 0.232, 0.237, 0.243, 0.248, 0.254, 0.259, & - & 0.265, 0.271, 0.276, 0.282, 0.287, 0.293, 0.298, 0.304, 0.309, & - & 0.315, 0.320, 0.326, 0.331, 0.337, 0.342, 0.348, 0.353, 0.358, & - & 0.364, 0.369, 0.375, 0.380, 0.386, 0.391, 0.396, 0.402, 0.407, & - & 0.412, 0.418, 0.423, 0.428, 0.434, 0.439, 0.444, 0.449, 0.455, & - & 0.460, 0.465, 0.470, 0.476, 0.481, 0.486, 0.491, 0.496, 0.502, & - & 0.507, 0.512, 0.517, 0.522, 0.527, 0.532, 0.537, 0.542, 0.548, & - & 0.553, 0.558, 0.563, 0.568, 0.573, 0.578, 0.583, 0.588, 0.593, & - & 0.598, 0.603, 0.607, 0.612, 0.617, 0.622, 0.627, 0.632, 0.637, & - & 0.642, 0.647, 0.651, 0.656, 0.661, 0.666, 0.671, 0.675, 0.680, & - & 0.685, 0.690, 0.694, 0.699, 0.704, 0.709, 0.713, 0.718, 0.723, & - & 0.727, 0.732, 0.737, 0.741, 0.746, 0.751, 0.755, 0.760, 0.764, & - & 0.769, 0.773, 0.778, 0.783, 0.787, 0.792, 0.796, 0.801, 0.805, & - & 0.810, 0.814, 0.819, 0.823, 0.828, 0.832, 0.836, 0.841, 0.845, & - & 0.850, 0.854, 0.858, 0.863, 0.867, 0.872, 0.876, 0.880, 0.885, & - & 0.889, 0.893, 0.898, 0.902, 0.906, 0.910, 0.915, 0.919, 0.923, & - & 0.928, 0.932, 0.936, 0.940, 0.944, 0.949, 0.953, 0.957, 0.961, & - & 0.965, 0.969, 0.974, 0.978, 0.982, 0.986, 0.990, 0.994, 0.998, & - & 1.002, 1.007, 1.011, 1.015, 1.019, 1.023, 1.027, 1.031, 1.035, & - & 1.039, 1.043, 1.047, 1.051, 1.055, 1.059, 1.063, 1.067, 1.071, & - & 1.075, 1.079, 1.083, 1.087, 1.091, 1.094, 1.098, 1.102, 1.106, & - & 1.110, 1.114, 1.118, 1.122, 1.125, 1.129, 1.133, 1.137, 1.141, & - & 1.145, 1.148, 1.152, 1.156, 1.160, 1.164, 1.167, 1.171, 1.175, & - & 1.179, 1.182, 1.186, 1.190, 1.194, 1.197, 1.201, 1.205, 1.208, & - & 1.212, 1.216, 1.219, 1.223, 1.227, 1.230, 1.234, 1.238, 1.241, & - & 1.245, 1.249, 1.252, 1.256, 1.259, 1.263, 1.267, 1.270, 1.274, & - & 1.277, 1.281, 1.284, 1.288, 1.292, 1.295, 1.299, 1.302, 1.306, & - & 1.309, 1.313, 1.316, 1.320, 1.323, 1.327, 1.330, 1.334, 1.337, & - & 1.341, 1.344, 1.347, 1.351, 1.354, 1.358, 1.361, 1.365, 1.368, & - & 1.371, 1.375, 1.378, 1.382, 1.385, 1.388, 1.392, 1.395, 1.398, & - & 1.402, 1.405, 1.408, 1.412, 1.415, 1.418, 1.422, 1.425, 1.428, & - & 1.432, 1.435, 1.438, 1.441, 1.477, 1.509, 1.540, 1.571, 1.601, & - & 1.631, 1.661, 1.690, 1.718, 1.747, 1.774, 1.802, 1.829, 1.855, & - & 1.881, 1.907, 1.933, 1.958, 1.983, 2.007, 2.031, 2.055, 2.079, & - & 2.102, 2.125, 2.147, 2.170, 2.192, 2.213, 2.235, 2.256, 2.277, & - & 2.298, 2.318, 2.339, 2.359, 2.378, 2.398, 2.417, 2.436, 2.455, & - & 2.474, 2.493, 2.511, 2.529, 2.547, 2.565, 2.582, 2.599, 2.617, & - & 2.634, 2.650, 2.667, 2.684, 2.700, 2.716, 2.732, 2.748, 2.763, & - & 2.779, 2.794, 2.810, 2.825, 2.840, 2.854, 2.869, 2.884, 2.898, & - & 2.912, 2.926, 2.940, 2.954, 2.968, 2.982, 2.995, 3.008, 3.022, & - & 3.035, 3.048, 3.061, 3.074, 3.086, 3.099, 3.111, 3.124, 3.136, & - & 3.148, 3.160, 3.172, 3.184, 3.196, 3.208, 3.219, 3.231, 3.242, & - & 3.254, 3.265, 3.276, 3.287, 3.298, 3.309, 3.320, 3.330, 3.341, & - & 3.352, 3.362, 3.373, 3.383, 3.393, 3.403, 3.413, 3.423, 3.433, & - & 3.443, 3.453, 3.463, 3.472, 3.482, 3.491, 3.501, 3.510, 3.520, & - & 3.529, 3.538, 3.547, 3.556, 3.565, 3.574, 3.583, 3.592, 3.601, & - & 3.609, 3.618, 3.626, 3.635, 3.643, 3.652, 3.660, 3.668, 3.677, & - & 3.685, 3.693, 3.701, 3.709, 3.717, 3.725, 3.733, 3.741, 3.748, & - & 3.756, 3.764, 3.771, 3.779, 3.786, 3.794, 3.801, 3.809, 3.816, & - & 3.823, 3.830, 3.838 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.078,-0.169,-0.215,-0.247,-0.272,-0.293,-0.311,-0.326,-0.340, & - -0.353,-0.364,-0.375,-0.384,-0.393,-0.402,-0.410,-0.417,-0.424, & - -0.431,-0.437,-0.443,-0.448,-0.454,-0.459,-0.464,-0.469,-0.473, & - -0.477,-0.482,-0.486,-0.489,-0.493,-0.497,-0.500,-0.503,-0.506, & - -0.509,-0.512,-0.515,-0.518,-0.520,-0.523,-0.525,-0.528,-0.530, & - -0.532,-0.534,-0.536,-0.538,-0.540,-0.542,-0.544,-0.546,-0.547, & - -0.549,-0.550,-0.552,-0.553,-0.555,-0.556,-0.557,-0.559,-0.560, & - -0.561,-0.562,-0.563,-0.564,-0.565,-0.566,-0.567,-0.568,-0.569, & - -0.570,-0.571,-0.572,-0.572,-0.573,-0.574,-0.575,-0.575,-0.576, & - -0.576,-0.577,-0.578,-0.578,-0.579,-0.579,-0.580,-0.580,-0.580, & - -0.581,-0.581,-0.582,-0.582,-0.582,-0.582,-0.583,-0.583,-0.583, & - -0.583,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.585, & - -0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585, & - -0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585,-0.585, & - -0.585,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584,-0.584, & - -0.584,-0.584,-0.583,-0.583,-0.583,-0.583,-0.583,-0.583,-0.583, & - -0.582,-0.582,-0.582,-0.582,-0.582,-0.582,-0.582,-0.581,-0.581, & - -0.581,-0.581,-0.581,-0.581,-0.580,-0.580,-0.580,-0.580,-0.580, & - -0.579,-0.579,-0.579,-0.579,-0.579,-0.579,-0.578,-0.578,-0.578, & - -0.578,-0.578,-0.577,-0.577,-0.577,-0.577,-0.577,-0.577,-0.576, & - -0.576,-0.576,-0.576,-0.576,-0.575,-0.575,-0.575,-0.575,-0.575, & - -0.574,-0.574,-0.574,-0.574,-0.574,-0.574,-0.573,-0.573,-0.573, & - -0.573,-0.573,-0.572,-0.572,-0.572,-0.572,-0.572,-0.571,-0.571, & - -0.571,-0.571,-0.571,-0.571,-0.570,-0.570,-0.570,-0.570,-0.570, & - -0.569,-0.569,-0.569,-0.569,-0.569,-0.569,-0.568,-0.568,-0.568, & - -0.568,-0.568,-0.567,-0.567,-0.567,-0.567,-0.567,-0.567,-0.566, & - -0.566,-0.566,-0.566,-0.566,-0.566,-0.565,-0.565,-0.565,-0.565, & - -0.565,-0.565,-0.564,-0.564,-0.564,-0.564,-0.564,-0.564,-0.563, & - -0.563,-0.563,-0.563,-0.563,-0.563,-0.562,-0.562,-0.562,-0.562, & - -0.562,-0.562,-0.561,-0.561,-0.561,-0.561,-0.561,-0.561,-0.561, & - -0.560,-0.560,-0.560,-0.560,-0.560,-0.560,-0.560,-0.559,-0.559, & - -0.559,-0.559,-0.559,-0.559,-0.559,-0.558,-0.558,-0.558,-0.558, & - -0.558,-0.558,-0.558,-0.557,-0.557,-0.557,-0.557,-0.557,-0.557, & - -0.557,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556,-0.556, & - -0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.555,-0.554, & - -0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.554,-0.553, & - -0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.553,-0.552, & - -0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552,-0.552, & - -0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551,-0.551, & - -0.551,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550,-0.550, & - -0.550,-0.550,-0.550,-0.549,-0.549,-0.549,-0.549,-0.549,-0.549, & - -0.549,-0.549,-0.549,-0.549,-0.549,-0.549,-0.549,-0.548,-0.548, & - -0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548,-0.548, & - -0.548,-0.548,-0.547,-0.547,-0.547,-0.547,-0.547,-0.547,-0.547, & - -0.547,-0.547,-0.547,-0.547,-0.546,-0.546,-0.545,-0.545,-0.544, & - -0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544,-0.544, & - -0.544,-0.544,-0.545,-0.545,-0.545,-0.546,-0.546,-0.547,-0.547, & - -0.548,-0.548,-0.549,-0.550,-0.550,-0.551,-0.552,-0.553,-0.554, & - -0.555,-0.556,-0.557,-0.558,-0.559,-0.560,-0.561,-0.562,-0.563, & - -0.564,-0.566,-0.567,-0.568,-0.569,-0.571,-0.572,-0.573,-0.575, & - -0.576,-0.578,-0.579,-0.581,-0.582,-0.584,-0.586,-0.587,-0.589, & - -0.590,-0.592,-0.594,-0.595,-0.597,-0.599,-0.601,-0.603,-0.604, & - -0.606,-0.608,-0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.622, & - -0.624,-0.626,-0.628,-0.630,-0.632,-0.634,-0.636,-0.638,-0.640, & - -0.642,-0.644,-0.647,-0.649,-0.651,-0.653,-0.655,-0.658,-0.660, & - -0.662,-0.664,-0.667,-0.669,-0.671,-0.674,-0.676,-0.678,-0.681, & - -0.683,-0.686,-0.688,-0.690,-0.693,-0.695,-0.698,-0.700,-0.703, & - -0.705,-0.708,-0.710,-0.713,-0.715,-0.718,-0.720,-0.723,-0.725, & - -0.728,-0.731,-0.733,-0.736,-0.738,-0.741,-0.744,-0.746,-0.749, & - -0.752,-0.754,-0.757,-0.760,-0.762,-0.765,-0.768,-0.770,-0.773, & - -0.776,-0.779,-0.781,-0.784,-0.787,-0.790,-0.793,-0.795,-0.798, & - -0.801,-0.804,-0.807,-0.809,-0.812,-0.815,-0.818,-0.821,-0.824, & - -0.827,-0.829,-0.832 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.096,-0.206,-0.258,-0.293,-0.321,-0.342,-0.360,-0.376,-0.389, & - -0.401,-0.411,-0.420,-0.429,-0.436,-0.443,-0.449,-0.455,-0.460, & - -0.465,-0.469,-0.473,-0.477,-0.481,-0.484,-0.487,-0.490,-0.493, & - -0.495,-0.497,-0.500,-0.502,-0.504,-0.505,-0.507,-0.509,-0.510, & - -0.512,-0.513,-0.514,-0.515,-0.517,-0.518,-0.519,-0.520,-0.520, & - -0.521,-0.522,-0.523,-0.524,-0.524,-0.525,-0.526,-0.526,-0.527, & - -0.527,-0.528,-0.528,-0.529,-0.529,-0.530,-0.530,-0.530,-0.531, & - -0.531,-0.531,-0.531,-0.532,-0.532,-0.532,-0.532,-0.532,-0.532, & - -0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533,-0.533, & - -0.532,-0.532,-0.532,-0.532,-0.532,-0.532,-0.531,-0.531,-0.531, & - -0.530,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.527, & - -0.527,-0.526,-0.526,-0.525,-0.525,-0.524,-0.524,-0.523,-0.523, & - -0.522,-0.521,-0.521,-0.520,-0.519,-0.519,-0.518,-0.517,-0.517, & - -0.516,-0.515,-0.515,-0.514,-0.513,-0.512,-0.512,-0.511,-0.510, & - -0.509,-0.509,-0.508,-0.507,-0.506,-0.506,-0.505,-0.504,-0.503, & - -0.503,-0.502,-0.501,-0.500,-0.499,-0.499,-0.498,-0.497,-0.496, & - -0.495,-0.495,-0.494,-0.493,-0.492,-0.491,-0.491,-0.490,-0.489, & - -0.488,-0.487,-0.486,-0.486,-0.485,-0.484,-0.483,-0.482,-0.482, & - -0.481,-0.480,-0.479,-0.478,-0.477,-0.477,-0.476,-0.475,-0.474, & - -0.473,-0.472,-0.472,-0.471,-0.470,-0.469,-0.468,-0.468,-0.467, & - -0.466,-0.465,-0.464,-0.463,-0.463,-0.462,-0.461,-0.460,-0.459, & - -0.459,-0.458,-0.457,-0.456,-0.455,-0.455,-0.454,-0.453,-0.452, & - -0.451,-0.450,-0.450,-0.449,-0.448,-0.447,-0.446,-0.446,-0.445, & - -0.444,-0.443,-0.442,-0.442,-0.441,-0.440,-0.439,-0.438,-0.438, & - -0.437,-0.436,-0.435,-0.435,-0.434,-0.433,-0.432,-0.431,-0.431, & - -0.430,-0.429,-0.428,-0.427,-0.427,-0.426,-0.425,-0.424,-0.424, & - -0.423,-0.422,-0.421,-0.421,-0.420,-0.419,-0.418,-0.417,-0.417, & - -0.416,-0.415,-0.414,-0.414,-0.413,-0.412,-0.411,-0.411,-0.410, & - -0.409,-0.408,-0.408,-0.407,-0.406,-0.405,-0.405,-0.404,-0.403, & - -0.402,-0.402,-0.401,-0.400,-0.400,-0.399,-0.398,-0.397,-0.397, & - -0.396,-0.395,-0.394,-0.394,-0.393,-0.392,-0.392,-0.391,-0.390, & - -0.389,-0.389,-0.388,-0.387,-0.387,-0.386,-0.385,-0.385,-0.384, & - -0.383,-0.382,-0.382,-0.381,-0.380,-0.380,-0.379,-0.378,-0.378, & - -0.377,-0.376,-0.376,-0.375,-0.374,-0.374,-0.373,-0.372,-0.371, & - -0.371,-0.370,-0.369,-0.369,-0.368,-0.367,-0.367,-0.366,-0.365, & - -0.365,-0.364,-0.364,-0.363,-0.362,-0.362,-0.361,-0.360,-0.360, & - -0.359,-0.358,-0.358,-0.357,-0.356,-0.356,-0.355,-0.354,-0.354, & - -0.353,-0.353,-0.352,-0.351,-0.351,-0.350,-0.349,-0.349,-0.348, & - -0.348,-0.347,-0.346,-0.346,-0.345,-0.344,-0.344,-0.343,-0.343, & - -0.342,-0.341,-0.341,-0.340,-0.340,-0.339,-0.338,-0.338,-0.337, & - -0.337,-0.336,-0.335,-0.335,-0.334,-0.334,-0.333,-0.332,-0.332, & - -0.331,-0.331,-0.330,-0.330,-0.329,-0.328,-0.328,-0.327,-0.327, & - -0.326,-0.326,-0.325,-0.324,-0.324,-0.323,-0.323,-0.322,-0.322, & - -0.321,-0.320,-0.320,-0.319,-0.319,-0.318,-0.318,-0.317,-0.317, & - -0.316,-0.316,-0.315,-0.314,-0.309,-0.303,-0.298,-0.293,-0.288, & - -0.284,-0.279,-0.275,-0.270,-0.266,-0.262,-0.258,-0.254,-0.250, & - -0.246,-0.242,-0.239,-0.235,-0.232,-0.229,-0.226,-0.223,-0.219, & - -0.217,-0.214,-0.211,-0.208,-0.206,-0.203,-0.201,-0.198,-0.196, & - -0.194,-0.192,-0.190,-0.188,-0.186,-0.184,-0.182,-0.180,-0.179, & - -0.177,-0.175,-0.174,-0.173,-0.171,-0.170,-0.169,-0.167,-0.166, & - -0.165,-0.164,-0.163,-0.162,-0.161,-0.161,-0.160,-0.159,-0.158, & - -0.158,-0.157,-0.157,-0.156,-0.156,-0.155,-0.155,-0.155,-0.154, & - -0.154,-0.154,-0.154,-0.154,-0.153,-0.153,-0.153,-0.153,-0.153, & - -0.154,-0.154,-0.154,-0.154,-0.154,-0.155,-0.155,-0.155,-0.156, & - -0.156,-0.157,-0.157,-0.158,-0.158,-0.159,-0.159,-0.160,-0.161, & - -0.161,-0.162,-0.163,-0.164,-0.164,-0.165,-0.166,-0.167,-0.168, & - -0.169,-0.170,-0.171,-0.172,-0.173,-0.174,-0.175,-0.176,-0.177, & - -0.179,-0.180,-0.181,-0.182,-0.183,-0.185,-0.186,-0.187,-0.189, & - -0.190,-0.192,-0.193,-0.194,-0.196,-0.197,-0.199,-0.200,-0.202, & - -0.203,-0.205,-0.207,-0.208,-0.210,-0.212,-0.213,-0.215,-0.217, & - -0.218,-0.220,-0.222,-0.224,-0.225,-0.227,-0.229,-0.231,-0.233, & - -0.235,-0.237,-0.239,-0.240,-0.242,-0.244,-0.246,-0.248,-0.250, & - -0.252,-0.254,-0.256 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.095,-0.197,-0.242,-0.272,-0.293,-0.309,-0.321,-0.331,-0.339, & - -0.345,-0.351,-0.355,-0.358,-0.360,-0.362,-0.363,-0.363,-0.364, & - -0.364,-0.363,-0.362,-0.361,-0.360,-0.358,-0.357,-0.355,-0.353, & - -0.350,-0.348,-0.345,-0.343,-0.340,-0.337,-0.334,-0.331,-0.328, & - -0.325,-0.322,-0.319,-0.316,-0.312,-0.309,-0.306,-0.302,-0.299, & - -0.295,-0.292,-0.289,-0.285,-0.282,-0.278,-0.274,-0.271,-0.267, & - -0.264,-0.260,-0.257,-0.253,-0.249,-0.246,-0.242,-0.239,-0.235, & - -0.231,-0.228,-0.224,-0.220,-0.217,-0.213,-0.209,-0.205,-0.202, & - -0.198,-0.194,-0.190,-0.186,-0.182,-0.178,-0.175,-0.171,-0.167, & - -0.163,-0.158,-0.154,-0.150,-0.146,-0.142,-0.138,-0.134,-0.129, & - -0.125,-0.121,-0.116,-0.112,-0.107,-0.103,-0.099,-0.094,-0.090, & - -0.085,-0.080,-0.076,-0.071,-0.066,-0.062,-0.057,-0.052,-0.048, & - -0.043,-0.038,-0.033,-0.028,-0.024,-0.019,-0.014,-0.009,-0.004, & - & 0.001, 0.006, 0.010, 0.015, 0.020, 0.025, 0.030, 0.035, 0.040, & - & 0.045, 0.050, 0.055, 0.060, 0.064, 0.069, 0.074, 0.079, 0.084, & - & 0.089, 0.094, 0.099, 0.104, 0.109, 0.114, 0.119, 0.123, 0.128, & - & 0.133, 0.138, 0.143, 0.148, 0.153, 0.158, 0.162, 0.167, 0.172, & - & 0.177, 0.182, 0.187, 0.191, 0.196, 0.201, 0.206, 0.211, 0.215, & - & 0.220, 0.225, 0.230, 0.235, 0.239, 0.244, 0.249, 0.254, 0.258, & - & 0.263, 0.268, 0.272, 0.277, 0.282, 0.287, 0.291, 0.296, 0.301, & - & 0.305, 0.310, 0.315, 0.319, 0.324, 0.329, 0.333, 0.338, 0.342, & - & 0.347, 0.352, 0.356, 0.361, 0.365, 0.370, 0.375, 0.379, 0.384, & - & 0.388, 0.393, 0.397, 0.402, 0.406, 0.411, 0.415, 0.420, 0.424, & - & 0.429, 0.433, 0.438, 0.442, 0.447, 0.451, 0.456, 0.460, 0.464, & - & 0.469, 0.473, 0.478, 0.482, 0.487, 0.491, 0.495, 0.500, 0.504, & - & 0.508, 0.513, 0.517, 0.521, 0.526, 0.530, 0.534, 0.539, 0.543, & - & 0.547, 0.552, 0.556, 0.560, 0.564, 0.569, 0.573, 0.577, 0.581, & - & 0.586, 0.590, 0.594, 0.598, 0.602, 0.607, 0.611, 0.615, 0.619, & - & 0.623, 0.627, 0.632, 0.636, 0.640, 0.644, 0.648, 0.652, 0.656, & - & 0.660, 0.664, 0.669, 0.673, 0.677, 0.681, 0.685, 0.689, 0.693, & - & 0.697, 0.701, 0.705, 0.709, 0.713, 0.717, 0.721, 0.725, 0.729, & - & 0.733, 0.737, 0.741, 0.745, 0.749, 0.753, 0.757, 0.761, 0.765, & - & 0.768, 0.772, 0.776, 0.780, 0.784, 0.788, 0.792, 0.796, 0.799, & - & 0.803, 0.807, 0.811, 0.815, 0.819, 0.823, 0.826, 0.830, 0.834, & - & 0.838, 0.842, 0.845, 0.849, 0.853, 0.857, 0.860, 0.864, 0.868, & - & 0.872, 0.875, 0.879, 0.883, 0.886, 0.890, 0.894, 0.898, 0.901, & - & 0.905, 0.909, 0.912, 0.916, 0.920, 0.923, 0.927, 0.930, 0.934, & - & 0.938, 0.941, 0.945, 0.949, 0.952, 0.956, 0.959, 0.963, 0.966, & - & 0.970, 0.974, 0.977, 0.981, 0.984, 0.988, 0.991, 0.995, 0.998, & - & 1.002, 1.005, 1.009, 1.012, 1.016, 1.019, 1.023, 1.026, 1.030, & - & 1.033, 1.037, 1.040, 1.044, 1.047, 1.050, 1.054, 1.057, 1.061, & - & 1.064, 1.067, 1.071, 1.074, 1.078, 1.081, 1.084, 1.088, 1.091, & - & 1.094, 1.098, 1.101, 1.105, 1.108, 1.111, 1.115, 1.118, 1.121, & - & 1.124, 1.128, 1.131, 1.134, 1.138, 1.141, 1.144, 1.147, 1.151, & - & 1.154, 1.157, 1.160, 1.164, 1.198, 1.230, 1.261, 1.292, 1.322, & - & 1.351, 1.380, 1.409, 1.437, 1.465, 1.492, 1.519, 1.546, 1.572, & - & 1.598, 1.623, 1.648, 1.673, 1.697, 1.721, 1.745, 1.768, 1.791, & - & 1.814, 1.836, 1.858, 1.880, 1.901, 1.922, 1.943, 1.964, 1.984, & - & 2.004, 2.024, 2.044, 2.063, 2.082, 2.101, 2.119, 2.138, 2.156, & - & 2.174, 2.191, 2.209, 2.226, 2.243, 2.260, 2.276, 2.293, 2.309, & - & 2.325, 2.341, 2.357, 2.372, 2.387, 2.403, 2.418, 2.432, 2.447, & - & 2.461, 2.476, 2.490, 2.504, 2.518, 2.531, 2.545, 2.558, 2.571, & - & 2.585, 2.597, 2.610, 2.623, 2.635, 2.648, 2.660, 2.672, 2.684, & - & 2.696, 2.708, 2.720, 2.731, 2.742, 2.754, 2.765, 2.776, 2.787, & - & 2.798, 2.808, 2.819, 2.830, 2.840, 2.850, 2.860, 2.871, 2.881, & - & 2.890, 2.900, 2.910, 2.920, 2.929, 2.938, 2.948, 2.957, 2.966, & - & 2.975, 2.984, 2.993, 3.002, 3.011, 3.019, 3.028, 3.036, 3.045, & - & 3.053, 3.061, 3.069, 3.077, 3.085, 3.093, 3.101, 3.109, 3.117, & - & 3.124, 3.132, 3.139, 3.147, 3.154, 3.161, 3.168, 3.176, 3.183, & - & 3.190, 3.197, 3.203, 3.210, 3.217, 3.224, 3.230, 3.237, 3.243, & - & 3.250, 3.256, 3.263, 3.269, 3.275, 3.281, 3.287, 3.293, 3.299, & - & 3.305, 3.311, 3.317, 3.323, 3.329, 3.334, 3.340, 3.345, 3.351, & - & 3.356, 3.362, 3.367 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.098,-0.214,-0.273,-0.315,-0.347,-0.375,-0.399,-0.419,-0.438, & - -0.455,-0.470,-0.485,-0.498,-0.511,-0.522,-0.533,-0.544,-0.554, & - -0.563,-0.572,-0.581,-0.590,-0.598,-0.605,-0.613,-0.620,-0.627, & - -0.634,-0.641,-0.647,-0.653,-0.660,-0.666,-0.671,-0.677,-0.683, & - -0.688,-0.693,-0.698,-0.703,-0.708,-0.713,-0.718,-0.723,-0.727, & - -0.732,-0.736,-0.741,-0.745,-0.749,-0.753,-0.757,-0.762,-0.765, & - -0.769,-0.773,-0.777,-0.781,-0.784,-0.788,-0.792,-0.795,-0.799, & - -0.802,-0.806,-0.809,-0.812,-0.816,-0.819,-0.822,-0.825,-0.829, & - -0.832,-0.835,-0.838,-0.841,-0.844,-0.847,-0.850,-0.853,-0.856, & - -0.859,-0.862,-0.865,-0.867,-0.870,-0.873,-0.876,-0.879,-0.881, & - -0.884,-0.887,-0.890,-0.892,-0.895,-0.898,-0.900,-0.903,-0.905, & - -0.908,-0.911,-0.913,-0.916,-0.918,-0.921,-0.923,-0.926,-0.928, & - -0.931,-0.933,-0.936,-0.938,-0.940,-0.943,-0.945,-0.948,-0.950, & - -0.952,-0.955,-0.957,-0.959,-0.962,-0.964,-0.966,-0.969,-0.971, & - -0.973,-0.975,-0.978,-0.980,-0.982,-0.984,-0.986,-0.989,-0.991, & - -0.993,-0.995,-0.997,-0.999,-1.002,-1.004,-1.006,-1.008,-1.010, & - -1.012,-1.014,-1.016,-1.018,-1.020,-1.022,-1.024,-1.026,-1.028, & - -1.030,-1.032,-1.034,-1.036,-1.038,-1.040,-1.042,-1.044,-1.046, & - -1.048,-1.050,-1.052,-1.054,-1.056,-1.058,-1.060,-1.062,-1.064, & - -1.066,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079,-1.080, & - -1.082,-1.084,-1.086,-1.088,-1.090,-1.091,-1.093,-1.095,-1.097, & - -1.099,-1.100,-1.102,-1.104,-1.106,-1.107,-1.109,-1.111,-1.113, & - -1.114,-1.116,-1.118,-1.120,-1.121,-1.123,-1.125,-1.127,-1.128, & - -1.130,-1.132,-1.133,-1.135,-1.137,-1.138,-1.140,-1.142,-1.143, & - -1.145,-1.147,-1.148,-1.150,-1.152,-1.153,-1.155,-1.157,-1.158, & - -1.160,-1.162,-1.163,-1.165,-1.166,-1.168,-1.170,-1.171,-1.173, & - -1.174,-1.176,-1.178,-1.179,-1.181,-1.182,-1.184,-1.185,-1.187, & - -1.189,-1.190,-1.192,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201, & - -1.203,-1.204,-1.206,-1.207,-1.209,-1.210,-1.212,-1.213,-1.215, & - -1.216,-1.218,-1.219,-1.221,-1.222,-1.224,-1.225,-1.227,-1.228, & - -1.230,-1.231,-1.233,-1.234,-1.236,-1.237,-1.238,-1.240,-1.241, & - -1.243,-1.244,-1.246,-1.247,-1.249,-1.250,-1.252,-1.253,-1.254, & - -1.256,-1.257,-1.259,-1.260,-1.262,-1.263,-1.264,-1.266,-1.267, & - -1.269,-1.270,-1.271,-1.273,-1.274,-1.276,-1.277,-1.278,-1.280, & - -1.281,-1.283,-1.284,-1.285,-1.287,-1.288,-1.290,-1.291,-1.292, & - -1.294,-1.295,-1.296,-1.298,-1.299,-1.301,-1.302,-1.303,-1.305, & - -1.306,-1.307,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.317, & - -1.318,-1.319,-1.321,-1.322,-1.323,-1.325,-1.326,-1.327,-1.329, & - -1.330,-1.331,-1.333,-1.334,-1.335,-1.337,-1.338,-1.339,-1.341, & - -1.342,-1.343,-1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352, & - -1.354,-1.355,-1.356,-1.357,-1.359,-1.360,-1.361,-1.363,-1.364, & - -1.365,-1.366,-1.368,-1.369,-1.370,-1.371,-1.373,-1.374,-1.375, & - -1.376,-1.378,-1.379,-1.380,-1.381,-1.383,-1.384,-1.385,-1.387, & - -1.388,-1.389,-1.390,-1.391,-1.393,-1.394,-1.395,-1.396,-1.398, & - -1.399,-1.400,-1.401,-1.403,-1.416,-1.428,-1.440,-1.452,-1.463, & - -1.475,-1.487,-1.498,-1.509,-1.520,-1.532,-1.543,-1.554,-1.564, & - -1.575,-1.586,-1.596,-1.607,-1.617,-1.628,-1.638,-1.648,-1.659, & - -1.669,-1.679,-1.689,-1.699,-1.709,-1.719,-1.729,-1.738,-1.748, & - -1.758,-1.767,-1.777,-1.786,-1.796,-1.805,-1.815,-1.824,-1.833, & - -1.843,-1.852,-1.861,-1.870,-1.879,-1.888,-1.897,-1.906,-1.915, & - -1.924,-1.933,-1.942,-1.951,-1.960,-1.969,-1.977,-1.986,-1.995, & - -2.004,-2.012,-2.021,-2.029,-2.038,-2.047,-2.055,-2.064,-2.072, & - -2.081,-2.089,-2.097,-2.106,-2.114,-2.123,-2.131,-2.139,-2.147, & - -2.156,-2.164,-2.172,-2.180,-2.189,-2.197,-2.205,-2.213,-2.221, & - -2.229,-2.237,-2.245,-2.253,-2.261,-2.269,-2.277,-2.285,-2.293, & - -2.301,-2.309,-2.317,-2.325,-2.333,-2.341,-2.349,-2.356,-2.364, & - -2.372,-2.380,-2.388,-2.395,-2.403,-2.411,-2.419,-2.426,-2.434, & - -2.442,-2.449,-2.457,-2.465,-2.472,-2.480,-2.488,-2.495,-2.503, & - -2.510,-2.518,-2.525,-2.533,-2.541,-2.548,-2.556,-2.563,-2.571, & - -2.578,-2.586,-2.593,-2.600,-2.608,-2.615,-2.623,-2.630,-2.638, & - -2.645,-2.652,-2.660,-2.667,-2.674,-2.682,-2.689,-2.696,-2.704, & - -2.711,-2.718,-2.726,-2.733,-2.740,-2.747,-2.755,-2.762,-2.769, & - -2.776,-2.784,-2.791 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.048,-0.102,-0.127,-0.145,-0.158,-0.169,-0.178,-0.185,-0.192, & - -0.198,-0.203,-0.207,-0.211,-0.215,-0.218,-0.221,-0.224,-0.226, & - -0.228,-0.230,-0.231,-0.232,-0.234,-0.235,-0.235,-0.236,-0.237, & - -0.237,-0.237,-0.237,-0.237,-0.237,-0.237,-0.236,-0.236,-0.235, & - -0.234,-0.234,-0.233,-0.232,-0.231,-0.230,-0.228,-0.227,-0.226, & - -0.224,-0.223,-0.221,-0.220,-0.218,-0.216,-0.214,-0.212,-0.210, & - -0.208,-0.206,-0.204,-0.202,-0.200,-0.198,-0.196,-0.193,-0.191, & - -0.189,-0.186,-0.184,-0.181,-0.179,-0.176,-0.173,-0.171,-0.168, & - -0.165,-0.163,-0.160,-0.157,-0.154,-0.151,-0.148,-0.146,-0.143, & - -0.140,-0.137,-0.133,-0.130,-0.127,-0.124,-0.121,-0.118,-0.115, & - -0.111,-0.108,-0.105,-0.101,-0.098,-0.095,-0.091,-0.088,-0.084, & - -0.081,-0.077,-0.074,-0.070,-0.067,-0.063,-0.060,-0.056,-0.052, & - -0.049,-0.045,-0.042,-0.038,-0.034,-0.031,-0.027,-0.023,-0.020, & - -0.016,-0.012,-0.008,-0.005,-0.001, 0.003, 0.006, 0.010, 0.014, & - & 0.018, 0.021, 0.025, 0.029, 0.032, 0.036, 0.040, 0.043, 0.047, & - & 0.051, 0.054, 0.058, 0.062, 0.065, 0.069, 0.073, 0.076, 0.080, & - & 0.084, 0.087, 0.091, 0.094, 0.098, 0.102, 0.105, 0.109, 0.112, & - & 0.116, 0.119, 0.123, 0.127, 0.130, 0.134, 0.137, 0.141, 0.144, & - & 0.148, 0.151, 0.155, 0.158, 0.162, 0.165, 0.168, 0.172, 0.175, & - & 0.179, 0.182, 0.186, 0.189, 0.192, 0.196, 0.199, 0.202, 0.206, & - & 0.209, 0.212, 0.216, 0.219, 0.222, 0.226, 0.229, 0.232, 0.236, & - & 0.239, 0.242, 0.245, 0.249, 0.252, 0.255, 0.258, 0.262, 0.265, & - & 0.268, 0.271, 0.274, 0.278, 0.281, 0.284, 0.287, 0.290, 0.293, & - & 0.297, 0.300, 0.303, 0.306, 0.309, 0.312, 0.315, 0.318, 0.321, & - & 0.324, 0.327, 0.330, 0.334, 0.337, 0.340, 0.343, 0.346, 0.349, & - & 0.352, 0.355, 0.358, 0.361, 0.364, 0.367, 0.369, 0.372, 0.375, & - & 0.378, 0.381, 0.384, 0.387, 0.390, 0.393, 0.396, 0.399, 0.402, & - & 0.404, 0.407, 0.410, 0.413, 0.416, 0.419, 0.422, 0.424, 0.427, & - & 0.430, 0.433, 0.436, 0.438, 0.441, 0.444, 0.447, 0.450, 0.452, & - & 0.455, 0.458, 0.461, 0.463, 0.466, 0.469, 0.471, 0.474, 0.477, & - & 0.480, 0.482, 0.485, 0.488, 0.490, 0.493, 0.496, 0.498, 0.501, & - & 0.504, 0.506, 0.509, 0.512, 0.514, 0.517, 0.519, 0.522, 0.525, & - & 0.527, 0.530, 0.532, 0.535, 0.538, 0.540, 0.543, 0.545, 0.548, & - & 0.550, 0.553, 0.555, 0.558, 0.560, 0.563, 0.566, 0.568, 0.571, & - & 0.573, 0.576, 0.578, 0.581, 0.583, 0.585, 0.588, 0.590, 0.593, & - & 0.595, 0.598, 0.600, 0.603, 0.605, 0.607, 0.610, 0.612, 0.615, & - & 0.617, 0.620, 0.622, 0.624, 0.627, 0.629, 0.632, 0.634, 0.636, & - & 0.639, 0.641, 0.643, 0.646, 0.648, 0.650, 0.653, 0.655, 0.657, & - & 0.660, 0.662, 0.664, 0.667, 0.669, 0.671, 0.674, 0.676, 0.678, & - & 0.680, 0.683, 0.685, 0.687, 0.689, 0.692, 0.694, 0.696, 0.699, & - & 0.701, 0.703, 0.705, 0.707, 0.710, 0.712, 0.714, 0.716, 0.719, & - & 0.721, 0.723, 0.725, 0.727, 0.730, 0.732, 0.734, 0.736, 0.738, & - & 0.740, 0.743, 0.745, 0.747, 0.749, 0.751, 0.753, 0.755, 0.758, & - & 0.760, 0.762, 0.764, 0.766, 0.768, 0.770, 0.772, 0.775, 0.777, & - & 0.779, 0.781, 0.783, 0.785, 0.807, 0.828, 0.848, 0.867, 0.886, & - & 0.905, 0.924, 0.942, 0.960, 0.978, 0.995, 1.013, 1.029, 1.046, & - & 1.062, 1.079, 1.095, 1.110, 1.126, 1.141, 1.156, 1.171, 1.185, & - & 1.200, 1.214, 1.228, 1.242, 1.256, 1.269, 1.282, 1.295, 1.308, & - & 1.321, 1.334, 1.346, 1.359, 1.371, 1.383, 1.395, 1.406, 1.418, & - & 1.429, 1.441, 1.452, 1.463, 1.474, 1.485, 1.495, 1.506, 1.516, & - & 1.527, 1.537, 1.547, 1.557, 1.567, 1.577, 1.586, 1.596, 1.605, & - & 1.615, 1.624, 1.633, 1.642, 1.651, 1.660, 1.669, 1.678, 1.686, & - & 1.695, 1.703, 1.711, 1.720, 1.728, 1.736, 1.744, 1.752, 1.760, & - & 1.768, 1.775, 1.783, 1.791, 1.798, 1.806, 1.813, 1.820, 1.828, & - & 1.835, 1.842, 1.849, 1.856, 1.863, 1.870, 1.876, 1.883, 1.890, & - & 1.896, 1.903, 1.909, 1.916, 1.922, 1.928, 1.935, 1.941, 1.947, & - & 1.953, 1.959, 1.965, 1.971, 1.977, 1.983, 1.989, 1.994, 2.000, & - & 2.006, 2.011, 2.017, 2.022, 2.028, 2.033, 2.039, 2.044, 2.049, & - & 2.054, 2.060, 2.065, 2.070, 2.075, 2.080, 2.085, 2.090, 2.095, & - & 2.100, 2.104, 2.109, 2.114, 2.119, 2.123, 2.128, 2.132, 2.137, & - & 2.142, 2.146, 2.150, 2.155, 2.159, 2.164, 2.168, 2.172, 2.176, & - & 2.181, 2.185, 2.189, 2.193, 2.197, 2.201, 2.205, 2.209, 2.213, & - & 2.217, 2.221, 2.225 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.051,-0.116,-0.152,-0.180,-0.203,-0.223,-0.241,-0.257,-0.272, & - -0.286,-0.300,-0.313,-0.325,-0.336,-0.348,-0.359,-0.369,-0.379, & - -0.389,-0.399,-0.408,-0.417,-0.426,-0.435,-0.444,-0.452,-0.460, & - -0.468,-0.476,-0.484,-0.492,-0.499,-0.507,-0.514,-0.521,-0.528, & - -0.535,-0.542,-0.548,-0.555,-0.562,-0.568,-0.574,-0.580,-0.587, & - -0.593,-0.599,-0.604,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638, & - -0.644,-0.649,-0.654,-0.659,-0.664,-0.670,-0.675,-0.680,-0.684, & - -0.689,-0.694,-0.699,-0.704,-0.708,-0.713,-0.718,-0.722,-0.727, & - -0.731,-0.736,-0.740,-0.745,-0.749,-0.754,-0.758,-0.763,-0.767, & - -0.771,-0.776,-0.780,-0.784,-0.788,-0.793,-0.797,-0.801,-0.805, & - -0.810,-0.814,-0.818,-0.822,-0.826,-0.830,-0.834,-0.839,-0.843, & - -0.847,-0.851,-0.855,-0.859,-0.863,-0.867,-0.871,-0.875,-0.879, & - -0.883,-0.887,-0.891,-0.895,-0.899,-0.903,-0.907,-0.910,-0.914, & - -0.918,-0.922,-0.926,-0.930,-0.933,-0.937,-0.941,-0.945,-0.948, & - -0.952,-0.956,-0.959,-0.963,-0.967,-0.970,-0.974,-0.977,-0.981, & - -0.985,-0.988,-0.992,-0.995,-0.999,-1.002,-1.006,-1.009,-1.012, & - -1.016,-1.019,-1.023,-1.026,-1.029,-1.033,-1.036,-1.039,-1.042, & - -1.046,-1.049,-1.052,-1.055,-1.059,-1.062,-1.065,-1.068,-1.071, & - -1.074,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093,-1.096,-1.099, & - -1.102,-1.105,-1.108,-1.111,-1.114,-1.117,-1.120,-1.123,-1.126, & - -1.129,-1.131,-1.134,-1.137,-1.140,-1.143,-1.146,-1.149,-1.151, & - -1.154,-1.157,-1.160,-1.162,-1.165,-1.168,-1.171,-1.173,-1.176, & - -1.179,-1.181,-1.184,-1.187,-1.189,-1.192,-1.195,-1.197,-1.200, & - -1.202,-1.205,-1.207,-1.210,-1.213,-1.215,-1.218,-1.220,-1.223, & - -1.225,-1.228,-1.230,-1.233,-1.235,-1.237,-1.240,-1.242,-1.245, & - -1.247,-1.250,-1.252,-1.254,-1.257,-1.259,-1.261,-1.264,-1.266, & - -1.268,-1.271,-1.273,-1.275,-1.278,-1.280,-1.282,-1.284,-1.287, & - -1.289,-1.291,-1.293,-1.296,-1.298,-1.300,-1.302,-1.304,-1.307, & - -1.309,-1.311,-1.313,-1.315,-1.317,-1.319,-1.322,-1.324,-1.326, & - -1.328,-1.330,-1.332,-1.334,-1.336,-1.338,-1.340,-1.342,-1.344, & - -1.346,-1.348,-1.350,-1.352,-1.354,-1.356,-1.358,-1.360,-1.362, & - -1.364,-1.366,-1.368,-1.370,-1.372,-1.374,-1.376,-1.378,-1.380, & - -1.382,-1.384,-1.385,-1.387,-1.389,-1.391,-1.393,-1.395,-1.397, & - -1.398,-1.400,-1.402,-1.404,-1.406,-1.408,-1.409,-1.411,-1.413, & - -1.415,-1.417,-1.418,-1.420,-1.422,-1.424,-1.425,-1.427,-1.429, & - -1.431,-1.432,-1.434,-1.436,-1.437,-1.439,-1.441,-1.443,-1.444, & - -1.446,-1.448,-1.449,-1.451,-1.453,-1.454,-1.456,-1.458,-1.459, & - -1.461,-1.462,-1.464,-1.466,-1.467,-1.469,-1.470,-1.472,-1.474, & - -1.475,-1.477,-1.478,-1.480,-1.482,-1.483,-1.485,-1.486,-1.488, & - -1.489,-1.491,-1.492,-1.494,-1.495,-1.497,-1.498,-1.500,-1.501, & - -1.503,-1.504,-1.506,-1.507,-1.509,-1.510,-1.512,-1.513,-1.515, & - -1.516,-1.518,-1.519,-1.521,-1.522,-1.523,-1.525,-1.526,-1.528, & - -1.529,-1.530,-1.532,-1.533,-1.535,-1.536,-1.537,-1.539,-1.540, & - -1.542,-1.543,-1.544,-1.546,-1.547,-1.548,-1.550,-1.551,-1.553, & - -1.554,-1.555,-1.557,-1.558,-1.572,-1.585,-1.597,-1.609,-1.621, & - -1.632,-1.643,-1.654,-1.665,-1.675,-1.685,-1.695,-1.705,-1.714, & - -1.723,-1.732,-1.741,-1.750,-1.758,-1.766,-1.774,-1.782,-1.790, & - -1.798,-1.805,-1.813,-1.820,-1.827,-1.834,-1.841,-1.848,-1.855, & - -1.861,-1.868,-1.874,-1.881,-1.887,-1.893,-1.899,-1.905,-1.911, & - -1.917,-1.923,-1.929,-1.934,-1.940,-1.945,-1.951,-1.956,-1.962, & - -1.967,-1.972,-1.977,-1.982,-1.988,-1.993,-1.998,-2.003,-2.008, & - -2.012,-2.017,-2.022,-2.027,-2.032,-2.036,-2.041,-2.046,-2.050, & - -2.055,-2.059,-2.064,-2.068,-2.073,-2.077,-2.082,-2.086,-2.090, & - -2.095,-2.099,-2.103,-2.108,-2.112,-2.116,-2.120,-2.124,-2.128, & - -2.133,-2.137,-2.141,-2.145,-2.149,-2.153,-2.157,-2.161,-2.165, & - -2.169,-2.173,-2.177,-2.181,-2.185,-2.189,-2.192,-2.196,-2.200, & - -2.204,-2.208,-2.212,-2.216,-2.219,-2.223,-2.227,-2.231,-2.234, & - -2.238,-2.242,-2.246,-2.249,-2.253,-2.257,-2.260,-2.264,-2.268, & - -2.271,-2.275,-2.279,-2.282,-2.286,-2.289,-2.293,-2.297,-2.300, & - -2.304,-2.307,-2.311,-2.315,-2.318,-2.322,-2.325,-2.329,-2.332, & - -2.336,-2.339,-2.343,-2.346,-2.350,-2.353,-2.357,-2.360,-2.364, & - -2.367,-2.370,-2.374,-2.377,-2.381,-2.384,-2.388,-2.391,-2.395, & - -2.398,-2.401,-2.405 & - / - -! *** KCL - - DATA BNC20M/ & - -0.048,-0.103,-0.129,-0.147,-0.160,-0.171,-0.180,-0.188,-0.195, & - -0.201,-0.206,-0.210,-0.215,-0.218,-0.222,-0.225,-0.228,-0.230, & - -0.233,-0.235,-0.237,-0.239,-0.241,-0.242,-0.244,-0.245,-0.247, & - -0.248,-0.249,-0.250,-0.251,-0.252,-0.253,-0.254,-0.255,-0.256, & - -0.256,-0.257,-0.258,-0.258,-0.259,-0.260,-0.260,-0.261,-0.261, & - -0.261,-0.262,-0.262,-0.263,-0.263,-0.263,-0.264,-0.264,-0.264, & - -0.265,-0.265,-0.265,-0.265,-0.266,-0.266,-0.266,-0.266,-0.266, & - -0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267, & - -0.267,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268,-0.268, & - -0.268,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267,-0.267, & - -0.267,-0.267,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265,-0.265, & - -0.265,-0.265,-0.265,-0.264,-0.264,-0.264,-0.264,-0.263,-0.263, & - -0.263,-0.262,-0.262,-0.262,-0.261,-0.261,-0.261,-0.260,-0.260, & - -0.260,-0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.257,-0.257, & - -0.257,-0.256,-0.256,-0.256,-0.255,-0.255,-0.254,-0.254,-0.254, & - -0.253,-0.253,-0.253,-0.252,-0.252,-0.251,-0.251,-0.251,-0.250, & - -0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.247,-0.247,-0.247, & - -0.246,-0.246,-0.246,-0.245,-0.245,-0.244,-0.244,-0.244,-0.243, & - -0.243,-0.242,-0.242,-0.242,-0.241,-0.241,-0.240,-0.240,-0.240, & - -0.239,-0.239,-0.238,-0.238,-0.238,-0.237,-0.237,-0.236,-0.236, & - -0.236,-0.235,-0.235,-0.234,-0.234,-0.234,-0.233,-0.233,-0.232, & - -0.232,-0.232,-0.231,-0.231,-0.230,-0.230,-0.230,-0.229,-0.229, & - -0.228,-0.228,-0.228,-0.227,-0.227,-0.227,-0.226,-0.226,-0.225, & - -0.225,-0.225,-0.224,-0.224,-0.223,-0.223,-0.223,-0.222,-0.222, & - -0.221,-0.221,-0.221,-0.220,-0.220,-0.220,-0.219,-0.219,-0.218, & - -0.218,-0.218,-0.217,-0.217,-0.217,-0.216,-0.216,-0.215,-0.215, & - -0.215,-0.214,-0.214,-0.214,-0.213,-0.213,-0.212,-0.212,-0.212, & - -0.211,-0.211,-0.211,-0.210,-0.210,-0.209,-0.209,-0.209,-0.208, & - -0.208,-0.208,-0.207,-0.207,-0.207,-0.206,-0.206,-0.205,-0.205, & - -0.205,-0.204,-0.204,-0.204,-0.203,-0.203,-0.203,-0.202,-0.202, & - -0.202,-0.201,-0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.199, & - -0.198,-0.198,-0.198,-0.197,-0.197,-0.197,-0.196,-0.196,-0.196, & - -0.195,-0.195,-0.195,-0.194,-0.194,-0.194,-0.193,-0.193,-0.193, & - -0.192,-0.192,-0.192,-0.191,-0.191,-0.191,-0.190,-0.190,-0.190, & - -0.189,-0.189,-0.189,-0.188,-0.188,-0.188,-0.187,-0.187,-0.187, & - -0.186,-0.186,-0.186,-0.186,-0.185,-0.185,-0.185,-0.184,-0.184, & - -0.184,-0.183,-0.183,-0.183,-0.182,-0.182,-0.182,-0.181,-0.181, & - -0.181,-0.181,-0.180,-0.180,-0.180,-0.179,-0.179,-0.179,-0.178, & - -0.178,-0.178,-0.178,-0.177,-0.177,-0.177,-0.176,-0.176,-0.176, & - -0.175,-0.175,-0.175,-0.175,-0.174,-0.174,-0.174,-0.173,-0.173, & - -0.173,-0.173,-0.172,-0.172,-0.172,-0.171,-0.171,-0.171,-0.171, & - -0.170,-0.170,-0.170,-0.169,-0.169,-0.169,-0.169,-0.168,-0.168, & - -0.168,-0.167,-0.167,-0.167,-0.167,-0.166,-0.166,-0.166,-0.166, & - -0.165,-0.165,-0.165,-0.164,-0.164,-0.164,-0.164,-0.163,-0.163, & - -0.163,-0.163,-0.162,-0.162,-0.159,-0.157,-0.154,-0.152,-0.149, & - -0.147,-0.145,-0.143,-0.141,-0.139,-0.137,-0.135,-0.133,-0.131, & - -0.129,-0.127,-0.126,-0.124,-0.122,-0.121,-0.119,-0.118,-0.116, & - -0.115,-0.114,-0.112,-0.111,-0.110,-0.109,-0.107,-0.106,-0.105, & - -0.104,-0.103,-0.102,-0.101,-0.100,-0.099,-0.099,-0.098,-0.097, & - -0.096,-0.095,-0.095,-0.094,-0.093,-0.093,-0.092,-0.092,-0.091, & - -0.091,-0.090,-0.090,-0.089,-0.089,-0.089,-0.088,-0.088,-0.088, & - -0.087,-0.087,-0.087,-0.087,-0.087,-0.086,-0.086,-0.086,-0.086, & - -0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086,-0.086, & - -0.086,-0.086,-0.086,-0.087,-0.087,-0.087,-0.087,-0.087,-0.088, & - -0.088,-0.088,-0.088,-0.089,-0.089,-0.089,-0.090,-0.090,-0.090, & - -0.091,-0.091,-0.092,-0.092,-0.092,-0.093,-0.093,-0.094,-0.094, & - -0.095,-0.095,-0.096,-0.096,-0.097,-0.098,-0.098,-0.099,-0.099, & - -0.100,-0.101,-0.101,-0.102,-0.103,-0.103,-0.104,-0.105,-0.105, & - -0.106,-0.107,-0.107,-0.108,-0.109,-0.110,-0.111,-0.111,-0.112, & - -0.113,-0.114,-0.115,-0.115,-0.116,-0.117,-0.118,-0.119,-0.120, & - -0.121,-0.122,-0.122,-0.123,-0.124,-0.125,-0.126,-0.127,-0.128, & - -0.129,-0.130,-0.131,-0.132,-0.133,-0.134,-0.135,-0.136,-0.137, & - -0.138,-0.139,-0.140 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.195,-0.422,-0.535,-0.614,-0.676,-0.727,-0.770,-0.808,-0.841, & - -0.871,-0.898,-0.923,-0.946,-0.968,-0.988,-1.006,-1.024,-1.041, & - -1.056,-1.071,-1.085,-1.099,-1.112,-1.124,-1.136,-1.148,-1.159, & - -1.169,-1.179,-1.189,-1.199,-1.208,-1.217,-1.226,-1.234,-1.243, & - -1.251,-1.258,-1.266,-1.273,-1.281,-1.288,-1.295,-1.302,-1.308, & - -1.315,-1.321,-1.327,-1.333,-1.339,-1.345,-1.351,-1.357,-1.362, & - -1.368,-1.373,-1.379,-1.384,-1.389,-1.394,-1.399,-1.404,-1.409, & - -1.413,-1.418,-1.423,-1.427,-1.432,-1.436,-1.441,-1.445,-1.449, & - -1.454,-1.458,-1.462,-1.466,-1.470,-1.474,-1.478,-1.482,-1.486, & - -1.489,-1.493,-1.497,-1.500,-1.504,-1.508,-1.511,-1.515,-1.518, & - -1.522,-1.525,-1.528,-1.532,-1.535,-1.538,-1.541,-1.545,-1.548, & - -1.551,-1.554,-1.557,-1.560,-1.563,-1.566,-1.569,-1.572,-1.575, & - -1.578,-1.581,-1.584,-1.586,-1.589,-1.592,-1.595,-1.598,-1.600, & - -1.603,-1.606,-1.608,-1.611,-1.614,-1.616,-1.619,-1.621,-1.624, & - -1.626,-1.629,-1.631,-1.634,-1.636,-1.639,-1.641,-1.644,-1.646, & - -1.649,-1.651,-1.653,-1.656,-1.658,-1.660,-1.663,-1.665,-1.667, & - -1.670,-1.672,-1.674,-1.676,-1.679,-1.681,-1.683,-1.685,-1.688, & - -1.690,-1.692,-1.694,-1.696,-1.698,-1.701,-1.703,-1.705,-1.707, & - -1.709,-1.711,-1.713,-1.715,-1.717,-1.720,-1.722,-1.724,-1.726, & - -1.728,-1.730,-1.732,-1.734,-1.736,-1.738,-1.740,-1.742,-1.744, & - -1.746,-1.748,-1.750,-1.752,-1.754,-1.756,-1.757,-1.759,-1.761, & - -1.763,-1.765,-1.767,-1.769,-1.771,-1.773,-1.775,-1.776,-1.778, & - -1.780,-1.782,-1.784,-1.786,-1.788,-1.789,-1.791,-1.793,-1.795, & - -1.797,-1.799,-1.800,-1.802,-1.804,-1.806,-1.808,-1.809,-1.811, & - -1.813,-1.815,-1.816,-1.818,-1.820,-1.822,-1.823,-1.825,-1.827, & - -1.829,-1.830,-1.832,-1.834,-1.836,-1.837,-1.839,-1.841,-1.842, & - -1.844,-1.846,-1.848,-1.849,-1.851,-1.853,-1.854,-1.856,-1.858, & - -1.859,-1.861,-1.863,-1.864,-1.866,-1.868,-1.869,-1.871,-1.873, & - -1.874,-1.876,-1.878,-1.879,-1.881,-1.882,-1.884,-1.886,-1.887, & - -1.889,-1.891,-1.892,-1.894,-1.895,-1.897,-1.899,-1.900,-1.902, & - -1.903,-1.905,-1.907,-1.908,-1.910,-1.911,-1.913,-1.915,-1.916, & - -1.918,-1.919,-1.921,-1.922,-1.924,-1.925,-1.927,-1.929,-1.930, & - -1.932,-1.933,-1.935,-1.936,-1.938,-1.939,-1.941,-1.943,-1.944, & - -1.946,-1.947,-1.949,-1.950,-1.952,-1.953,-1.955,-1.956,-1.958, & - -1.959,-1.961,-1.962,-1.964,-1.965,-1.967,-1.968,-1.970,-1.971, & - -1.973,-1.974,-1.976,-1.977,-1.979,-1.980,-1.982,-1.983,-1.985, & - -1.986,-1.988,-1.989,-1.991,-1.992,-1.994,-1.995,-1.997,-1.998, & - -2.000,-2.001,-2.003,-2.004,-2.006,-2.007,-2.008,-2.010,-2.011, & - -2.013,-2.014,-2.016,-2.017,-2.019,-2.020,-2.022,-2.023,-2.024, & - -2.026,-2.027,-2.029,-2.030,-2.032,-2.033,-2.035,-2.036,-2.037, & - -2.039,-2.040,-2.042,-2.043,-2.045,-2.046,-2.047,-2.049,-2.050, & - -2.052,-2.053,-2.055,-2.056,-2.057,-2.059,-2.060,-2.062,-2.063, & - -2.065,-2.066,-2.067,-2.069,-2.070,-2.072,-2.073,-2.074,-2.076, & - -2.077,-2.079,-2.080,-2.081,-2.083,-2.084,-2.086,-2.087,-2.088, & - -2.090,-2.091,-2.093,-2.094,-2.109,-2.123,-2.137,-2.150,-2.164, & - -2.177,-2.191,-2.204,-2.217,-2.231,-2.244,-2.257,-2.270,-2.283, & - -2.296,-2.309,-2.322,-2.335,-2.348,-2.361,-2.374,-2.386,-2.399, & - -2.412,-2.425,-2.437,-2.450,-2.463,-2.475,-2.488,-2.500,-2.513, & - -2.525,-2.538,-2.550,-2.563,-2.575,-2.588,-2.600,-2.612,-2.625, & - -2.637,-2.650,-2.662,-2.674,-2.686,-2.699,-2.711,-2.723,-2.736, & - -2.748,-2.760,-2.772,-2.784,-2.797,-2.809,-2.821,-2.833,-2.845, & - -2.857,-2.870,-2.882,-2.894,-2.906,-2.918,-2.930,-2.942,-2.954, & - -2.966,-2.978,-2.991,-3.003,-3.015,-3.027,-3.039,-3.051,-3.063, & - -3.075,-3.087,-3.099,-3.111,-3.123,-3.135,-3.147,-3.159,-3.171, & - -3.182,-3.194,-3.206,-3.218,-3.230,-3.242,-3.254,-3.266,-3.278, & - -3.290,-3.302,-3.314,-3.325,-3.337,-3.349,-3.361,-3.373,-3.385, & - -3.397,-3.409,-3.420,-3.432,-3.444,-3.456,-3.468,-3.480,-3.491, & - -3.503,-3.515,-3.527,-3.539,-3.551,-3.562,-3.574,-3.586,-3.598, & - -3.609,-3.621,-3.633,-3.645,-3.657,-3.668,-3.680,-3.692,-3.704, & - -3.715,-3.727,-3.739,-3.751,-3.762,-3.774,-3.786,-3.798,-3.809, & - -3.821,-3.833,-3.844,-3.856,-3.868,-3.880,-3.891,-3.903,-3.915, & - -3.926,-3.938,-3.950,-3.961,-3.973,-3.985,-3.997,-4.008,-4.020, & - -4.032,-4.043,-4.055 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.095,-0.197,-0.243,-0.273,-0.294,-0.311,-0.323,-0.333,-0.342, & - -0.348,-0.353,-0.358,-0.361,-0.364,-0.366,-0.367,-0.368,-0.368, & - -0.368,-0.368,-0.368,-0.367,-0.366,-0.364,-0.363,-0.361,-0.359, & - -0.357,-0.355,-0.353,-0.351,-0.348,-0.346,-0.343,-0.340,-0.337, & - -0.335,-0.332,-0.329,-0.326,-0.323,-0.320,-0.316,-0.313,-0.310, & - -0.307,-0.304,-0.300,-0.297,-0.294,-0.290,-0.287,-0.284,-0.280, & - -0.277,-0.274,-0.270,-0.267,-0.264,-0.260,-0.257,-0.253,-0.250, & - -0.247,-0.243,-0.240,-0.236,-0.233,-0.229,-0.226,-0.222,-0.219, & - -0.215,-0.211,-0.208,-0.204,-0.200,-0.197,-0.193,-0.189,-0.186, & - -0.182,-0.178,-0.174,-0.170,-0.166,-0.162,-0.158,-0.154,-0.150, & - -0.146,-0.142,-0.138,-0.134,-0.130,-0.125,-0.121,-0.117,-0.113, & - -0.108,-0.104,-0.100,-0.095,-0.091,-0.086,-0.082,-0.077,-0.073, & - -0.068,-0.064,-0.059,-0.055,-0.050,-0.045,-0.041,-0.036,-0.032, & - -0.027,-0.022,-0.018,-0.013,-0.008,-0.004, 0.001, 0.006, 0.010, & - & 0.015, 0.020, 0.024, 0.029, 0.034, 0.039, 0.043, 0.048, 0.053, & - & 0.057, 0.062, 0.067, 0.071, 0.076, 0.081, 0.085, 0.090, 0.095, & - & 0.099, 0.104, 0.109, 0.113, 0.118, 0.122, 0.127, 0.132, 0.136, & - & 0.141, 0.145, 0.150, 0.155, 0.159, 0.164, 0.168, 0.173, 0.178, & - & 0.182, 0.187, 0.191, 0.196, 0.200, 0.205, 0.209, 0.214, 0.218, & - & 0.223, 0.227, 0.232, 0.236, 0.241, 0.245, 0.250, 0.254, 0.259, & - & 0.263, 0.268, 0.272, 0.276, 0.281, 0.285, 0.290, 0.294, 0.299, & - & 0.303, 0.307, 0.312, 0.316, 0.320, 0.325, 0.329, 0.333, 0.338, & - & 0.342, 0.346, 0.351, 0.355, 0.359, 0.364, 0.368, 0.372, 0.377, & - & 0.381, 0.385, 0.389, 0.394, 0.398, 0.402, 0.406, 0.411, 0.415, & - & 0.419, 0.423, 0.427, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, & - & 0.457, 0.461, 0.465, 0.469, 0.473, 0.477, 0.481, 0.485, 0.490, & - & 0.494, 0.498, 0.502, 0.506, 0.510, 0.514, 0.518, 0.522, 0.526, & - & 0.530, 0.534, 0.538, 0.542, 0.546, 0.550, 0.554, 0.558, 0.562, & - & 0.566, 0.570, 0.574, 0.578, 0.582, 0.586, 0.590, 0.594, 0.598, & - & 0.602, 0.605, 0.609, 0.613, 0.617, 0.621, 0.625, 0.629, 0.633, & - & 0.636, 0.640, 0.644, 0.648, 0.652, 0.656, 0.659, 0.663, 0.667, & - & 0.671, 0.674, 0.678, 0.682, 0.686, 0.690, 0.693, 0.697, 0.701, & - & 0.704, 0.708, 0.712, 0.716, 0.719, 0.723, 0.727, 0.730, 0.734, & - & 0.738, 0.741, 0.745, 0.749, 0.752, 0.756, 0.760, 0.763, 0.767, & - & 0.771, 0.774, 0.778, 0.781, 0.785, 0.789, 0.792, 0.796, 0.799, & - & 0.803, 0.806, 0.810, 0.813, 0.817, 0.821, 0.824, 0.828, 0.831, & - & 0.835, 0.838, 0.842, 0.845, 0.849, 0.852, 0.856, 0.859, 0.862, & - & 0.866, 0.869, 0.873, 0.876, 0.880, 0.883, 0.886, 0.890, 0.893, & - & 0.897, 0.900, 0.903, 0.907, 0.910, 0.914, 0.917, 0.920, 0.924, & - & 0.927, 0.930, 0.934, 0.937, 0.940, 0.944, 0.947, 0.950, 0.954, & - & 0.957, 0.960, 0.963, 0.967, 0.970, 0.973, 0.977, 0.980, 0.983, & - & 0.986, 0.990, 0.993, 0.996, 0.999, 1.003, 1.006, 1.009, 1.012, & - & 1.015, 1.019, 1.022, 1.025, 1.028, 1.031, 1.034, 1.038, 1.041, & - & 1.044, 1.047, 1.050, 1.053, 1.056, 1.060, 1.063, 1.066, 1.069, & - & 1.072, 1.075, 1.078, 1.081, 1.114, 1.144, 1.174, 1.203, 1.232, & - & 1.260, 1.288, 1.315, 1.342, 1.369, 1.395, 1.420, 1.446, 1.471, & - & 1.495, 1.519, 1.543, 1.567, 1.590, 1.613, 1.635, 1.657, 1.679, & - & 1.701, 1.722, 1.743, 1.764, 1.784, 1.804, 1.824, 1.844, 1.863, & - & 1.882, 1.901, 1.920, 1.938, 1.956, 1.974, 1.992, 2.009, 2.026, & - & 2.043, 2.060, 2.077, 2.093, 2.109, 2.125, 2.141, 2.157, 2.172, & - & 2.187, 2.202, 2.217, 2.232, 2.246, 2.261, 2.275, 2.289, 2.303, & - & 2.317, 2.330, 2.344, 2.357, 2.370, 2.383, 2.396, 2.408, 2.421, & - & 2.433, 2.445, 2.458, 2.470, 2.481, 2.493, 2.505, 2.516, 2.528, & - & 2.539, 2.550, 2.561, 2.572, 2.583, 2.593, 2.604, 2.614, 2.625, & - & 2.635, 2.645, 2.655, 2.665, 2.675, 2.684, 2.694, 2.704, 2.713, & - & 2.722, 2.732, 2.741, 2.750, 2.759, 2.768, 2.776, 2.785, 2.794, & - & 2.802, 2.811, 2.819, 2.827, 2.835, 2.843, 2.851, 2.859, 2.867, & - & 2.875, 2.883, 2.890, 2.898, 2.906, 2.913, 2.920, 2.928, 2.935, & - & 2.942, 2.949, 2.956, 2.963, 2.970, 2.977, 2.983, 2.990, 2.997, & - & 3.003, 3.010, 3.016, 3.022, 3.029, 3.035, 3.041, 3.047, 3.053, & - & 3.059, 3.065, 3.071, 3.077, 3.083, 3.089, 3.094, 3.100, 3.105, & - & 3.111, 3.116, 3.122, 3.127, 3.133, 3.138, 3.143, 3.148, 3.153, & - & 3.158, 3.163, 3.168 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.094,-0.194,-0.238,-0.266,-0.285,-0.299,-0.310,-0.319,-0.325, & - -0.330,-0.333,-0.336,-0.337,-0.338,-0.338,-0.338,-0.337,-0.336, & - -0.334,-0.332,-0.330,-0.328,-0.325,-0.322,-0.319,-0.315,-0.312, & - -0.308,-0.304,-0.300,-0.296,-0.292,-0.288,-0.283,-0.279,-0.274, & - -0.270,-0.265,-0.261,-0.256,-0.251,-0.247,-0.242,-0.237,-0.232, & - -0.227,-0.222,-0.218,-0.213,-0.208,-0.203,-0.198,-0.193,-0.188, & - -0.183,-0.178,-0.173,-0.168,-0.163,-0.158,-0.153,-0.148,-0.143, & - -0.138,-0.133,-0.128,-0.123,-0.118,-0.113,-0.108,-0.103,-0.097, & - -0.092,-0.087,-0.082,-0.077,-0.071,-0.066,-0.061,-0.055,-0.050, & - -0.045,-0.039,-0.034,-0.028,-0.023,-0.017,-0.011,-0.006, 0.000, & - & 0.006, 0.011, 0.017, 0.023, 0.029, 0.035, 0.041, 0.047, 0.053, & - & 0.059, 0.065, 0.071, 0.077, 0.083, 0.089, 0.096, 0.102, 0.108, & - & 0.114, 0.121, 0.127, 0.133, 0.140, 0.146, 0.152, 0.159, 0.165, & - & 0.171, 0.178, 0.184, 0.191, 0.197, 0.203, 0.210, 0.216, 0.223, & - & 0.229, 0.236, 0.242, 0.249, 0.255, 0.261, 0.268, 0.274, 0.281, & - & 0.287, 0.293, 0.300, 0.306, 0.313, 0.319, 0.325, 0.332, 0.338, & - & 0.345, 0.351, 0.357, 0.364, 0.370, 0.376, 0.383, 0.389, 0.395, & - & 0.402, 0.408, 0.414, 0.421, 0.427, 0.433, 0.439, 0.446, 0.452, & - & 0.458, 0.464, 0.471, 0.477, 0.483, 0.489, 0.495, 0.502, 0.508, & - & 0.514, 0.520, 0.526, 0.532, 0.538, 0.545, 0.551, 0.557, 0.563, & - & 0.569, 0.575, 0.581, 0.587, 0.593, 0.599, 0.605, 0.611, 0.617, & - & 0.623, 0.629, 0.635, 0.641, 0.647, 0.653, 0.659, 0.665, 0.671, & - & 0.677, 0.683, 0.689, 0.694, 0.700, 0.706, 0.712, 0.718, 0.724, & - & 0.730, 0.735, 0.741, 0.747, 0.753, 0.759, 0.764, 0.770, 0.776, & - & 0.782, 0.787, 0.793, 0.799, 0.804, 0.810, 0.816, 0.822, 0.827, & - & 0.833, 0.838, 0.844, 0.850, 0.855, 0.861, 0.867, 0.872, 0.878, & - & 0.883, 0.889, 0.894, 0.900, 0.905, 0.911, 0.916, 0.922, 0.927, & - & 0.933, 0.938, 0.944, 0.949, 0.955, 0.960, 0.966, 0.971, 0.976, & - & 0.982, 0.987, 0.993, 0.998, 1.003, 1.009, 1.014, 1.019, 1.025, & - & 1.030, 1.035, 1.041, 1.046, 1.051, 1.056, 1.062, 1.067, 1.072, & - & 1.077, 1.083, 1.088, 1.093, 1.098, 1.103, 1.109, 1.114, 1.119, & - & 1.124, 1.129, 1.134, 1.139, 1.144, 1.150, 1.155, 1.160, 1.165, & - & 1.170, 1.175, 1.180, 1.185, 1.190, 1.195, 1.200, 1.205, 1.210, & - & 1.215, 1.220, 1.225, 1.230, 1.235, 1.240, 1.245, 1.250, 1.255, & - & 1.260, 1.264, 1.269, 1.274, 1.279, 1.284, 1.289, 1.294, 1.299, & - & 1.303, 1.308, 1.313, 1.318, 1.323, 1.327, 1.332, 1.337, 1.342, & - & 1.346, 1.351, 1.356, 1.361, 1.365, 1.370, 1.375, 1.380, 1.384, & - & 1.389, 1.394, 1.398, 1.403, 1.408, 1.412, 1.417, 1.421, 1.426, & - & 1.431, 1.435, 1.440, 1.444, 1.449, 1.454, 1.458, 1.463, 1.467, & - & 1.472, 1.476, 1.481, 1.485, 1.490, 1.494, 1.499, 1.503, 1.508, & - & 1.512, 1.517, 1.521, 1.526, 1.530, 1.535, 1.539, 1.543, 1.548, & - & 1.552, 1.557, 1.561, 1.565, 1.570, 1.574, 1.578, 1.583, 1.587, & - & 1.591, 1.596, 1.600, 1.604, 1.609, 1.613, 1.617, 1.622, 1.626, & - & 1.630, 1.634, 1.639, 1.643, 1.647, 1.651, 1.656, 1.660, 1.664, & - & 1.668, 1.672, 1.677, 1.681, 1.726, 1.766, 1.807, 1.846, 1.885, & - & 1.923, 1.961, 1.998, 2.034, 2.070, 2.105, 2.140, 2.175, 2.208, & - & 2.242, 2.275, 2.307, 2.339, 2.370, 2.401, 2.432, 2.462, 2.492, & - & 2.521, 2.550, 2.579, 2.607, 2.635, 2.662, 2.690, 2.716, 2.743, & - & 2.769, 2.795, 2.820, 2.845, 2.870, 2.895, 2.919, 2.943, 2.966, & - & 2.990, 3.013, 3.036, 3.058, 3.081, 3.103, 3.124, 3.146, 3.167, & - & 3.188, 3.209, 3.230, 3.250, 3.270, 3.290, 3.310, 3.329, 3.349, & - & 3.368, 3.387, 3.405, 3.424, 3.442, 3.460, 3.478, 3.496, 3.513, & - & 3.531, 3.548, 3.565, 3.582, 3.599, 3.615, 3.631, 3.648, 3.664, & - & 3.680, 3.695, 3.711, 3.726, 3.742, 3.757, 3.772, 3.787, 3.801, & - & 3.816, 3.830, 3.845, 3.859, 3.873, 3.887, 3.901, 3.914, 3.928, & - & 3.941, 3.955, 3.968, 3.981, 3.994, 4.007, 4.019, 4.032, 4.044, & - & 4.057, 4.069, 4.081, 4.093, 4.105, 4.117, 4.129, 4.141, 4.152, & - & 4.164, 4.175, 4.186, 4.197, 4.209, 4.220, 4.230, 4.241, 4.252, & - & 4.263, 4.273, 4.284, 4.294, 4.304, 4.314, 4.324, 4.335, 4.344, & - & 4.354, 4.364, 4.374, 4.383, 4.393, 4.402, 4.412, 4.421, 4.430, & - & 4.440, 4.449, 4.458, 4.467, 4.476, 4.484, 4.493, 4.502, 4.510, & - & 4.519, 4.527, 4.536, 4.544, 4.553, 4.561, 4.569, 4.577, 4.585, & - & 4.593, 4.601, 4.609 & - / - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM273 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 273K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM273 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC273/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM273 - - - BLOCK DATA KMCF273 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC273/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.046,-0.097,-0.119,-0.134,-0.145,-0.153,-0.160,-0.165,-0.169, & - -0.173,-0.176,-0.178,-0.180,-0.181,-0.182,-0.183,-0.184,-0.184, & - -0.185,-0.185,-0.185,-0.185,-0.184,-0.184,-0.183,-0.183,-0.182, & - -0.181,-0.181,-0.180,-0.179,-0.178,-0.177,-0.176,-0.174,-0.173, & - -0.172,-0.171,-0.170,-0.168,-0.167,-0.166,-0.164,-0.163,-0.162, & - -0.160,-0.159,-0.157,-0.156,-0.155,-0.153,-0.152,-0.150,-0.149, & - -0.147,-0.146,-0.144,-0.143,-0.141,-0.140,-0.138,-0.137,-0.135, & - -0.134,-0.132,-0.131,-0.129,-0.128,-0.126,-0.124,-0.123,-0.121, & - -0.120,-0.118,-0.116,-0.115,-0.113,-0.112,-0.110,-0.108,-0.107, & - -0.105,-0.103,-0.101,-0.100,-0.098,-0.096,-0.094,-0.093,-0.091, & - -0.089,-0.087,-0.085,-0.083,-0.081,-0.080,-0.078,-0.076,-0.074, & - -0.072,-0.070,-0.068,-0.066,-0.064,-0.062,-0.060,-0.058,-0.056, & - -0.054,-0.052,-0.050,-0.048,-0.046,-0.044,-0.042,-0.039,-0.037, & - -0.035,-0.033,-0.031,-0.029,-0.027,-0.025,-0.023,-0.021,-0.018, & - -0.016,-0.014,-0.012,-0.010,-0.008,-0.006,-0.004,-0.002, 0.001, & - & 0.003, 0.005, 0.007, 0.009, 0.011, 0.013, 0.015, 0.017, 0.019, & - & 0.022, 0.024, 0.026, 0.028, 0.030, 0.032, 0.034, 0.036, 0.038, & - & 0.040, 0.042, 0.045, 0.047, 0.049, 0.051, 0.053, 0.055, 0.057, & - & 0.059, 0.061, 0.063, 0.065, 0.067, 0.069, 0.071, 0.073, 0.075, & - & 0.078, 0.080, 0.082, 0.084, 0.086, 0.088, 0.090, 0.092, 0.094, & - & 0.096, 0.098, 0.100, 0.102, 0.104, 0.106, 0.108, 0.110, 0.112, & - & 0.114, 0.116, 0.118, 0.120, 0.122, 0.124, 0.126, 0.128, 0.130, & - & 0.132, 0.134, 0.136, 0.138, 0.140, 0.142, 0.143, 0.145, 0.147, & - & 0.149, 0.151, 0.153, 0.155, 0.157, 0.159, 0.161, 0.163, 0.165, & - & 0.167, 0.169, 0.171, 0.172, 0.174, 0.176, 0.178, 0.180, 0.182, & - & 0.184, 0.186, 0.188, 0.190, 0.191, 0.193, 0.195, 0.197, 0.199, & - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.212, 0.214, 0.216, & - & 0.218, 0.219, 0.221, 0.223, 0.225, 0.227, 0.229, 0.230, 0.232, & - & 0.234, 0.236, 0.238, 0.239, 0.241, 0.243, 0.245, 0.247, 0.248, & - & 0.250, 0.252, 0.254, 0.256, 0.257, 0.259, 0.261, 0.263, 0.265, & - & 0.266, 0.268, 0.270, 0.272, 0.273, 0.275, 0.277, 0.279, 0.280, & - & 0.282, 0.284, 0.286, 0.287, 0.289, 0.291, 0.292, 0.294, 0.296, & - & 0.298, 0.299, 0.301, 0.303, 0.305, 0.306, 0.308, 0.310, 0.311, & - & 0.313, 0.315, 0.316, 0.318, 0.320, 0.321, 0.323, 0.325, 0.326, & - & 0.328, 0.330, 0.331, 0.333, 0.335, 0.336, 0.338, 0.340, 0.341, & - & 0.343, 0.345, 0.346, 0.348, 0.350, 0.351, 0.353, 0.355, 0.356, & - & 0.358, 0.359, 0.361, 0.363, 0.364, 0.366, 0.367, 0.369, 0.371, & - & 0.372, 0.374, 0.375, 0.377, 0.379, 0.380, 0.382, 0.383, 0.385, & - & 0.387, 0.388, 0.390, 0.391, 0.393, 0.394, 0.396, 0.398, 0.399, & - & 0.401, 0.402, 0.404, 0.405, 0.407, 0.408, 0.410, 0.412, 0.413, & - & 0.415, 0.416, 0.418, 0.419, 0.421, 0.422, 0.424, 0.425, 0.427, & - & 0.428, 0.430, 0.431, 0.433, 0.434, 0.436, 0.437, 0.439, 0.440, & - & 0.442, 0.443, 0.445, 0.446, 0.448, 0.449, 0.451, 0.452, 0.454, & - & 0.455, 0.457, 0.458, 0.460, 0.461, 0.463, 0.464, 0.465, 0.467, & - & 0.468, 0.470, 0.471, 0.473, 0.488, 0.502, 0.516, 0.530, 0.544, & - & 0.557, 0.570, 0.583, 0.596, 0.608, 0.621, 0.633, 0.645, 0.657, & - & 0.669, 0.680, 0.692, 0.703, 0.714, 0.725, 0.736, 0.747, 0.758, & - & 0.768, 0.778, 0.789, 0.799, 0.809, 0.819, 0.828, 0.838, 0.847, & - & 0.857, 0.866, 0.875, 0.884, 0.893, 0.902, 0.911, 0.920, 0.928, & - & 0.937, 0.945, 0.954, 0.962, 0.970, 0.978, 0.986, 0.994, 1.002, & - & 1.010, 1.017, 1.025, 1.032, 1.040, 1.047, 1.054, 1.062, 1.069, & - & 1.076, 1.083, 1.090, 1.097, 1.103, 1.110, 1.117, 1.124, 1.130, & - & 1.137, 1.143, 1.149, 1.156, 1.162, 1.168, 1.174, 1.181, 1.187, & - & 1.193, 1.199, 1.205, 1.210, 1.216, 1.222, 1.228, 1.233, 1.239, & - & 1.245, 1.250, 1.255, 1.261, 1.266, 1.272, 1.277, 1.282, 1.287, & - & 1.293, 1.298, 1.303, 1.308, 1.313, 1.318, 1.323, 1.328, 1.333, & - & 1.337, 1.342, 1.347, 1.352, 1.356, 1.361, 1.366, 1.370, 1.375, & - & 1.379, 1.384, 1.388, 1.392, 1.397, 1.401, 1.406, 1.410, 1.414, & - & 1.418, 1.422, 1.427, 1.431, 1.435, 1.439, 1.443, 1.447, 1.451, & - & 1.455, 1.459, 1.463, 1.467, 1.470, 1.474, 1.478, 1.482, 1.486, & - & 1.489, 1.493, 1.497, 1.500, 1.504, 1.508, 1.511, 1.515, 1.518, & - & 1.522, 1.525, 1.529, 1.532, 1.536, 1.539, 1.542, 1.546, 1.549, & - & 1.552, 1.556, 1.559 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.096,-0.208,-0.264,-0.304,-0.335,-0.361,-0.383,-0.403,-0.420, & - -0.436,-0.450,-0.464,-0.476,-0.487,-0.498,-0.508,-0.517,-0.526, & - -0.535,-0.543,-0.551,-0.558,-0.566,-0.572,-0.579,-0.586,-0.592, & - -0.598,-0.603,-0.609,-0.614,-0.620,-0.625,-0.630,-0.635,-0.639, & - -0.644,-0.649,-0.653,-0.657,-0.661,-0.666,-0.670,-0.674,-0.677, & - -0.681,-0.685,-0.689,-0.692,-0.696,-0.699,-0.702,-0.706,-0.709, & - -0.712,-0.715,-0.718,-0.721,-0.725,-0.727,-0.730,-0.733,-0.736, & - -0.739,-0.742,-0.744,-0.747,-0.750,-0.752,-0.755,-0.757,-0.760, & - -0.763,-0.765,-0.767,-0.770,-0.772,-0.775,-0.777,-0.779,-0.782, & - -0.784,-0.786,-0.788,-0.791,-0.793,-0.795,-0.797,-0.799,-0.801, & - -0.803,-0.806,-0.808,-0.810,-0.812,-0.814,-0.816,-0.818,-0.820, & - -0.822,-0.824,-0.826,-0.827,-0.829,-0.831,-0.833,-0.835,-0.837, & - -0.839,-0.841,-0.842,-0.844,-0.846,-0.848,-0.850,-0.851,-0.853, & - -0.855,-0.857,-0.858,-0.860,-0.862,-0.863,-0.865,-0.867,-0.868, & - -0.870,-0.872,-0.873,-0.875,-0.877,-0.878,-0.880,-0.881,-0.883, & - -0.885,-0.886,-0.888,-0.889,-0.891,-0.892,-0.894,-0.895,-0.897, & - -0.898,-0.900,-0.901,-0.903,-0.904,-0.906,-0.907,-0.909,-0.910, & - -0.912,-0.913,-0.915,-0.916,-0.917,-0.919,-0.920,-0.922,-0.923, & - -0.924,-0.926,-0.927,-0.928,-0.930,-0.931,-0.933,-0.934,-0.935, & - -0.937,-0.938,-0.939,-0.941,-0.942,-0.943,-0.944,-0.946,-0.947, & - -0.948,-0.950,-0.951,-0.952,-0.953,-0.955,-0.956,-0.957,-0.958, & - -0.960,-0.961,-0.962,-0.963,-0.965,-0.966,-0.967,-0.968,-0.969, & - -0.971,-0.972,-0.973,-0.974,-0.975,-0.977,-0.978,-0.979,-0.980, & - -0.981,-0.982,-0.984,-0.985,-0.986,-0.987,-0.988,-0.989,-0.990, & - -0.992,-0.993,-0.994,-0.995,-0.996,-0.997,-0.998,-0.999,-1.001, & - -1.002,-1.003,-1.004,-1.005,-1.006,-1.007,-1.008,-1.009,-1.010, & - -1.011,-1.012,-1.014,-1.015,-1.016,-1.017,-1.018,-1.019,-1.020, & - -1.021,-1.022,-1.023,-1.024,-1.025,-1.026,-1.027,-1.028,-1.029, & - -1.030,-1.031,-1.032,-1.033,-1.034,-1.035,-1.036,-1.037,-1.038, & - -1.039,-1.040,-1.041,-1.042,-1.043,-1.044,-1.045,-1.046,-1.047, & - -1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.054,-1.055,-1.056, & - -1.057,-1.058,-1.059,-1.060,-1.061,-1.062,-1.063,-1.064,-1.065, & - -1.066,-1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.072,-1.073, & - -1.074,-1.075,-1.076,-1.077,-1.078,-1.079,-1.079,-1.080,-1.081, & - -1.082,-1.083,-1.084,-1.085,-1.086,-1.087,-1.088,-1.088,-1.089, & - -1.090,-1.091,-1.092,-1.093,-1.094,-1.095,-1.096,-1.096,-1.097, & - -1.098,-1.099,-1.100,-1.101,-1.102,-1.102,-1.103,-1.104,-1.105, & - -1.106,-1.107,-1.108,-1.109,-1.109,-1.110,-1.111,-1.112,-1.113, & - -1.114,-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.120,-1.120, & - -1.121,-1.122,-1.123,-1.124,-1.124,-1.125,-1.126,-1.127,-1.128, & - -1.129,-1.129,-1.130,-1.131,-1.132,-1.133,-1.134,-1.134,-1.135, & - -1.136,-1.137,-1.138,-1.138,-1.139,-1.140,-1.141,-1.142,-1.142, & - -1.143,-1.144,-1.145,-1.146,-1.146,-1.147,-1.148,-1.149,-1.150, & - -1.150,-1.151,-1.152,-1.153,-1.153,-1.154,-1.155,-1.156,-1.157, & - -1.157,-1.158,-1.159,-1.160,-1.168,-1.175,-1.183,-1.190,-1.198, & - -1.205,-1.212,-1.219,-1.226,-1.233,-1.239,-1.246,-1.253,-1.259, & - -1.266,-1.272,-1.279,-1.285,-1.291,-1.298,-1.304,-1.310,-1.316, & - -1.322,-1.328,-1.334,-1.340,-1.346,-1.352,-1.357,-1.363,-1.369, & - -1.374,-1.380,-1.386,-1.391,-1.397,-1.402,-1.408,-1.413,-1.419, & - -1.424,-1.429,-1.435,-1.440,-1.445,-1.450,-1.456,-1.461,-1.466, & - -1.471,-1.476,-1.481,-1.486,-1.491,-1.496,-1.501,-1.506,-1.511, & - -1.516,-1.521,-1.526,-1.531,-1.536,-1.541,-1.545,-1.550,-1.555, & - -1.560,-1.564,-1.569,-1.574,-1.579,-1.583,-1.588,-1.593,-1.597, & - -1.602,-1.606,-1.611,-1.616,-1.620,-1.625,-1.629,-1.634,-1.638, & - -1.643,-1.647,-1.652,-1.656,-1.661,-1.665,-1.670,-1.674,-1.678, & - -1.683,-1.687,-1.692,-1.696,-1.700,-1.705,-1.709,-1.713,-1.718, & - -1.722,-1.726,-1.730,-1.735,-1.739,-1.743,-1.747,-1.752,-1.756, & - -1.760,-1.764,-1.768,-1.773,-1.777,-1.781,-1.785,-1.789,-1.793, & - -1.798,-1.802,-1.806,-1.810,-1.814,-1.818,-1.822,-1.826,-1.830, & - -1.834,-1.838,-1.843,-1.847,-1.851,-1.855,-1.859,-1.863,-1.867, & - -1.871,-1.875,-1.879,-1.883,-1.887,-1.891,-1.895,-1.899,-1.902, & - -1.906,-1.910,-1.914,-1.918,-1.922,-1.926,-1.930,-1.934,-1.938, & - -1.942,-1.946,-1.949 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.048,-0.105,-0.133,-0.154,-0.170,-0.183,-0.195,-0.205,-0.214, & - -0.223,-0.230,-0.237,-0.244,-0.250,-0.256,-0.261,-0.266,-0.271, & - -0.276,-0.280,-0.284,-0.289,-0.292,-0.296,-0.300,-0.304,-0.307, & - -0.310,-0.314,-0.317,-0.320,-0.323,-0.326,-0.328,-0.331,-0.334, & - -0.337,-0.339,-0.342,-0.344,-0.347,-0.349,-0.351,-0.353,-0.356, & - -0.358,-0.360,-0.362,-0.364,-0.366,-0.368,-0.370,-0.372,-0.374, & - -0.376,-0.378,-0.379,-0.381,-0.383,-0.385,-0.386,-0.388,-0.390, & - -0.391,-0.393,-0.395,-0.396,-0.398,-0.399,-0.401,-0.402,-0.404, & - -0.405,-0.407,-0.408,-0.410,-0.411,-0.413,-0.414,-0.415,-0.417, & - -0.418,-0.420,-0.421,-0.422,-0.424,-0.425,-0.426,-0.427,-0.429, & - -0.430,-0.431,-0.433,-0.434,-0.435,-0.436,-0.438,-0.439,-0.440, & - -0.441,-0.442,-0.444,-0.445,-0.446,-0.447,-0.448,-0.449,-0.451, & - -0.452,-0.453,-0.454,-0.455,-0.456,-0.457,-0.459,-0.460,-0.461, & - -0.462,-0.463,-0.464,-0.465,-0.466,-0.467,-0.468,-0.469,-0.470, & - -0.472,-0.473,-0.474,-0.475,-0.476,-0.477,-0.478,-0.479,-0.480, & - -0.481,-0.482,-0.483,-0.484,-0.485,-0.486,-0.487,-0.488,-0.489, & - -0.490,-0.490,-0.491,-0.492,-0.493,-0.494,-0.495,-0.496,-0.497, & - -0.498,-0.499,-0.500,-0.501,-0.502,-0.503,-0.503,-0.504,-0.505, & - -0.506,-0.507,-0.508,-0.509,-0.510,-0.510,-0.511,-0.512,-0.513, & - -0.514,-0.515,-0.516,-0.516,-0.517,-0.518,-0.519,-0.520,-0.521, & - -0.521,-0.522,-0.523,-0.524,-0.525,-0.526,-0.526,-0.527,-0.528, & - -0.529,-0.530,-0.530,-0.531,-0.532,-0.533,-0.534,-0.534,-0.535, & - -0.536,-0.537,-0.537,-0.538,-0.539,-0.540,-0.540,-0.541,-0.542, & - -0.543,-0.543,-0.544,-0.545,-0.546,-0.546,-0.547,-0.548,-0.549, & - -0.549,-0.550,-0.551,-0.552,-0.552,-0.553,-0.554,-0.554,-0.555, & - -0.556,-0.557,-0.557,-0.558,-0.559,-0.559,-0.560,-0.561,-0.562, & - -0.562,-0.563,-0.564,-0.564,-0.565,-0.566,-0.566,-0.567,-0.568, & - -0.568,-0.569,-0.570,-0.570,-0.571,-0.572,-0.572,-0.573,-0.574, & - -0.574,-0.575,-0.576,-0.576,-0.577,-0.578,-0.578,-0.579,-0.580, & - -0.580,-0.581,-0.582,-0.582,-0.583,-0.584,-0.584,-0.585,-0.585, & - -0.586,-0.587,-0.587,-0.588,-0.589,-0.589,-0.590,-0.591,-0.591, & - -0.592,-0.592,-0.593,-0.594,-0.594,-0.595,-0.595,-0.596,-0.597, & - -0.597,-0.598,-0.599,-0.599,-0.600,-0.600,-0.601,-0.602,-0.602, & - -0.603,-0.603,-0.604,-0.604,-0.605,-0.606,-0.606,-0.607,-0.607, & - -0.608,-0.609,-0.609,-0.610,-0.610,-0.611,-0.612,-0.612,-0.613, & - -0.613,-0.614,-0.614,-0.615,-0.616,-0.616,-0.617,-0.617,-0.618, & - -0.618,-0.619,-0.619,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623, & - -0.623,-0.624,-0.624,-0.625,-0.626,-0.626,-0.627,-0.627,-0.628, & - -0.628,-0.629,-0.629,-0.630,-0.630,-0.631,-0.632,-0.632,-0.633, & - -0.633,-0.634,-0.634,-0.635,-0.635,-0.636,-0.636,-0.637,-0.637, & - -0.638,-0.638,-0.639,-0.640,-0.640,-0.641,-0.641,-0.642,-0.642, & - -0.643,-0.643,-0.644,-0.644,-0.645,-0.645,-0.646,-0.646,-0.647, & - -0.647,-0.648,-0.648,-0.649,-0.649,-0.650,-0.650,-0.651,-0.651, & - -0.652,-0.652,-0.653,-0.653,-0.654,-0.654,-0.655,-0.655,-0.656, & - -0.656,-0.657,-0.657,-0.658,-0.663,-0.668,-0.673,-0.677,-0.682, & - -0.687,-0.691,-0.696,-0.700,-0.704,-0.709,-0.713,-0.717,-0.721, & - -0.725,-0.729,-0.733,-0.737,-0.741,-0.745,-0.749,-0.753,-0.757, & - -0.760,-0.764,-0.768,-0.771,-0.775,-0.779,-0.782,-0.786,-0.789, & - -0.793,-0.796,-0.799,-0.803,-0.806,-0.810,-0.813,-0.816,-0.819, & - -0.823,-0.826,-0.829,-0.832,-0.836,-0.839,-0.842,-0.845,-0.848, & - -0.851,-0.854,-0.857,-0.860,-0.863,-0.866,-0.869,-0.872,-0.875, & - -0.878,-0.881,-0.884,-0.887,-0.890,-0.893,-0.895,-0.898,-0.901, & - -0.904,-0.907,-0.909,-0.912,-0.915,-0.918,-0.920,-0.923,-0.926, & - -0.929,-0.931,-0.934,-0.937,-0.939,-0.942,-0.945,-0.947,-0.950, & - -0.952,-0.955,-0.958,-0.960,-0.963,-0.965,-0.968,-0.971,-0.973, & - -0.976,-0.978,-0.981,-0.983,-0.986,-0.988,-0.991,-0.993,-0.996, & - -0.998,-1.000,-1.003,-1.005,-1.008,-1.010,-1.013,-1.015,-1.017, & - -1.020,-1.022,-1.025,-1.027,-1.029,-1.032,-1.034,-1.036,-1.039, & - -1.041,-1.043,-1.046,-1.048,-1.050,-1.053,-1.055,-1.057,-1.060, & - -1.062,-1.064,-1.067,-1.069,-1.071,-1.073,-1.076,-1.078,-1.080, & - -1.082,-1.085,-1.087,-1.089,-1.091,-1.093,-1.096,-1.098,-1.100, & - -1.102,-1.105,-1.107,-1.109,-1.111,-1.113,-1.115,-1.118,-1.120, & - -1.122,-1.124,-1.126 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.096,-0.208,-0.265,-0.305,-0.337,-0.363,-0.385,-0.405,-0.423, & - -0.439,-0.453,-0.467,-0.479,-0.491,-0.502,-0.512,-0.522,-0.531, & - -0.540,-0.548,-0.556,-0.564,-0.571,-0.578,-0.585,-0.592,-0.598, & - -0.605,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638,-0.643,-0.648, & - -0.653,-0.657,-0.662,-0.666,-0.671,-0.675,-0.679,-0.683,-0.688, & - -0.691,-0.695,-0.699,-0.703,-0.707,-0.710,-0.714,-0.717,-0.721, & - -0.724,-0.727,-0.731,-0.734,-0.737,-0.740,-0.743,-0.746,-0.749, & - -0.752,-0.755,-0.758,-0.761,-0.763,-0.766,-0.769,-0.772,-0.774, & - -0.777,-0.780,-0.782,-0.785,-0.787,-0.790,-0.792,-0.795,-0.797, & - -0.799,-0.802,-0.804,-0.807,-0.809,-0.811,-0.814,-0.816,-0.818, & - -0.820,-0.823,-0.825,-0.827,-0.829,-0.831,-0.833,-0.836,-0.838, & - -0.840,-0.842,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, & - -0.858,-0.860,-0.862,-0.864,-0.866,-0.868,-0.870,-0.872,-0.874, & - -0.875,-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.888,-0.890, & - -0.892,-0.894,-0.895,-0.897,-0.899,-0.901,-0.902,-0.904,-0.906, & - -0.908,-0.909,-0.911,-0.913,-0.914,-0.916,-0.918,-0.919,-0.921, & - -0.923,-0.924,-0.926,-0.927,-0.929,-0.931,-0.932,-0.934,-0.935, & - -0.937,-0.938,-0.940,-0.942,-0.943,-0.945,-0.946,-0.948,-0.949, & - -0.951,-0.952,-0.954,-0.955,-0.957,-0.958,-0.960,-0.961,-0.962, & - -0.964,-0.965,-0.967,-0.968,-0.970,-0.971,-0.972,-0.974,-0.975, & - -0.977,-0.978,-0.979,-0.981,-0.982,-0.984,-0.985,-0.986,-0.988, & - -0.989,-0.990,-0.992,-0.993,-0.994,-0.996,-0.997,-0.998,-1.000, & - -1.001,-1.002,-1.004,-1.005,-1.006,-1.007,-1.009,-1.010,-1.011, & - -1.013,-1.014,-1.015,-1.016,-1.018,-1.019,-1.020,-1.021,-1.023, & - -1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.034, & - -1.035,-1.036,-1.037,-1.038,-1.039,-1.041,-1.042,-1.043,-1.044, & - -1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.055, & - -1.056,-1.057,-1.058,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065, & - -1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.073,-1.074,-1.075, & - -1.076,-1.077,-1.078,-1.079,-1.080,-1.081,-1.082,-1.083,-1.084, & - -1.086,-1.087,-1.088,-1.089,-1.090,-1.091,-1.092,-1.093,-1.094, & - -1.095,-1.096,-1.097,-1.098,-1.099,-1.100,-1.101,-1.102,-1.103, & - -1.104,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110,-1.111,-1.112, & - -1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.119,-1.120,-1.121, & - -1.122,-1.123,-1.124,-1.125,-1.126,-1.127,-1.128,-1.129,-1.130, & - -1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, & - -1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.147, & - -1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155,-1.156, & - -1.157,-1.158,-1.159,-1.160,-1.160,-1.161,-1.162,-1.163,-1.164, & - -1.165,-1.166,-1.167,-1.168,-1.169,-1.169,-1.170,-1.171,-1.172, & - -1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, & - -1.181,-1.182,-1.183,-1.184,-1.185,-1.185,-1.186,-1.187,-1.188, & - -1.189,-1.190,-1.191,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196, & - -1.197,-1.198,-1.198,-1.199,-1.200,-1.201,-1.202,-1.203,-1.203, & - -1.204,-1.205,-1.206,-1.207,-1.216,-1.224,-1.232,-1.240,-1.248, & - -1.256,-1.263,-1.271,-1.279,-1.286,-1.293,-1.301,-1.308,-1.315, & - -1.322,-1.329,-1.336,-1.343,-1.349,-1.356,-1.363,-1.369,-1.376, & - -1.382,-1.389,-1.395,-1.402,-1.408,-1.414,-1.420,-1.427,-1.433, & - -1.439,-1.445,-1.451,-1.457,-1.463,-1.468,-1.474,-1.480,-1.486, & - -1.492,-1.497,-1.503,-1.509,-1.514,-1.520,-1.525,-1.531,-1.536, & - -1.542,-1.547,-1.553,-1.558,-1.563,-1.569,-1.574,-1.579,-1.585, & - -1.590,-1.595,-1.600,-1.605,-1.611,-1.616,-1.621,-1.626,-1.631, & - -1.636,-1.641,-1.646,-1.651,-1.656,-1.661,-1.666,-1.671,-1.676, & - -1.681,-1.685,-1.690,-1.695,-1.700,-1.705,-1.710,-1.714,-1.719, & - -1.724,-1.729,-1.733,-1.738,-1.743,-1.747,-1.752,-1.757,-1.761, & - -1.766,-1.770,-1.775,-1.780,-1.784,-1.789,-1.793,-1.798,-1.802, & - -1.807,-1.811,-1.816,-1.820,-1.825,-1.829,-1.834,-1.838,-1.842, & - -1.847,-1.851,-1.856,-1.860,-1.864,-1.869,-1.873,-1.877,-1.882, & - -1.886,-1.890,-1.895,-1.899,-1.903,-1.908,-1.912,-1.916,-1.920, & - -1.925,-1.929,-1.933,-1.937,-1.941,-1.946,-1.950,-1.954,-1.958, & - -1.962,-1.966,-1.971,-1.975,-1.979,-1.983,-1.987,-1.991,-1.995, & - -2.000,-2.004,-2.008,-2.012,-2.016,-2.020,-2.024,-2.028,-2.032, & - -2.036,-2.040,-2.044 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.048,-0.108,-0.138,-0.161,-0.179,-0.194,-0.208,-0.220,-0.231, & - -0.241,-0.250,-0.259,-0.267,-0.275,-0.282,-0.289,-0.296,-0.302, & - -0.309,-0.315,-0.321,-0.326,-0.332,-0.337,-0.342,-0.347,-0.352, & - -0.357,-0.361,-0.366,-0.370,-0.375,-0.379,-0.383,-0.387,-0.391, & - -0.395,-0.399,-0.403,-0.406,-0.410,-0.414,-0.417,-0.421,-0.424, & - -0.427,-0.431,-0.434,-0.437,-0.440,-0.443,-0.446,-0.449,-0.452, & - -0.455,-0.458,-0.461,-0.464,-0.466,-0.469,-0.472,-0.475,-0.477, & - -0.480,-0.482,-0.485,-0.487,-0.490,-0.492,-0.495,-0.497,-0.500, & - -0.502,-0.505,-0.507,-0.509,-0.512,-0.514,-0.516,-0.518,-0.521, & - -0.523,-0.525,-0.527,-0.530,-0.532,-0.534,-0.536,-0.538,-0.541, & - -0.543,-0.545,-0.547,-0.549,-0.551,-0.553,-0.555,-0.558,-0.560, & - -0.562,-0.564,-0.566,-0.568,-0.570,-0.572,-0.574,-0.576,-0.578, & - -0.580,-0.582,-0.584,-0.586,-0.588,-0.590,-0.592,-0.594,-0.596, & - -0.598,-0.600,-0.602,-0.604,-0.606,-0.608,-0.609,-0.611,-0.613, & - -0.615,-0.617,-0.619,-0.621,-0.622,-0.624,-0.626,-0.628,-0.630, & - -0.631,-0.633,-0.635,-0.637,-0.639,-0.640,-0.642,-0.644,-0.646, & - -0.647,-0.649,-0.651,-0.652,-0.654,-0.656,-0.657,-0.659,-0.661, & - -0.662,-0.664,-0.666,-0.667,-0.669,-0.671,-0.672,-0.674,-0.675, & - -0.677,-0.679,-0.680,-0.682,-0.683,-0.685,-0.686,-0.688,-0.690, & - -0.691,-0.693,-0.694,-0.696,-0.697,-0.699,-0.700,-0.702,-0.703, & - -0.705,-0.706,-0.708,-0.709,-0.711,-0.712,-0.713,-0.715,-0.716, & - -0.718,-0.719,-0.721,-0.722,-0.723,-0.725,-0.726,-0.728,-0.729, & - -0.730,-0.732,-0.733,-0.735,-0.736,-0.737,-0.739,-0.740,-0.741, & - -0.743,-0.744,-0.745,-0.747,-0.748,-0.749,-0.751,-0.752,-0.753, & - -0.755,-0.756,-0.757,-0.759,-0.760,-0.761,-0.762,-0.764,-0.765, & - -0.766,-0.768,-0.769,-0.770,-0.771,-0.773,-0.774,-0.775,-0.776, & - -0.778,-0.779,-0.780,-0.781,-0.782,-0.784,-0.785,-0.786,-0.787, & - -0.788,-0.790,-0.791,-0.792,-0.793,-0.794,-0.796,-0.797,-0.798, & - -0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.806,-0.807,-0.808, & - -0.809,-0.811,-0.812,-0.813,-0.814,-0.815,-0.816,-0.817,-0.818, & - -0.820,-0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828, & - -0.829,-0.830,-0.832,-0.833,-0.834,-0.835,-0.836,-0.837,-0.838, & - -0.839,-0.840,-0.841,-0.842,-0.843,-0.844,-0.845,-0.846,-0.847, & - -0.848,-0.849,-0.850,-0.851,-0.852,-0.853,-0.854,-0.855,-0.857, & - -0.858,-0.859,-0.860,-0.861,-0.862,-0.863,-0.863,-0.864,-0.865, & - -0.866,-0.867,-0.868,-0.869,-0.870,-0.871,-0.872,-0.873,-0.874, & - -0.875,-0.876,-0.877,-0.878,-0.879,-0.880,-0.881,-0.882,-0.883, & - -0.884,-0.885,-0.886,-0.887,-0.887,-0.888,-0.889,-0.890,-0.891, & - -0.892,-0.893,-0.894,-0.895,-0.896,-0.897,-0.898,-0.898,-0.899, & - -0.900,-0.901,-0.902,-0.903,-0.904,-0.905,-0.906,-0.907,-0.907, & - -0.908,-0.909,-0.910,-0.911,-0.912,-0.913,-0.914,-0.914,-0.915, & - -0.916,-0.917,-0.918,-0.919,-0.920,-0.920,-0.921,-0.922,-0.923, & - -0.924,-0.925,-0.926,-0.926,-0.927,-0.928,-0.929,-0.930,-0.931, & - -0.931,-0.932,-0.933,-0.934,-0.935,-0.936,-0.936,-0.937,-0.938, & - -0.939,-0.940,-0.940,-0.941,-0.950,-0.958,-0.965,-0.973,-0.980, & - -0.988,-0.995,-1.002,-1.009,-1.015,-1.022,-1.029,-1.035,-1.041, & - -1.047,-1.054,-1.060,-1.066,-1.071,-1.077,-1.083,-1.088,-1.094, & - -1.099,-1.105,-1.110,-1.115,-1.120,-1.125,-1.130,-1.135,-1.140, & - -1.145,-1.150,-1.155,-1.159,-1.164,-1.168,-1.173,-1.177,-1.182, & - -1.186,-1.191,-1.195,-1.199,-1.203,-1.207,-1.212,-1.216,-1.220, & - -1.224,-1.228,-1.232,-1.235,-1.239,-1.243,-1.247,-1.251,-1.254, & - -1.258,-1.262,-1.265,-1.269,-1.273,-1.276,-1.280,-1.283,-1.287, & - -1.290,-1.293,-1.297,-1.300,-1.304,-1.307,-1.310,-1.313,-1.317, & - -1.320,-1.323,-1.326,-1.330,-1.333,-1.336,-1.339,-1.342,-1.345, & - -1.348,-1.351,-1.354,-1.357,-1.360,-1.363,-1.366,-1.369,-1.372, & - -1.375,-1.378,-1.381,-1.383,-1.386,-1.389,-1.392,-1.395,-1.397, & - -1.400,-1.403,-1.406,-1.408,-1.411,-1.414,-1.417,-1.419,-1.422, & - -1.425,-1.427,-1.430,-1.432,-1.435,-1.438,-1.440,-1.443,-1.445, & - -1.448,-1.450,-1.453,-1.456,-1.458,-1.461,-1.463,-1.466,-1.468, & - -1.470,-1.473,-1.475,-1.478,-1.480,-1.483,-1.485,-1.487,-1.490, & - -1.492,-1.495,-1.497,-1.499,-1.502,-1.504,-1.506,-1.509,-1.511, & - -1.513,-1.516,-1.518,-1.520,-1.523,-1.525,-1.527,-1.529,-1.532, & - -1.534,-1.536,-1.538 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.047,-0.101,-0.126,-0.144,-0.157,-0.168,-0.177,-0.185,-0.191, & - -0.197,-0.202,-0.207,-0.211,-0.215,-0.218,-0.221,-0.224,-0.227, & - -0.229,-0.232,-0.234,-0.236,-0.238,-0.239,-0.241,-0.242,-0.244, & - -0.245,-0.246,-0.247,-0.249,-0.250,-0.251,-0.251,-0.252,-0.253, & - -0.254,-0.255,-0.255,-0.256,-0.257,-0.257,-0.258,-0.258,-0.259, & - -0.259,-0.260,-0.260,-0.261,-0.261,-0.261,-0.262,-0.262,-0.262, & - -0.263,-0.263,-0.263,-0.263,-0.264,-0.264,-0.264,-0.264,-0.265, & - -0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.266,-0.266,-0.266, & - -0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266, & - -0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.266,-0.265, & - -0.265,-0.265,-0.265,-0.265,-0.265,-0.265,-0.264,-0.264,-0.264, & - -0.264,-0.264,-0.263,-0.263,-0.263,-0.263,-0.263,-0.262,-0.262, & - -0.262,-0.262,-0.261,-0.261,-0.261,-0.260,-0.260,-0.260,-0.260, & - -0.259,-0.259,-0.259,-0.258,-0.258,-0.258,-0.257,-0.257,-0.257, & - -0.256,-0.256,-0.256,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254, & - -0.253,-0.253,-0.253,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251, & - -0.250,-0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247, & - -0.247,-0.247,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244,-0.244, & - -0.244,-0.243,-0.243,-0.242,-0.242,-0.242,-0.241,-0.241,-0.241, & - -0.240,-0.240,-0.239,-0.239,-0.239,-0.238,-0.238,-0.238,-0.237, & - -0.237,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235,-0.234,-0.234, & - -0.233,-0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.231,-0.230, & - -0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.228,-0.227,-0.227, & - -0.227,-0.226,-0.226,-0.225,-0.225,-0.225,-0.224,-0.224,-0.224, & - -0.223,-0.223,-0.222,-0.222,-0.222,-0.221,-0.221,-0.221,-0.220, & - -0.220,-0.219,-0.219,-0.219,-0.218,-0.218,-0.218,-0.217,-0.217, & - -0.216,-0.216,-0.216,-0.215,-0.215,-0.215,-0.214,-0.214,-0.214, & - -0.213,-0.213,-0.212,-0.212,-0.212,-0.211,-0.211,-0.211,-0.210, & - -0.210,-0.210,-0.209,-0.209,-0.208,-0.208,-0.208,-0.207,-0.207, & - -0.207,-0.206,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204,-0.204, & - -0.203,-0.203,-0.203,-0.202,-0.202,-0.202,-0.201,-0.201,-0.201, & - -0.200,-0.200,-0.200,-0.199,-0.199,-0.198,-0.198,-0.198,-0.197, & - -0.197,-0.197,-0.196,-0.196,-0.196,-0.195,-0.195,-0.195,-0.194, & - -0.194,-0.194,-0.193,-0.193,-0.193,-0.192,-0.192,-0.192,-0.191, & - -0.191,-0.191,-0.190,-0.190,-0.190,-0.189,-0.189,-0.189,-0.188, & - -0.188,-0.188,-0.187,-0.187,-0.187,-0.186,-0.186,-0.186,-0.185, & - -0.185,-0.185,-0.184,-0.184,-0.184,-0.183,-0.183,-0.183,-0.182, & - -0.182,-0.182,-0.181,-0.181,-0.181,-0.180,-0.180,-0.180,-0.179, & - -0.179,-0.179,-0.178,-0.178,-0.178,-0.177,-0.177,-0.177,-0.176, & - -0.176,-0.176,-0.176,-0.175,-0.175,-0.175,-0.174,-0.174,-0.174, & - -0.173,-0.173,-0.173,-0.172,-0.172,-0.172,-0.171,-0.171,-0.171, & - -0.171,-0.170,-0.170,-0.170,-0.169,-0.169,-0.169,-0.168,-0.168, & - -0.168,-0.167,-0.167,-0.167,-0.167,-0.166,-0.166,-0.166,-0.165, & - -0.165,-0.165,-0.164,-0.164,-0.164,-0.164,-0.163,-0.163,-0.163, & - -0.162,-0.162,-0.162,-0.161,-0.158,-0.155,-0.153,-0.150,-0.147, & - -0.144,-0.142,-0.139,-0.137,-0.134,-0.132,-0.129,-0.127,-0.125, & - -0.122,-0.120,-0.118,-0.116,-0.113,-0.111,-0.109,-0.107,-0.105, & - -0.103,-0.101,-0.099,-0.097,-0.095,-0.093,-0.092,-0.090,-0.088, & - -0.086,-0.085,-0.083,-0.081,-0.080,-0.078,-0.077,-0.075,-0.073, & - -0.072,-0.071,-0.069,-0.068,-0.066,-0.065,-0.064,-0.062,-0.061, & - -0.060,-0.058,-0.057,-0.056,-0.055,-0.053,-0.052,-0.051,-0.050, & - -0.049,-0.048,-0.047,-0.046,-0.044,-0.043,-0.042,-0.041,-0.040, & - -0.039,-0.039,-0.038,-0.037,-0.036,-0.035,-0.034,-0.033,-0.032, & - -0.032,-0.031,-0.030,-0.029,-0.028,-0.028,-0.027,-0.026,-0.025, & - -0.025,-0.024,-0.023,-0.023,-0.022,-0.021,-0.021,-0.020,-0.019, & - -0.019,-0.018,-0.018,-0.017,-0.017,-0.016,-0.016,-0.015,-0.015, & - -0.014,-0.014,-0.013,-0.013,-0.012,-0.012,-0.011,-0.011,-0.010, & - -0.010,-0.010,-0.009,-0.009,-0.008,-0.008,-0.008,-0.007,-0.007, & - -0.007,-0.006,-0.006,-0.006,-0.005,-0.005,-0.005,-0.005,-0.004, & - -0.004,-0.004,-0.004,-0.003,-0.003,-0.003,-0.003,-0.003,-0.002, & - -0.002,-0.002,-0.002,-0.002,-0.002,-0.001,-0.001,-0.001,-0.001, & - -0.001,-0.001,-0.001,-0.001, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.095,-0.207,-0.263,-0.303,-0.333,-0.359,-0.381,-0.400,-0.417, & - -0.432,-0.446,-0.459,-0.471,-0.482,-0.492,-0.502,-0.511,-0.520, & - -0.528,-0.536,-0.543,-0.550,-0.557,-0.564,-0.570,-0.576,-0.582, & - -0.588,-0.593,-0.598,-0.603,-0.608,-0.613,-0.618,-0.622,-0.627, & - -0.631,-0.635,-0.640,-0.644,-0.648,-0.651,-0.655,-0.659,-0.662, & - -0.666,-0.669,-0.673,-0.676,-0.679,-0.682,-0.686,-0.689,-0.692, & - -0.695,-0.698,-0.700,-0.703,-0.706,-0.709,-0.712,-0.714,-0.717, & - -0.719,-0.722,-0.724,-0.727,-0.729,-0.732,-0.734,-0.736,-0.739, & - -0.741,-0.743,-0.746,-0.748,-0.750,-0.752,-0.754,-0.756,-0.758, & - -0.761,-0.763,-0.765,-0.767,-0.769,-0.771,-0.773,-0.774,-0.776, & - -0.778,-0.780,-0.782,-0.784,-0.786,-0.787,-0.789,-0.791,-0.793, & - -0.795,-0.796,-0.798,-0.800,-0.802,-0.803,-0.805,-0.807,-0.808, & - -0.810,-0.811,-0.813,-0.815,-0.816,-0.818,-0.819,-0.821,-0.823, & - -0.824,-0.826,-0.827,-0.829,-0.830,-0.832,-0.833,-0.835,-0.836, & - -0.838,-0.839,-0.841,-0.842,-0.843,-0.845,-0.846,-0.848,-0.849, & - -0.850,-0.852,-0.853,-0.854,-0.856,-0.857,-0.858,-0.860,-0.861, & - -0.862,-0.864,-0.865,-0.866,-0.868,-0.869,-0.870,-0.871,-0.873, & - -0.874,-0.875,-0.876,-0.878,-0.879,-0.880,-0.881,-0.883,-0.884, & - -0.885,-0.886,-0.887,-0.889,-0.890,-0.891,-0.892,-0.893,-0.894, & - -0.896,-0.897,-0.898,-0.899,-0.900,-0.901,-0.902,-0.904,-0.905, & - -0.906,-0.907,-0.908,-0.909,-0.910,-0.911,-0.912,-0.914,-0.915, & - -0.916,-0.917,-0.918,-0.919,-0.920,-0.921,-0.922,-0.923,-0.924, & - -0.925,-0.926,-0.927,-0.928,-0.929,-0.930,-0.931,-0.932,-0.933, & - -0.934,-0.935,-0.936,-0.937,-0.938,-0.939,-0.940,-0.941,-0.942, & - -0.943,-0.944,-0.945,-0.946,-0.947,-0.948,-0.949,-0.950,-0.951, & - -0.952,-0.953,-0.954,-0.955,-0.956,-0.957,-0.958,-0.959,-0.960, & - -0.960,-0.961,-0.962,-0.963,-0.964,-0.965,-0.966,-0.967,-0.968, & - -0.969,-0.970,-0.970,-0.971,-0.972,-0.973,-0.974,-0.975,-0.976, & - -0.977,-0.978,-0.978,-0.979,-0.980,-0.981,-0.982,-0.983,-0.984, & - -0.985,-0.985,-0.986,-0.987,-0.988,-0.989,-0.990,-0.991,-0.991, & - -0.992,-0.993,-0.994,-0.995,-0.996,-0.996,-0.997,-0.998,-0.999, & - -1.000,-1.001,-1.001,-1.002,-1.003,-1.004,-1.005,-1.005,-1.006, & - -1.007,-1.008,-1.009,-1.010,-1.010,-1.011,-1.012,-1.013,-1.014, & - -1.014,-1.015,-1.016,-1.017,-1.017,-1.018,-1.019,-1.020,-1.021, & - -1.021,-1.022,-1.023,-1.024,-1.025,-1.025,-1.026,-1.027,-1.028, & - -1.028,-1.029,-1.030,-1.031,-1.031,-1.032,-1.033,-1.034,-1.034, & - -1.035,-1.036,-1.037,-1.037,-1.038,-1.039,-1.040,-1.040,-1.041, & - -1.042,-1.043,-1.043,-1.044,-1.045,-1.046,-1.046,-1.047,-1.048, & - -1.049,-1.049,-1.050,-1.051,-1.051,-1.052,-1.053,-1.054,-1.054, & - -1.055,-1.056,-1.057,-1.057,-1.058,-1.059,-1.059,-1.060,-1.061, & - -1.061,-1.062,-1.063,-1.064,-1.064,-1.065,-1.066,-1.066,-1.067, & - -1.068,-1.069,-1.069,-1.070,-1.071,-1.071,-1.072,-1.073,-1.073, & - -1.074,-1.075,-1.075,-1.076,-1.077,-1.078,-1.078,-1.079,-1.080, & - -1.080,-1.081,-1.082,-1.082,-1.083,-1.084,-1.084,-1.085,-1.086, & - -1.086,-1.087,-1.088,-1.088,-1.096,-1.102,-1.109,-1.115,-1.121, & - -1.127,-1.134,-1.140,-1.146,-1.152,-1.158,-1.163,-1.169,-1.175, & - -1.181,-1.186,-1.192,-1.198,-1.203,-1.209,-1.214,-1.219,-1.225, & - -1.230,-1.235,-1.241,-1.246,-1.251,-1.256,-1.261,-1.266,-1.271, & - -1.276,-1.281,-1.286,-1.291,-1.296,-1.301,-1.306,-1.311,-1.315, & - -1.320,-1.325,-1.330,-1.334,-1.339,-1.344,-1.348,-1.353,-1.358, & - -1.362,-1.367,-1.371,-1.376,-1.380,-1.385,-1.389,-1.394,-1.398, & - -1.403,-1.407,-1.412,-1.416,-1.420,-1.425,-1.429,-1.434,-1.438, & - -1.442,-1.447,-1.451,-1.455,-1.459,-1.464,-1.468,-1.472,-1.476, & - -1.480,-1.485,-1.489,-1.493,-1.497,-1.501,-1.505,-1.510,-1.514, & - -1.518,-1.522,-1.526,-1.530,-1.534,-1.538,-1.542,-1.546,-1.550, & - -1.554,-1.558,-1.562,-1.566,-1.570,-1.574,-1.578,-1.582,-1.586, & - -1.590,-1.594,-1.598,-1.602,-1.606,-1.610,-1.614,-1.618,-1.622, & - -1.625,-1.629,-1.633,-1.637,-1.641,-1.645,-1.649,-1.652,-1.656, & - -1.660,-1.664,-1.668,-1.672,-1.675,-1.679,-1.683,-1.687,-1.690, & - -1.694,-1.698,-1.702,-1.706,-1.709,-1.713,-1.717,-1.721,-1.724, & - -1.728,-1.732,-1.735,-1.739,-1.743,-1.747,-1.750,-1.754,-1.758, & - -1.761,-1.765,-1.769,-1.772,-1.776,-1.780,-1.783,-1.787,-1.791, & - -1.794,-1.798,-1.801 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.045,-0.089,-0.107,-0.117,-0.124,-0.128,-0.131,-0.132,-0.133, & - -0.132,-0.132,-0.130,-0.128,-0.126,-0.123,-0.120,-0.117,-0.113, & - -0.109,-0.105,-0.101,-0.096,-0.091,-0.086,-0.081,-0.076,-0.070, & - -0.065,-0.059,-0.053,-0.047,-0.040,-0.034,-0.027,-0.021,-0.014, & - -0.007, 0.000, 0.007, 0.014, 0.021, 0.028, 0.036, 0.043, 0.051, & - & 0.058, 0.066, 0.074, 0.082, 0.089, 0.097, 0.105, 0.113, 0.121, & - & 0.130, 0.138, 0.146, 0.154, 0.163, 0.171, 0.179, 0.188, 0.196, & - & 0.205, 0.214, 0.222, 0.231, 0.240, 0.248, 0.257, 0.266, 0.275, & - & 0.284, 0.293, 0.302, 0.311, 0.320, 0.329, 0.338, 0.347, 0.357, & - & 0.366, 0.375, 0.385, 0.394, 0.404, 0.413, 0.423, 0.433, 0.442, & - & 0.452, 0.462, 0.472, 0.482, 0.492, 0.502, 0.512, 0.522, 0.532, & - & 0.542, 0.552, 0.563, 0.573, 0.583, 0.594, 0.604, 0.614, 0.625, & - & 0.635, 0.646, 0.656, 0.667, 0.677, 0.688, 0.698, 0.709, 0.719, & - & 0.730, 0.741, 0.751, 0.762, 0.772, 0.783, 0.794, 0.804, 0.815, & - & 0.825, 0.836, 0.846, 0.857, 0.867, 0.878, 0.888, 0.899, 0.909, & - & 0.920, 0.930, 0.941, 0.951, 0.962, 0.972, 0.982, 0.993, 1.003, & - & 1.014, 1.024, 1.034, 1.044, 1.055, 1.065, 1.075, 1.085, 1.096, & - & 1.106, 1.116, 1.126, 1.136, 1.146, 1.156, 1.166, 1.176, 1.186, & - & 1.196, 1.206, 1.216, 1.226, 1.236, 1.246, 1.256, 1.266, 1.276, & - & 1.285, 1.295, 1.305, 1.315, 1.325, 1.334, 1.344, 1.354, 1.363, & - & 1.373, 1.383, 1.392, 1.402, 1.411, 1.421, 1.430, 1.440, 1.449, & - & 1.459, 1.468, 1.478, 1.487, 1.496, 1.506, 1.515, 1.524, 1.534, & - & 1.543, 1.552, 1.561, 1.571, 1.580, 1.589, 1.598, 1.607, 1.616, & - & 1.625, 1.634, 1.643, 1.652, 1.661, 1.670, 1.679, 1.688, 1.697, & - & 1.706, 1.715, 1.724, 1.733, 1.742, 1.750, 1.759, 1.768, 1.777, & - & 1.786, 1.794, 1.803, 1.812, 1.820, 1.829, 1.838, 1.846, 1.855, & - & 1.863, 1.872, 1.880, 1.889, 1.897, 1.906, 1.914, 1.923, 1.931, & - & 1.940, 1.948, 1.956, 1.965, 1.973, 1.981, 1.990, 1.998, 2.006, & - & 2.015, 2.023, 2.031, 2.039, 2.047, 2.056, 2.064, 2.072, 2.080, & - & 2.088, 2.096, 2.104, 2.112, 2.120, 2.128, 2.136, 2.144, 2.152, & - & 2.160, 2.168, 2.176, 2.184, 2.192, 2.200, 2.207, 2.215, 2.223, & - & 2.231, 2.239, 2.246, 2.254, 2.262, 2.270, 2.277, 2.285, 2.293, & - & 2.300, 2.308, 2.316, 2.323, 2.331, 2.339, 2.346, 2.354, 2.361, & - & 2.369, 2.376, 2.384, 2.391, 2.399, 2.406, 2.414, 2.421, 2.428, & - & 2.436, 2.443, 2.451, 2.458, 2.465, 2.473, 2.480, 2.487, 2.494, & - & 2.502, 2.509, 2.516, 2.523, 2.531, 2.538, 2.545, 2.552, 2.559, & - & 2.566, 2.574, 2.581, 2.588, 2.595, 2.602, 2.609, 2.616, 2.623, & - & 2.630, 2.637, 2.644, 2.651, 2.658, 2.665, 2.672, 2.679, 2.686, & - & 2.693, 2.700, 2.707, 2.713, 2.720, 2.727, 2.734, 2.741, 2.748, & - & 2.754, 2.761, 2.768, 2.775, 2.781, 2.788, 2.795, 2.802, 2.808, & - & 2.815, 2.822, 2.828, 2.835, 2.842, 2.848, 2.855, 2.862, 2.868, & - & 2.875, 2.881, 2.888, 2.894, 2.901, 2.907, 2.914, 2.920, 2.927, & - & 2.933, 2.940, 2.946, 2.953, 2.959, 2.966, 2.972, 2.978, 2.985, & - & 2.991, 2.998, 3.004, 3.010, 3.017, 3.023, 3.029, 3.036, 3.042, & - & 3.048, 3.054, 3.061, 3.067, 3.134, 3.195, 3.254, 3.313, 3.371, & - & 3.428, 3.485, 3.540, 3.595, 3.648, 3.701, 3.754, 3.805, 3.856, & - & 3.906, 3.955, 4.004, 4.052, 4.100, 4.147, 4.193, 4.239, 4.284, & - & 4.328, 4.372, 4.416, 4.459, 4.501, 4.543, 4.585, 4.626, 4.666, & - & 4.707, 4.746, 4.786, 4.824, 4.863, 4.901, 4.938, 4.976, 5.013, & - & 5.049, 5.085, 5.121, 5.156, 5.191, 5.226, 5.260, 5.294, 5.328, & - & 5.361, 5.395, 5.427, 5.460, 5.492, 5.524, 5.555, 5.587, 5.618, & - & 5.649, 5.679, 5.709, 5.739, 5.769, 5.799, 5.828, 5.857, 5.886, & - & 5.914, 5.942, 5.971, 5.998, 6.026, 6.053, 6.081, 6.108, 6.134, & - & 6.161, 6.187, 6.214, 6.240, 6.265, 6.291, 6.316, 6.342, 6.367, & - & 6.392, 6.416, 6.441, 6.465, 6.489, 6.513, 6.537, 6.561, 6.584, & - & 6.608, 6.631, 6.654, 6.677, 6.699, 6.722, 6.744, 6.767, 6.789, & - & 6.811, 6.833, 6.854, 6.876, 6.897, 6.919, 6.940, 6.961, 6.982, & - & 7.003, 7.023, 7.044, 7.064, 7.085, 7.105, 7.125, 7.145, 7.165, & - & 7.184, 7.204, 7.223, 7.243, 7.262, 7.281, 7.300, 7.319, 7.338, & - & 7.356, 7.375, 7.394, 7.412, 7.430, 7.448, 7.467, 7.485, 7.502, & - & 7.520, 7.538, 7.556, 7.573, 7.591, 7.608, 7.625, 7.642, 7.659, & - & 7.676, 7.693, 7.710, 7.727, 7.743, 7.760, 7.776, 7.793, 7.809, & - & 7.825, 7.841, 7.858 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.047,-0.099,-0.125,-0.142,-0.155,-0.166,-0.175,-0.182,-0.189, & - -0.195,-0.200,-0.204,-0.208,-0.212,-0.215,-0.218,-0.221,-0.223, & - -0.225,-0.227,-0.228,-0.230,-0.231,-0.232,-0.233,-0.234,-0.235, & - -0.235,-0.235,-0.236,-0.236,-0.236,-0.236,-0.235,-0.235,-0.235, & - -0.234,-0.233,-0.233,-0.232,-0.231,-0.230,-0.229,-0.228,-0.227, & - -0.226,-0.224,-0.223,-0.222,-0.220,-0.219,-0.217,-0.215,-0.214, & - -0.212,-0.210,-0.208,-0.207,-0.205,-0.203,-0.201,-0.199,-0.197, & - -0.195,-0.192,-0.190,-0.188,-0.186,-0.183,-0.181,-0.179,-0.176, & - -0.174,-0.171,-0.169,-0.166,-0.164,-0.161,-0.159,-0.156,-0.153, & - -0.151,-0.148,-0.145,-0.143,-0.140,-0.137,-0.134,-0.131,-0.128, & - -0.125,-0.122,-0.120,-0.117,-0.114,-0.110,-0.107,-0.104,-0.101, & - -0.098,-0.095,-0.092,-0.089,-0.085,-0.082,-0.079,-0.076,-0.073, & - -0.069,-0.066,-0.063,-0.060,-0.056,-0.053,-0.050,-0.046,-0.043, & - -0.040,-0.036,-0.033,-0.030,-0.026,-0.023,-0.020,-0.016,-0.013, & - -0.010,-0.006,-0.003, 0.000, 0.004, 0.007, 0.010, 0.014, 0.017, & - & 0.020, 0.024, 0.027, 0.030, 0.034, 0.037, 0.040, 0.043, 0.047, & - & 0.050, 0.053, 0.056, 0.060, 0.063, 0.066, 0.069, 0.073, 0.076, & - & 0.079, 0.082, 0.086, 0.089, 0.092, 0.095, 0.098, 0.101, 0.105, & - & 0.108, 0.111, 0.114, 0.117, 0.120, 0.123, 0.127, 0.130, 0.133, & - & 0.136, 0.139, 0.142, 0.145, 0.148, 0.151, 0.154, 0.157, 0.160, & - & 0.163, 0.166, 0.170, 0.173, 0.176, 0.179, 0.182, 0.184, 0.187, & - & 0.190, 0.193, 0.196, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, & - & 0.217, 0.220, 0.223, 0.226, 0.228, 0.231, 0.234, 0.237, 0.240, & - & 0.243, 0.246, 0.248, 0.251, 0.254, 0.257, 0.260, 0.262, 0.265, & - & 0.268, 0.271, 0.274, 0.276, 0.279, 0.282, 0.285, 0.287, 0.290, & - & 0.293, 0.296, 0.298, 0.301, 0.304, 0.306, 0.309, 0.312, 0.315, & - & 0.317, 0.320, 0.323, 0.325, 0.328, 0.330, 0.333, 0.336, 0.338, & - & 0.341, 0.344, 0.346, 0.349, 0.351, 0.354, 0.357, 0.359, 0.362, & - & 0.364, 0.367, 0.369, 0.372, 0.375, 0.377, 0.380, 0.382, 0.385, & - & 0.387, 0.390, 0.392, 0.395, 0.397, 0.400, 0.402, 0.405, 0.407, & - & 0.410, 0.412, 0.415, 0.417, 0.419, 0.422, 0.424, 0.427, 0.429, & - & 0.432, 0.434, 0.437, 0.439, 0.441, 0.444, 0.446, 0.449, 0.451, & - & 0.453, 0.456, 0.458, 0.460, 0.463, 0.465, 0.467, 0.470, 0.472, & - & 0.474, 0.477, 0.479, 0.481, 0.484, 0.486, 0.488, 0.491, 0.493, & - & 0.495, 0.498, 0.500, 0.502, 0.504, 0.507, 0.509, 0.511, 0.513, & - & 0.516, 0.518, 0.520, 0.522, 0.525, 0.527, 0.529, 0.531, 0.534, & - & 0.536, 0.538, 0.540, 0.542, 0.545, 0.547, 0.549, 0.551, 0.553, & - & 0.556, 0.558, 0.560, 0.562, 0.564, 0.566, 0.569, 0.571, 0.573, & - & 0.575, 0.577, 0.579, 0.581, 0.584, 0.586, 0.588, 0.590, 0.592, & - & 0.594, 0.596, 0.598, 0.600, 0.602, 0.605, 0.607, 0.609, 0.611, & - & 0.613, 0.615, 0.617, 0.619, 0.621, 0.623, 0.625, 0.627, 0.629, & - & 0.631, 0.633, 0.635, 0.637, 0.639, 0.642, 0.644, 0.646, 0.648, & - & 0.650, 0.652, 0.654, 0.656, 0.658, 0.660, 0.662, 0.663, 0.665, & - & 0.667, 0.669, 0.671, 0.673, 0.675, 0.677, 0.679, 0.681, 0.683, & - & 0.685, 0.687, 0.689, 0.691, 0.712, 0.730, 0.749, 0.767, 0.785, & - & 0.803, 0.820, 0.837, 0.854, 0.871, 0.887, 0.903, 0.919, 0.935, & - & 0.950, 0.965, 0.980, 0.995, 1.010, 1.024, 1.039, 1.053, 1.067, & - & 1.080, 1.094, 1.107, 1.120, 1.133, 1.146, 1.159, 1.172, 1.184, & - & 1.196, 1.209, 1.221, 1.232, 1.244, 1.256, 1.267, 1.279, 1.290, & - & 1.301, 1.312, 1.323, 1.334, 1.344, 1.355, 1.365, 1.376, 1.386, & - & 1.396, 1.406, 1.416, 1.426, 1.436, 1.445, 1.455, 1.464, 1.474, & - & 1.483, 1.492, 1.501, 1.511, 1.519, 1.528, 1.537, 1.546, 1.555, & - & 1.563, 1.572, 1.580, 1.588, 1.597, 1.605, 1.613, 1.621, 1.629, & - & 1.637, 1.645, 1.653, 1.660, 1.668, 1.676, 1.683, 1.691, 1.698, & - & 1.706, 1.713, 1.720, 1.727, 1.734, 1.742, 1.749, 1.756, 1.763, & - & 1.769, 1.776, 1.783, 1.790, 1.796, 1.803, 1.810, 1.816, 1.823, & - & 1.829, 1.835, 1.842, 1.848, 1.854, 1.861, 1.867, 1.873, 1.879, & - & 1.885, 1.891, 1.897, 1.903, 1.909, 1.915, 1.920, 1.926, 1.932, & - & 1.938, 1.943, 1.949, 1.954, 1.960, 1.965, 1.971, 1.976, 1.982, & - & 1.987, 1.992, 1.998, 2.003, 2.008, 2.013, 2.018, 2.024, 2.029, & - & 2.034, 2.039, 2.044, 2.049, 2.054, 2.059, 2.063, 2.068, 2.073, & - & 2.078, 2.083, 2.087, 2.092, 2.097, 2.101, 2.106, 2.111, 2.115, & - & 2.120, 2.124, 2.129 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.046,-0.096,-0.118,-0.132,-0.142,-0.150,-0.156,-0.161,-0.164, & - -0.167,-0.170,-0.171,-0.173,-0.174,-0.174,-0.175,-0.175,-0.175, & - -0.175,-0.174,-0.174,-0.173,-0.172,-0.171,-0.170,-0.169,-0.168, & - -0.167,-0.165,-0.164,-0.163,-0.161,-0.160,-0.158,-0.156,-0.155, & - -0.153,-0.151,-0.150,-0.148,-0.146,-0.144,-0.142,-0.141,-0.139, & - -0.137,-0.135,-0.133,-0.131,-0.129,-0.127,-0.125,-0.124,-0.122, & - -0.120,-0.118,-0.116,-0.114,-0.112,-0.110,-0.108,-0.106,-0.104, & - -0.102,-0.100,-0.098,-0.096,-0.094,-0.092,-0.090,-0.088,-0.086, & - -0.084,-0.082,-0.080,-0.078,-0.076,-0.074,-0.071,-0.069,-0.067, & - -0.065,-0.063,-0.061,-0.058,-0.056,-0.054,-0.052,-0.049,-0.047, & - -0.045,-0.043,-0.040,-0.038,-0.035,-0.033,-0.031,-0.028,-0.026, & - -0.023,-0.021,-0.019,-0.016,-0.014,-0.011,-0.009,-0.006,-0.004, & - -0.001, 0.001, 0.004, 0.007, 0.009, 0.012, 0.014, 0.017, 0.019, & - & 0.022, 0.025, 0.027, 0.030, 0.032, 0.035, 0.038, 0.040, 0.043, & - & 0.045, 0.048, 0.051, 0.053, 0.056, 0.058, 0.061, 0.064, 0.066, & - & 0.069, 0.071, 0.074, 0.077, 0.079, 0.082, 0.084, 0.087, 0.090, & - & 0.092, 0.095, 0.097, 0.100, 0.103, 0.105, 0.108, 0.110, 0.113, & - & 0.115, 0.118, 0.121, 0.123, 0.126, 0.128, 0.131, 0.133, 0.136, & - & 0.138, 0.141, 0.143, 0.146, 0.148, 0.151, 0.154, 0.156, 0.159, & - & 0.161, 0.164, 0.166, 0.169, 0.171, 0.174, 0.176, 0.179, 0.181, & - & 0.184, 0.186, 0.189, 0.191, 0.193, 0.196, 0.198, 0.201, 0.203, & - & 0.206, 0.208, 0.211, 0.213, 0.216, 0.218, 0.220, 0.223, 0.225, & - & 0.228, 0.230, 0.232, 0.235, 0.237, 0.240, 0.242, 0.245, 0.247, & - & 0.249, 0.252, 0.254, 0.256, 0.259, 0.261, 0.264, 0.266, 0.268, & - & 0.271, 0.273, 0.275, 0.278, 0.280, 0.282, 0.285, 0.287, 0.289, & - & 0.292, 0.294, 0.296, 0.299, 0.301, 0.303, 0.306, 0.308, 0.310, & - & 0.312, 0.315, 0.317, 0.319, 0.322, 0.324, 0.326, 0.328, 0.331, & - & 0.333, 0.335, 0.337, 0.340, 0.342, 0.344, 0.346, 0.349, 0.351, & - & 0.353, 0.355, 0.357, 0.360, 0.362, 0.364, 0.366, 0.369, 0.371, & - & 0.373, 0.375, 0.377, 0.379, 0.382, 0.384, 0.386, 0.388, 0.390, & - & 0.393, 0.395, 0.397, 0.399, 0.401, 0.403, 0.405, 0.408, 0.410, & - & 0.412, 0.414, 0.416, 0.418, 0.420, 0.422, 0.425, 0.427, 0.429, & - & 0.431, 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.445, 0.448, & - & 0.450, 0.452, 0.454, 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, & - & 0.468, 0.470, 0.472, 0.474, 0.476, 0.478, 0.480, 0.482, 0.484, & - & 0.486, 0.488, 0.490, 0.492, 0.494, 0.496, 0.498, 0.500, 0.502, & - & 0.504, 0.506, 0.508, 0.510, 0.512, 0.514, 0.516, 0.518, 0.520, & - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.537, & - & 0.539, 0.541, 0.543, 0.545, 0.547, 0.549, 0.551, 0.553, 0.555, & - & 0.557, 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.572, & - & 0.574, 0.575, 0.577, 0.579, 0.581, 0.583, 0.585, 0.587, 0.588, & - & 0.590, 0.592, 0.594, 0.596, 0.598, 0.599, 0.601, 0.603, 0.605, & - & 0.607, 0.609, 0.610, 0.612, 0.614, 0.616, 0.618, 0.619, 0.621, & - & 0.623, 0.625, 0.627, 0.628, 0.630, 0.632, 0.634, 0.635, 0.637, & - & 0.639, 0.641, 0.643, 0.644, 0.663, 0.680, 0.697, 0.714, 0.730, & - & 0.747, 0.763, 0.778, 0.794, 0.809, 0.824, 0.839, 0.854, 0.868, & - & 0.883, 0.897, 0.911, 0.924, 0.938, 0.951, 0.965, 0.978, 0.990, & - & 1.003, 1.016, 1.028, 1.040, 1.053, 1.065, 1.076, 1.088, 1.100, & - & 1.111, 1.122, 1.133, 1.145, 1.155, 1.166, 1.177, 1.188, 1.198, & - & 1.208, 1.219, 1.229, 1.239, 1.249, 1.258, 1.268, 1.278, 1.287, & - & 1.297, 1.306, 1.315, 1.324, 1.333, 1.342, 1.351, 1.360, 1.369, & - & 1.377, 1.386, 1.394, 1.403, 1.411, 1.419, 1.428, 1.436, 1.444, & - & 1.452, 1.459, 1.467, 1.475, 1.483, 1.490, 1.498, 1.505, 1.513, & - & 1.520, 1.527, 1.535, 1.542, 1.549, 1.556, 1.563, 1.570, 1.577, & - & 1.584, 1.590, 1.597, 1.604, 1.610, 1.617, 1.623, 1.630, 1.636, & - & 1.643, 1.649, 1.655, 1.661, 1.667, 1.674, 1.680, 1.686, 1.692, & - & 1.698, 1.703, 1.709, 1.715, 1.721, 1.727, 1.732, 1.738, 1.744, & - & 1.749, 1.755, 1.760, 1.766, 1.771, 1.776, 1.782, 1.787, 1.792, & - & 1.797, 1.803, 1.808, 1.813, 1.818, 1.823, 1.828, 1.833, 1.838, & - & 1.843, 1.848, 1.853, 1.857, 1.862, 1.867, 1.872, 1.876, 1.881, & - & 1.886, 1.890, 1.895, 1.899, 1.904, 1.908, 1.913, 1.917, 1.922, & - & 1.926, 1.930, 1.935, 1.939, 1.943, 1.948, 1.952, 1.956, 1.960, & - & 1.964, 1.968, 1.973 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.045,-0.090,-0.108,-0.119,-0.126,-0.130,-0.133,-0.135,-0.135, & - -0.135,-0.134,-0.133,-0.131,-0.129,-0.126,-0.124,-0.121,-0.117, & - -0.114,-0.110,-0.106,-0.102,-0.098,-0.093,-0.089,-0.084,-0.079, & - -0.075,-0.070,-0.065,-0.059,-0.054,-0.049,-0.044,-0.038,-0.033, & - -0.027,-0.022,-0.016,-0.010,-0.004, 0.001, 0.007, 0.013, 0.019, & - & 0.025, 0.031, 0.037, 0.043, 0.049, 0.055, 0.061, 0.067, 0.073, & - & 0.079, 0.085, 0.091, 0.098, 0.104, 0.110, 0.116, 0.122, 0.129, & - & 0.135, 0.141, 0.147, 0.154, 0.160, 0.166, 0.173, 0.179, 0.185, & - & 0.192, 0.198, 0.205, 0.211, 0.218, 0.224, 0.231, 0.238, 0.244, & - & 0.251, 0.258, 0.264, 0.271, 0.278, 0.285, 0.292, 0.298, 0.305, & - & 0.312, 0.319, 0.326, 0.333, 0.341, 0.348, 0.355, 0.362, 0.369, & - & 0.377, 0.384, 0.391, 0.398, 0.406, 0.413, 0.421, 0.428, 0.435, & - & 0.443, 0.450, 0.458, 0.465, 0.473, 0.480, 0.488, 0.495, 0.503, & - & 0.510, 0.518, 0.526, 0.533, 0.541, 0.548, 0.556, 0.563, 0.571, & - & 0.578, 0.586, 0.594, 0.601, 0.609, 0.616, 0.624, 0.631, 0.639, & - & 0.646, 0.654, 0.661, 0.669, 0.676, 0.684, 0.691, 0.699, 0.706, & - & 0.713, 0.721, 0.728, 0.736, 0.743, 0.750, 0.758, 0.765, 0.772, & - & 0.780, 0.787, 0.794, 0.802, 0.809, 0.816, 0.823, 0.831, 0.838, & - & 0.845, 0.852, 0.859, 0.867, 0.874, 0.881, 0.888, 0.895, 0.902, & - & 0.909, 0.916, 0.924, 0.931, 0.938, 0.945, 0.952, 0.959, 0.966, & - & 0.973, 0.980, 0.987, 0.994, 1.000, 1.007, 1.014, 1.021, 1.028, & - & 1.035, 1.042, 1.049, 1.055, 1.062, 1.069, 1.076, 1.082, 1.089, & - & 1.096, 1.103, 1.109, 1.116, 1.123, 1.129, 1.136, 1.143, 1.149, & - & 1.156, 1.163, 1.169, 1.176, 1.182, 1.189, 1.195, 1.202, 1.208, & - & 1.215, 1.221, 1.228, 1.234, 1.241, 1.247, 1.254, 1.260, 1.266, & - & 1.273, 1.279, 1.286, 1.292, 1.298, 1.305, 1.311, 1.317, 1.323, & - & 1.330, 1.336, 1.342, 1.348, 1.355, 1.361, 1.367, 1.373, 1.379, & - & 1.386, 1.392, 1.398, 1.404, 1.410, 1.416, 1.422, 1.428, 1.434, & - & 1.440, 1.446, 1.452, 1.458, 1.464, 1.470, 1.476, 1.482, 1.488, & - & 1.494, 1.500, 1.506, 1.512, 1.518, 1.524, 1.530, 1.535, 1.541, & - & 1.547, 1.553, 1.559, 1.564, 1.570, 1.576, 1.582, 1.588, 1.593, & - & 1.599, 1.605, 1.610, 1.616, 1.622, 1.628, 1.633, 1.639, 1.644, & - & 1.650, 1.656, 1.661, 1.667, 1.672, 1.678, 1.684, 1.689, 1.695, & - & 1.700, 1.706, 1.711, 1.717, 1.722, 1.728, 1.733, 1.739, 1.744, & - & 1.750, 1.755, 1.760, 1.766, 1.771, 1.777, 1.782, 1.787, 1.793, & - & 1.798, 1.803, 1.809, 1.814, 1.819, 1.825, 1.830, 1.835, 1.840, & - & 1.846, 1.851, 1.856, 1.861, 1.867, 1.872, 1.877, 1.882, 1.887, & - & 1.893, 1.898, 1.903, 1.908, 1.913, 1.918, 1.923, 1.929, 1.934, & - & 1.939, 1.944, 1.949, 1.954, 1.959, 1.964, 1.969, 1.974, 1.979, & - & 1.984, 1.989, 1.994, 1.999, 2.004, 2.009, 2.014, 2.019, 2.024, & - & 2.029, 2.034, 2.039, 2.044, 2.048, 2.053, 2.058, 2.063, 2.068, & - & 2.073, 2.078, 2.082, 2.087, 2.092, 2.097, 2.102, 2.107, 2.111, & - & 2.116, 2.121, 2.126, 2.130, 2.135, 2.140, 2.145, 2.149, 2.154, & - & 2.159, 2.163, 2.168, 2.173, 2.177, 2.182, 2.187, 2.191, 2.196, & - & 2.201, 2.205, 2.210, 2.215, 2.264, 2.309, 2.353, 2.396, 2.439, & - & 2.481, 2.523, 2.564, 2.604, 2.643, 2.683, 2.721, 2.759, 2.797, & - & 2.834, 2.870, 2.906, 2.941, 2.976, 3.011, 3.045, 3.079, 3.112, & - & 3.145, 3.177, 3.210, 3.241, 3.273, 3.304, 3.334, 3.364, 3.394, & - & 3.424, 3.453, 3.482, 3.511, 3.539, 3.567, 3.595, 3.622, 3.649, & - & 3.676, 3.702, 3.729, 3.755, 3.781, 3.806, 3.831, 3.856, 3.881, & - & 3.906, 3.930, 3.954, 3.978, 4.002, 4.025, 4.048, 4.071, 4.094, & - & 4.117, 4.139, 4.161, 4.183, 4.205, 4.227, 4.248, 4.270, 4.291, & - & 4.312, 4.332, 4.353, 4.373, 4.394, 4.414, 4.434, 4.453, 4.473, & - & 4.493, 4.512, 4.531, 4.550, 4.569, 4.588, 4.606, 4.625, 4.643, & - & 4.661, 4.679, 4.697, 4.715, 4.733, 4.750, 4.768, 4.785, 4.802, & - & 4.819, 4.836, 4.853, 4.870, 4.886, 4.903, 4.919, 4.936, 4.952, & - & 4.968, 4.984, 5.000, 5.015, 5.031, 5.046, 5.062, 5.077, 5.093, & - & 5.108, 5.123, 5.138, 5.153, 5.167, 5.182, 5.197, 5.211, 5.226, & - & 5.240, 5.254, 5.268, 5.282, 5.296, 5.310, 5.324, 5.338, 5.352, & - & 5.365, 5.379, 5.392, 5.406, 5.419, 5.432, 5.445, 5.458, 5.471, & - & 5.484, 5.497, 5.510, 5.523, 5.535, 5.548, 5.560, 5.573, 5.585, & - & 5.598, 5.610, 5.622, 5.634, 5.646, 5.658, 5.670, 5.682, 5.694, & - & 5.706, 5.717, 5.729 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.046,-0.096,-0.118,-0.132,-0.143,-0.151,-0.158,-0.163,-0.167, & - -0.170,-0.173,-0.175,-0.177,-0.178,-0.179,-0.180,-0.180,-0.180, & - -0.180,-0.180,-0.179,-0.179,-0.178,-0.177,-0.176,-0.174,-0.173, & - -0.171,-0.170,-0.168,-0.166,-0.164,-0.162,-0.159,-0.157,-0.155, & - -0.152,-0.150,-0.147,-0.144,-0.142,-0.139,-0.136,-0.133,-0.130, & - -0.127,-0.124,-0.120,-0.117,-0.114,-0.110,-0.107,-0.104,-0.100, & - -0.097,-0.093,-0.090,-0.086,-0.082,-0.079,-0.075,-0.071,-0.067, & - -0.064,-0.060,-0.056,-0.052,-0.048,-0.044,-0.040,-0.036,-0.032, & - -0.028,-0.024,-0.020,-0.015,-0.011,-0.007,-0.003, 0.002, 0.006, & - & 0.010, 0.015, 0.019, 0.024, 0.028, 0.033, 0.037, 0.042, 0.046, & - & 0.051, 0.056, 0.060, 0.065, 0.070, 0.075, 0.079, 0.084, 0.089, & - & 0.094, 0.099, 0.104, 0.109, 0.114, 0.119, 0.124, 0.129, 0.134, & - & 0.139, 0.144, 0.149, 0.154, 0.159, 0.164, 0.169, 0.174, 0.179, & - & 0.184, 0.189, 0.195, 0.200, 0.205, 0.210, 0.215, 0.220, 0.225, & - & 0.230, 0.236, 0.241, 0.246, 0.251, 0.256, 0.261, 0.266, 0.271, & - & 0.276, 0.281, 0.286, 0.291, 0.297, 0.302, 0.307, 0.312, 0.317, & - & 0.322, 0.327, 0.332, 0.337, 0.342, 0.347, 0.352, 0.357, 0.361, & - & 0.366, 0.371, 0.376, 0.381, 0.386, 0.391, 0.396, 0.401, 0.406, & - & 0.410, 0.415, 0.420, 0.425, 0.430, 0.434, 0.439, 0.444, 0.449, & - & 0.454, 0.458, 0.463, 0.468, 0.473, 0.477, 0.482, 0.487, 0.491, & - & 0.496, 0.501, 0.505, 0.510, 0.515, 0.519, 0.524, 0.529, 0.533, & - & 0.538, 0.542, 0.547, 0.551, 0.556, 0.560, 0.565, 0.570, 0.574, & - & 0.579, 0.583, 0.588, 0.592, 0.596, 0.601, 0.605, 0.610, 0.614, & - & 0.619, 0.623, 0.627, 0.632, 0.636, 0.641, 0.645, 0.649, 0.654, & - & 0.658, 0.662, 0.667, 0.671, 0.675, 0.680, 0.684, 0.688, 0.692, & - & 0.697, 0.701, 0.705, 0.709, 0.714, 0.718, 0.722, 0.726, 0.730, & - & 0.735, 0.739, 0.743, 0.747, 0.751, 0.755, 0.759, 0.764, 0.768, & - & 0.772, 0.776, 0.780, 0.784, 0.788, 0.792, 0.796, 0.800, 0.804, & - & 0.808, 0.812, 0.816, 0.820, 0.824, 0.828, 0.832, 0.836, 0.840, & - & 0.844, 0.848, 0.852, 0.856, 0.860, 0.864, 0.868, 0.872, 0.875, & - & 0.879, 0.883, 0.887, 0.891, 0.895, 0.899, 0.902, 0.906, 0.910, & - & 0.914, 0.918, 0.922, 0.925, 0.929, 0.933, 0.937, 0.940, 0.944, & - & 0.948, 0.952, 0.955, 0.959, 0.963, 0.967, 0.970, 0.974, 0.978, & - & 0.981, 0.985, 0.989, 0.992, 0.996, 1.000, 1.003, 1.007, 1.011, & - & 1.014, 1.018, 1.022, 1.025, 1.029, 1.032, 1.036, 1.040, 1.043, & - & 1.047, 1.050, 1.054, 1.057, 1.061, 1.064, 1.068, 1.071, 1.075, & - & 1.079, 1.082, 1.086, 1.089, 1.092, 1.096, 1.099, 1.103, 1.106, & - & 1.110, 1.113, 1.117, 1.120, 1.124, 1.127, 1.130, 1.134, 1.137, & - & 1.141, 1.144, 1.147, 1.151, 1.154, 1.158, 1.161, 1.164, 1.168, & - & 1.171, 1.174, 1.178, 1.181, 1.184, 1.188, 1.191, 1.194, 1.198, & - & 1.201, 1.204, 1.207, 1.211, 1.214, 1.217, 1.220, 1.224, 1.227, & - & 1.230, 1.233, 1.237, 1.240, 1.243, 1.246, 1.250, 1.253, 1.256, & - & 1.259, 1.262, 1.266, 1.269, 1.272, 1.275, 1.278, 1.281, 1.285, & - & 1.288, 1.291, 1.294, 1.297, 1.300, 1.303, 1.306, 1.310, 1.313, & - & 1.316, 1.319, 1.322, 1.325, 1.358, 1.388, 1.418, 1.447, 1.476, & - & 1.504, 1.532, 1.559, 1.586, 1.613, 1.639, 1.665, 1.691, 1.716, & - & 1.741, 1.766, 1.790, 1.814, 1.838, 1.861, 1.884, 1.907, 1.929, & - & 1.951, 1.973, 1.995, 2.016, 2.037, 2.058, 2.079, 2.099, 2.120, & - & 2.140, 2.159, 2.179, 2.198, 2.217, 2.236, 2.255, 2.274, 2.292, & - & 2.310, 2.328, 2.346, 2.363, 2.381, 2.398, 2.415, 2.432, 2.449, & - & 2.465, 2.482, 2.498, 2.514, 2.530, 2.546, 2.562, 2.577, 2.592, & - & 2.608, 2.623, 2.638, 2.653, 2.667, 2.682, 2.697, 2.711, 2.725, & - & 2.739, 2.753, 2.767, 2.781, 2.795, 2.808, 2.822, 2.835, 2.848, & - & 2.861, 2.874, 2.887, 2.900, 2.913, 2.925, 2.938, 2.950, 2.963, & - & 2.975, 2.987, 2.999, 3.011, 3.023, 3.035, 3.046, 3.058, 3.069, & - & 3.081, 3.092, 3.104, 3.115, 3.126, 3.137, 3.148, 3.159, 3.170, & - & 3.180, 3.191, 3.202, 3.212, 3.223, 3.233, 3.244, 3.254, 3.264, & - & 3.274, 3.284, 3.294, 3.304, 3.314, 3.324, 3.334, 3.343, 3.353, & - & 3.363, 3.372, 3.382, 3.391, 3.400, 3.410, 3.419, 3.428, 3.437, & - & 3.446, 3.455, 3.464, 3.473, 3.482, 3.491, 3.499, 3.508, 3.517, & - & 3.525, 3.534, 3.542, 3.551, 3.559, 3.568, 3.576, 3.584, 3.592, & - & 3.601, 3.609, 3.617, 3.625, 3.633, 3.641, 3.649, 3.657, 3.664, & - & 3.672, 3.680, 3.688 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.076,-0.165,-0.209,-0.240,-0.264,-0.284,-0.301,-0.316,-0.329, & - -0.341,-0.352,-0.362,-0.371,-0.379,-0.387,-0.394,-0.401,-0.408, & - -0.414,-0.420,-0.425,-0.430,-0.435,-0.440,-0.444,-0.449,-0.453, & - -0.457,-0.460,-0.464,-0.467,-0.471,-0.474,-0.477,-0.480,-0.483, & - -0.485,-0.488,-0.490,-0.493,-0.495,-0.497,-0.499,-0.501,-0.503, & - -0.505,-0.507,-0.509,-0.510,-0.512,-0.514,-0.515,-0.516,-0.518, & - -0.519,-0.520,-0.522,-0.523,-0.524,-0.525,-0.526,-0.527,-0.528, & - -0.529,-0.530,-0.531,-0.532,-0.532,-0.533,-0.534,-0.534,-0.535, & - -0.536,-0.536,-0.537,-0.537,-0.538,-0.538,-0.539,-0.539,-0.540, & - -0.540,-0.540,-0.541,-0.541,-0.541,-0.542,-0.542,-0.542,-0.542, & - -0.542,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543, & - -0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543,-0.543, & - -0.543,-0.542,-0.542,-0.542,-0.542,-0.542,-0.542,-0.542,-0.541, & - -0.541,-0.541,-0.541,-0.540,-0.540,-0.540,-0.540,-0.540,-0.539, & - -0.539,-0.539,-0.538,-0.538,-0.538,-0.538,-0.537,-0.537,-0.537, & - -0.536,-0.536,-0.536,-0.536,-0.535,-0.535,-0.535,-0.534,-0.534, & - -0.534,-0.533,-0.533,-0.533,-0.532,-0.532,-0.532,-0.531,-0.531, & - -0.530,-0.530,-0.530,-0.529,-0.529,-0.529,-0.528,-0.528,-0.528, & - -0.527,-0.527,-0.527,-0.526,-0.526,-0.525,-0.525,-0.525,-0.524, & - -0.524,-0.524,-0.523,-0.523,-0.522,-0.522,-0.522,-0.521,-0.521, & - -0.521,-0.520,-0.520,-0.519,-0.519,-0.519,-0.518,-0.518,-0.518, & - -0.517,-0.517,-0.516,-0.516,-0.516,-0.515,-0.515,-0.515,-0.514, & - -0.514,-0.513,-0.513,-0.513,-0.512,-0.512,-0.512,-0.511,-0.511, & - -0.510,-0.510,-0.510,-0.509,-0.509,-0.509,-0.508,-0.508,-0.507, & - -0.507,-0.507,-0.506,-0.506,-0.506,-0.505,-0.505,-0.504,-0.504, & - -0.504,-0.503,-0.503,-0.503,-0.502,-0.502,-0.501,-0.501,-0.501, & - -0.500,-0.500,-0.500,-0.499,-0.499,-0.499,-0.498,-0.498,-0.497, & - -0.497,-0.497,-0.496,-0.496,-0.496,-0.495,-0.495,-0.495,-0.494, & - -0.494,-0.493,-0.493,-0.493,-0.492,-0.492,-0.492,-0.491,-0.491, & - -0.491,-0.490,-0.490,-0.490,-0.489,-0.489,-0.489,-0.488,-0.488, & - -0.487,-0.487,-0.487,-0.486,-0.486,-0.486,-0.485,-0.485,-0.485, & - -0.484,-0.484,-0.484,-0.483,-0.483,-0.483,-0.482,-0.482,-0.482, & - -0.481,-0.481,-0.481,-0.480,-0.480,-0.480,-0.479,-0.479,-0.479, & - -0.478,-0.478,-0.478,-0.477,-0.477,-0.477,-0.476,-0.476,-0.476, & - -0.475,-0.475,-0.475,-0.474,-0.474,-0.474,-0.473,-0.473,-0.473, & - -0.472,-0.472,-0.472,-0.471,-0.471,-0.471,-0.471,-0.470,-0.470, & - -0.470,-0.469,-0.469,-0.469,-0.468,-0.468,-0.468,-0.467,-0.467, & - -0.467,-0.466,-0.466,-0.466,-0.466,-0.465,-0.465,-0.465,-0.464, & - -0.464,-0.464,-0.463,-0.463,-0.463,-0.463,-0.462,-0.462,-0.462, & - -0.461,-0.461,-0.461,-0.460,-0.460,-0.460,-0.460,-0.459,-0.459, & - -0.459,-0.458,-0.458,-0.458,-0.458,-0.457,-0.457,-0.457,-0.456, & - -0.456,-0.456,-0.456,-0.455,-0.455,-0.455,-0.454,-0.454,-0.454, & - -0.454,-0.453,-0.453,-0.453,-0.452,-0.452,-0.452,-0.452,-0.451, & - -0.451,-0.451,-0.450,-0.450,-0.450,-0.450,-0.449,-0.449,-0.449, & - -0.449,-0.448,-0.448,-0.448,-0.445,-0.442,-0.440,-0.437,-0.435, & - -0.432,-0.430,-0.428,-0.426,-0.423,-0.421,-0.419,-0.417,-0.415, & - -0.413,-0.411,-0.409,-0.407,-0.406,-0.404,-0.402,-0.401,-0.399, & - -0.397,-0.396,-0.394,-0.393,-0.391,-0.390,-0.389,-0.387,-0.386, & - -0.385,-0.383,-0.382,-0.381,-0.380,-0.379,-0.378,-0.377,-0.376, & - -0.375,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369,-0.368,-0.367, & - -0.367,-0.366,-0.365,-0.364,-0.364,-0.363,-0.362,-0.362,-0.361, & - -0.361,-0.360,-0.360,-0.359,-0.359,-0.358,-0.358,-0.357,-0.357, & - -0.356,-0.356,-0.356,-0.355,-0.355,-0.355,-0.354,-0.354,-0.354, & - -0.354,-0.353,-0.353,-0.353,-0.353,-0.353,-0.352,-0.352,-0.352, & - -0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352, & - -0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352,-0.352, & - -0.352,-0.353,-0.353,-0.353,-0.353,-0.353,-0.353,-0.354,-0.354, & - -0.354,-0.354,-0.355,-0.355,-0.355,-0.355,-0.356,-0.356,-0.356, & - -0.357,-0.357,-0.357,-0.358,-0.358,-0.358,-0.359,-0.359,-0.359, & - -0.360,-0.360,-0.361,-0.361,-0.362,-0.362,-0.362,-0.363,-0.363, & - -0.364,-0.364,-0.365,-0.365,-0.366,-0.366,-0.367,-0.367,-0.368, & - -0.369,-0.369,-0.370,-0.370,-0.371,-0.371,-0.372,-0.373,-0.373, & - -0.374,-0.374,-0.375 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.094,-0.201,-0.251,-0.286,-0.312,-0.334,-0.351,-0.366,-0.379, & - -0.390,-0.400,-0.409,-0.417,-0.424,-0.430,-0.436,-0.442,-0.447, & - -0.451,-0.455,-0.459,-0.463,-0.466,-0.469,-0.472,-0.475,-0.477, & - -0.479,-0.481,-0.483,-0.485,-0.487,-0.489,-0.490,-0.491,-0.493, & - -0.494,-0.495,-0.496,-0.497,-0.498,-0.499,-0.500,-0.501,-0.501, & - -0.502,-0.503,-0.503,-0.504,-0.504,-0.505,-0.505,-0.505,-0.506, & - -0.506,-0.506,-0.507,-0.507,-0.507,-0.507,-0.507,-0.508,-0.508, & - -0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508,-0.508, & - -0.508,-0.507,-0.507,-0.507,-0.507,-0.507,-0.506,-0.506,-0.506, & - -0.506,-0.505,-0.505,-0.505,-0.504,-0.504,-0.503,-0.503,-0.502, & - -0.502,-0.501,-0.501,-0.500,-0.500,-0.499,-0.499,-0.498,-0.497, & - -0.497,-0.496,-0.495,-0.495,-0.494,-0.493,-0.493,-0.492,-0.491, & - -0.490,-0.489,-0.489,-0.488,-0.487,-0.486,-0.485,-0.485,-0.484, & - -0.483,-0.482,-0.481,-0.480,-0.479,-0.478,-0.477,-0.477,-0.476, & - -0.475,-0.474,-0.473,-0.472,-0.471,-0.470,-0.469,-0.468,-0.467, & - -0.466,-0.465,-0.464,-0.463,-0.462,-0.461,-0.460,-0.459,-0.459, & - -0.458,-0.457,-0.456,-0.455,-0.454,-0.453,-0.452,-0.451,-0.450, & - -0.449,-0.448,-0.447,-0.446,-0.445,-0.444,-0.443,-0.442,-0.441, & - -0.440,-0.439,-0.438,-0.437,-0.436,-0.435,-0.434,-0.433,-0.432, & - -0.431,-0.430,-0.429,-0.428,-0.427,-0.426,-0.425,-0.424,-0.423, & - -0.422,-0.421,-0.420,-0.419,-0.418,-0.417,-0.416,-0.415,-0.414, & - -0.413,-0.412,-0.411,-0.410,-0.409,-0.408,-0.407,-0.406,-0.405, & - -0.404,-0.403,-0.402,-0.401,-0.400,-0.399,-0.398,-0.397,-0.396, & - -0.395,-0.394,-0.393,-0.392,-0.391,-0.390,-0.389,-0.388,-0.387, & - -0.386,-0.385,-0.384,-0.383,-0.382,-0.382,-0.381,-0.380,-0.379, & - -0.378,-0.377,-0.376,-0.375,-0.374,-0.373,-0.372,-0.371,-0.370, & - -0.369,-0.368,-0.367,-0.366,-0.365,-0.364,-0.363,-0.362,-0.361, & - -0.360,-0.359,-0.359,-0.358,-0.357,-0.356,-0.355,-0.354,-0.353, & - -0.352,-0.351,-0.350,-0.349,-0.348,-0.347,-0.346,-0.345,-0.344, & - -0.344,-0.343,-0.342,-0.341,-0.340,-0.339,-0.338,-0.337,-0.336, & - -0.335,-0.334,-0.333,-0.332,-0.332,-0.331,-0.330,-0.329,-0.328, & - -0.327,-0.326,-0.325,-0.324,-0.323,-0.323,-0.322,-0.321,-0.320, & - -0.319,-0.318,-0.317,-0.316,-0.315,-0.314,-0.314,-0.313,-0.312, & - -0.311,-0.310,-0.309,-0.308,-0.307,-0.307,-0.306,-0.305,-0.304, & - -0.303,-0.302,-0.301,-0.300,-0.300,-0.299,-0.298,-0.297,-0.296, & - -0.295,-0.294,-0.294,-0.293,-0.292,-0.291,-0.290,-0.289,-0.288, & - -0.288,-0.287,-0.286,-0.285,-0.284,-0.283,-0.282,-0.282,-0.281, & - -0.280,-0.279,-0.278,-0.277,-0.277,-0.276,-0.275,-0.274,-0.273, & - -0.273,-0.272,-0.271,-0.270,-0.269,-0.268,-0.268,-0.267,-0.266, & - -0.265,-0.264,-0.263,-0.263,-0.262,-0.261,-0.260,-0.259,-0.259, & - -0.258,-0.257,-0.256,-0.255,-0.255,-0.254,-0.253,-0.252,-0.251, & - -0.251,-0.250,-0.249,-0.248,-0.248,-0.247,-0.246,-0.245,-0.244, & - -0.244,-0.243,-0.242,-0.241,-0.240,-0.240,-0.239,-0.238,-0.237, & - -0.237,-0.236,-0.235,-0.234,-0.234,-0.233,-0.232,-0.231,-0.230, & - -0.230,-0.229,-0.228,-0.227,-0.219,-0.212,-0.205,-0.198,-0.191, & - -0.184,-0.177,-0.170,-0.163,-0.157,-0.151,-0.144,-0.138,-0.132, & - -0.126,-0.120,-0.114,-0.108,-0.103,-0.097,-0.091,-0.086,-0.081, & - -0.075,-0.070,-0.065,-0.060,-0.055,-0.050,-0.045,-0.041,-0.036, & - -0.031,-0.027,-0.022,-0.018,-0.014,-0.009,-0.005,-0.001, 0.003, & - & 0.007, 0.011, 0.015, 0.019, 0.023, 0.027, 0.031, 0.034, 0.038, & - & 0.041, 0.045, 0.048, 0.052, 0.055, 0.059, 0.062, 0.065, 0.068, & - & 0.071, 0.075, 0.078, 0.081, 0.084, 0.087, 0.089, 0.092, 0.095, & - & 0.098, 0.101, 0.103, 0.106, 0.109, 0.111, 0.114, 0.116, 0.119, & - & 0.121, 0.124, 0.126, 0.128, 0.131, 0.133, 0.135, 0.138, 0.140, & - & 0.142, 0.144, 0.146, 0.148, 0.150, 0.152, 0.154, 0.156, 0.158, & - & 0.160, 0.162, 0.164, 0.166, 0.167, 0.169, 0.171, 0.173, 0.174, & - & 0.176, 0.178, 0.179, 0.181, 0.182, 0.184, 0.186, 0.187, 0.189, & - & 0.190, 0.191, 0.193, 0.194, 0.196, 0.197, 0.198, 0.200, 0.201, & - & 0.202, 0.203, 0.205, 0.206, 0.207, 0.208, 0.209, 0.210, 0.212, & - & 0.213, 0.214, 0.215, 0.216, 0.217, 0.218, 0.219, 0.220, 0.221, & - & 0.222, 0.222, 0.223, 0.224, 0.225, 0.226, 0.227, 0.228, 0.228, & - & 0.229, 0.230, 0.231, 0.231, 0.232, 0.233, 0.234, 0.234, 0.235, & - & 0.235, 0.236, 0.237 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.093,-0.193,-0.238,-0.267,-0.288,-0.304,-0.316,-0.326,-0.334, & - -0.340,-0.345,-0.350,-0.353,-0.355,-0.357,-0.359,-0.360,-0.360, & - -0.360,-0.360,-0.359,-0.358,-0.357,-0.356,-0.355,-0.353,-0.351, & - -0.349,-0.347,-0.345,-0.342,-0.340,-0.337,-0.335,-0.332,-0.329, & - -0.326,-0.323,-0.321,-0.317,-0.314,-0.311,-0.308,-0.305,-0.302, & - -0.299,-0.295,-0.292,-0.289,-0.286,-0.282,-0.279,-0.276,-0.272, & - -0.269,-0.266,-0.262,-0.259,-0.255,-0.252,-0.249,-0.245,-0.242, & - -0.238,-0.235,-0.231,-0.228,-0.224,-0.221,-0.217,-0.213,-0.210, & - -0.206,-0.203,-0.199,-0.195,-0.192,-0.188,-0.184,-0.180,-0.177, & - -0.173,-0.169,-0.165,-0.161,-0.157,-0.153,-0.149,-0.145,-0.141, & - -0.137,-0.133,-0.129,-0.125,-0.120,-0.116,-0.112,-0.108,-0.103, & - -0.099,-0.095,-0.090,-0.086,-0.081,-0.077,-0.073,-0.068,-0.064, & - -0.059,-0.054,-0.050,-0.045,-0.041,-0.036,-0.032,-0.027,-0.022, & - -0.018,-0.013,-0.008,-0.004, 0.001, 0.005, 0.010, 0.015, 0.019, & - & 0.024, 0.029, 0.033, 0.038, 0.043, 0.048, 0.052, 0.057, 0.062, & - & 0.066, 0.071, 0.076, 0.080, 0.085, 0.090, 0.094, 0.099, 0.103, & - & 0.108, 0.113, 0.117, 0.122, 0.127, 0.131, 0.136, 0.141, 0.145, & - & 0.150, 0.154, 0.159, 0.164, 0.168, 0.173, 0.177, 0.182, 0.186, & - & 0.191, 0.196, 0.200, 0.205, 0.209, 0.214, 0.218, 0.223, 0.227, & - & 0.232, 0.236, 0.241, 0.245, 0.250, 0.254, 0.259, 0.263, 0.268, & - & 0.272, 0.277, 0.281, 0.286, 0.290, 0.294, 0.299, 0.303, 0.308, & - & 0.312, 0.317, 0.321, 0.325, 0.330, 0.334, 0.338, 0.343, 0.347, & - & 0.352, 0.356, 0.360, 0.365, 0.369, 0.373, 0.378, 0.382, 0.386, & - & 0.390, 0.395, 0.399, 0.403, 0.408, 0.412, 0.416, 0.420, 0.425, & - & 0.429, 0.433, 0.437, 0.442, 0.446, 0.450, 0.454, 0.458, 0.463, & - & 0.467, 0.471, 0.475, 0.479, 0.483, 0.488, 0.492, 0.496, 0.500, & - & 0.504, 0.508, 0.512, 0.516, 0.521, 0.525, 0.529, 0.533, 0.537, & - & 0.541, 0.545, 0.549, 0.553, 0.557, 0.561, 0.565, 0.569, 0.573, & - & 0.577, 0.581, 0.585, 0.589, 0.593, 0.597, 0.601, 0.605, 0.609, & - & 0.613, 0.617, 0.621, 0.625, 0.629, 0.633, 0.637, 0.641, 0.644, & - & 0.648, 0.652, 0.656, 0.660, 0.664, 0.668, 0.672, 0.675, 0.679, & - & 0.683, 0.687, 0.691, 0.695, 0.698, 0.702, 0.706, 0.710, 0.714, & - & 0.717, 0.721, 0.725, 0.729, 0.733, 0.736, 0.740, 0.744, 0.748, & - & 0.751, 0.755, 0.759, 0.762, 0.766, 0.770, 0.774, 0.777, 0.781, & - & 0.785, 0.788, 0.792, 0.796, 0.799, 0.803, 0.807, 0.810, 0.814, & - & 0.818, 0.821, 0.825, 0.828, 0.832, 0.836, 0.839, 0.843, 0.846, & - & 0.850, 0.853, 0.857, 0.861, 0.864, 0.868, 0.871, 0.875, 0.878, & - & 0.882, 0.885, 0.889, 0.892, 0.896, 0.899, 0.903, 0.906, 0.910, & - & 0.913, 0.917, 0.920, 0.924, 0.927, 0.931, 0.934, 0.938, 0.941, & - & 0.944, 0.948, 0.951, 0.955, 0.958, 0.961, 0.965, 0.968, 0.972, & - & 0.975, 0.978, 0.982, 0.985, 0.988, 0.992, 0.995, 0.999, 1.002, & - & 1.005, 1.009, 1.012, 1.015, 1.018, 1.022, 1.025, 1.028, 1.032, & - & 1.035, 1.038, 1.042, 1.045, 1.048, 1.051, 1.055, 1.058, 1.061, & - & 1.064, 1.068, 1.071, 1.074, 1.077, 1.080, 1.084, 1.087, 1.090, & - & 1.093, 1.096, 1.100, 1.103, 1.137, 1.168, 1.199, 1.229, 1.259, & - & 1.288, 1.317, 1.345, 1.373, 1.401, 1.428, 1.455, 1.482, 1.508, & - & 1.534, 1.559, 1.584, 1.609, 1.634, 1.658, 1.682, 1.706, 1.729, & - & 1.752, 1.775, 1.797, 1.819, 1.841, 1.863, 1.884, 1.905, 1.926, & - & 1.947, 1.967, 1.988, 2.008, 2.027, 2.047, 2.066, 2.085, 2.104, & - & 2.123, 2.141, 2.160, 2.178, 2.196, 2.214, 2.231, 2.249, 2.266, & - & 2.283, 2.300, 2.316, 2.333, 2.349, 2.365, 2.381, 2.397, 2.413, & - & 2.429, 2.444, 2.459, 2.475, 2.490, 2.504, 2.519, 2.534, 2.548, & - & 2.563, 2.577, 2.591, 2.605, 2.619, 2.632, 2.646, 2.659, 2.673, & - & 2.686, 2.699, 2.712, 2.725, 2.738, 2.751, 2.763, 2.776, 2.788, & - & 2.800, 2.813, 2.825, 2.837, 2.849, 2.860, 2.872, 2.884, 2.895, & - & 2.907, 2.918, 2.929, 2.940, 2.952, 2.963, 2.973, 2.984, 2.995, & - & 3.006, 3.016, 3.027, 3.037, 3.048, 3.058, 3.068, 3.078, 3.088, & - & 3.098, 3.108, 3.118, 3.128, 3.137, 3.147, 3.157, 3.166, 3.176, & - & 3.185, 3.194, 3.203, 3.213, 3.222, 3.231, 3.240, 3.249, 3.258, & - & 3.266, 3.275, 3.284, 3.292, 3.301, 3.309, 3.318, 3.326, 3.335, & - & 3.343, 3.351, 3.359, 3.368, 3.376, 3.384, 3.392, 3.399, 3.407, & - & 3.415, 3.423, 3.431, 3.438, 3.446, 3.454, 3.461, 3.469, 3.476, & - & 3.483, 3.491, 3.498 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.096,-0.208,-0.265,-0.305,-0.337,-0.363,-0.385,-0.405,-0.423, & - -0.439,-0.453,-0.467,-0.479,-0.491,-0.502,-0.512,-0.522,-0.531, & - -0.540,-0.548,-0.556,-0.564,-0.571,-0.578,-0.585,-0.592,-0.598, & - -0.605,-0.610,-0.616,-0.622,-0.627,-0.633,-0.638,-0.643,-0.648, & - -0.653,-0.657,-0.662,-0.666,-0.671,-0.675,-0.679,-0.683,-0.688, & - -0.691,-0.695,-0.699,-0.703,-0.707,-0.710,-0.714,-0.717,-0.721, & - -0.724,-0.727,-0.731,-0.734,-0.737,-0.740,-0.743,-0.746,-0.749, & - -0.752,-0.755,-0.758,-0.761,-0.763,-0.766,-0.769,-0.772,-0.774, & - -0.777,-0.780,-0.782,-0.785,-0.787,-0.790,-0.792,-0.795,-0.797, & - -0.799,-0.802,-0.804,-0.807,-0.809,-0.811,-0.814,-0.816,-0.818, & - -0.820,-0.823,-0.825,-0.827,-0.829,-0.831,-0.833,-0.836,-0.838, & - -0.840,-0.842,-0.844,-0.846,-0.848,-0.850,-0.852,-0.854,-0.856, & - -0.858,-0.860,-0.862,-0.864,-0.866,-0.868,-0.870,-0.872,-0.874, & - -0.875,-0.877,-0.879,-0.881,-0.883,-0.885,-0.887,-0.888,-0.890, & - -0.892,-0.894,-0.895,-0.897,-0.899,-0.901,-0.902,-0.904,-0.906, & - -0.908,-0.909,-0.911,-0.913,-0.914,-0.916,-0.918,-0.919,-0.921, & - -0.923,-0.924,-0.926,-0.927,-0.929,-0.931,-0.932,-0.934,-0.935, & - -0.937,-0.938,-0.940,-0.942,-0.943,-0.945,-0.946,-0.948,-0.949, & - -0.951,-0.952,-0.954,-0.955,-0.957,-0.958,-0.960,-0.961,-0.962, & - -0.964,-0.965,-0.967,-0.968,-0.970,-0.971,-0.972,-0.974,-0.975, & - -0.977,-0.978,-0.979,-0.981,-0.982,-0.984,-0.985,-0.986,-0.988, & - -0.989,-0.990,-0.992,-0.993,-0.994,-0.996,-0.997,-0.998,-1.000, & - -1.001,-1.002,-1.004,-1.005,-1.006,-1.007,-1.009,-1.010,-1.011, & - -1.013,-1.014,-1.015,-1.016,-1.018,-1.019,-1.020,-1.021,-1.023, & - -1.024,-1.025,-1.026,-1.027,-1.029,-1.030,-1.031,-1.032,-1.034, & - -1.035,-1.036,-1.037,-1.038,-1.039,-1.041,-1.042,-1.043,-1.044, & - -1.045,-1.047,-1.048,-1.049,-1.050,-1.051,-1.052,-1.053,-1.055, & - -1.056,-1.057,-1.058,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065, & - -1.066,-1.067,-1.068,-1.069,-1.070,-1.071,-1.073,-1.074,-1.075, & - -1.076,-1.077,-1.078,-1.079,-1.080,-1.081,-1.082,-1.083,-1.084, & - -1.086,-1.087,-1.088,-1.089,-1.090,-1.091,-1.092,-1.093,-1.094, & - -1.095,-1.096,-1.097,-1.098,-1.099,-1.100,-1.101,-1.102,-1.103, & - -1.104,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110,-1.111,-1.112, & - -1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.119,-1.120,-1.121, & - -1.122,-1.123,-1.124,-1.125,-1.126,-1.127,-1.128,-1.129,-1.130, & - -1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, & - -1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.147, & - -1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155,-1.156, & - -1.157,-1.158,-1.159,-1.160,-1.160,-1.161,-1.162,-1.163,-1.164, & - -1.165,-1.166,-1.167,-1.168,-1.169,-1.169,-1.170,-1.171,-1.172, & - -1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, & - -1.181,-1.182,-1.183,-1.184,-1.185,-1.185,-1.186,-1.187,-1.188, & - -1.189,-1.190,-1.191,-1.191,-1.192,-1.193,-1.194,-1.195,-1.196, & - -1.197,-1.198,-1.198,-1.199,-1.200,-1.201,-1.202,-1.203,-1.203, & - -1.204,-1.205,-1.206,-1.207,-1.216,-1.224,-1.232,-1.240,-1.248, & - -1.256,-1.263,-1.271,-1.279,-1.286,-1.293,-1.301,-1.308,-1.315, & - -1.322,-1.329,-1.336,-1.343,-1.349,-1.356,-1.363,-1.369,-1.376, & - -1.382,-1.389,-1.395,-1.402,-1.408,-1.414,-1.420,-1.427,-1.433, & - -1.439,-1.445,-1.451,-1.457,-1.463,-1.468,-1.474,-1.480,-1.486, & - -1.492,-1.497,-1.503,-1.509,-1.514,-1.520,-1.525,-1.531,-1.536, & - -1.542,-1.547,-1.553,-1.558,-1.563,-1.569,-1.574,-1.579,-1.585, & - -1.590,-1.595,-1.600,-1.605,-1.611,-1.616,-1.621,-1.626,-1.631, & - -1.636,-1.641,-1.646,-1.651,-1.656,-1.661,-1.666,-1.671,-1.676, & - -1.681,-1.685,-1.690,-1.695,-1.700,-1.705,-1.710,-1.714,-1.719, & - -1.724,-1.729,-1.733,-1.738,-1.743,-1.747,-1.752,-1.757,-1.761, & - -1.766,-1.770,-1.775,-1.780,-1.784,-1.789,-1.793,-1.798,-1.802, & - -1.807,-1.811,-1.816,-1.820,-1.825,-1.829,-1.834,-1.838,-1.842, & - -1.847,-1.851,-1.856,-1.860,-1.864,-1.869,-1.873,-1.877,-1.882, & - -1.886,-1.890,-1.895,-1.899,-1.903,-1.908,-1.912,-1.916,-1.920, & - -1.925,-1.929,-1.933,-1.937,-1.941,-1.946,-1.950,-1.954,-1.958, & - -1.962,-1.966,-1.971,-1.975,-1.979,-1.983,-1.987,-1.991,-1.995, & - -2.000,-2.004,-2.008,-2.012,-2.016,-2.020,-2.024,-2.028,-2.032, & - -2.036,-2.040,-2.044 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.047,-0.099,-0.124,-0.141,-0.154,-0.165,-0.173,-0.181,-0.187, & - -0.193,-0.198,-0.202,-0.206,-0.209,-0.212,-0.215,-0.217,-0.220, & - -0.221,-0.223,-0.225,-0.226,-0.227,-0.228,-0.229,-0.229,-0.230, & - -0.230,-0.230,-0.230,-0.230,-0.230,-0.230,-0.229,-0.229,-0.228, & - -0.228,-0.227,-0.226,-0.225,-0.224,-0.223,-0.222,-0.221,-0.220, & - -0.218,-0.217,-0.215,-0.214,-0.212,-0.210,-0.209,-0.207,-0.205, & - -0.203,-0.201,-0.199,-0.197,-0.195,-0.193,-0.191,-0.189,-0.187, & - -0.185,-0.182,-0.180,-0.178,-0.175,-0.173,-0.171,-0.168,-0.166, & - -0.163,-0.160,-0.158,-0.155,-0.153,-0.150,-0.147,-0.144,-0.142, & - -0.139,-0.136,-0.133,-0.130,-0.127,-0.124,-0.121,-0.118,-0.115, & - -0.112,-0.109,-0.106,-0.103,-0.100,-0.097,-0.094,-0.091,-0.087, & - -0.084,-0.081,-0.078,-0.074,-0.071,-0.068,-0.064,-0.061,-0.058, & - -0.054,-0.051,-0.047,-0.044,-0.041,-0.037,-0.034,-0.030,-0.027, & - -0.023,-0.020,-0.017,-0.013,-0.010,-0.006,-0.003, 0.001, 0.004, & - & 0.008, 0.011, 0.015, 0.018, 0.021, 0.025, 0.028, 0.032, 0.035, & - & 0.039, 0.042, 0.046, 0.049, 0.052, 0.056, 0.059, 0.063, 0.066, & - & 0.069, 0.073, 0.076, 0.079, 0.083, 0.086, 0.090, 0.093, 0.096, & - & 0.100, 0.103, 0.106, 0.110, 0.113, 0.116, 0.119, 0.123, 0.126, & - & 0.129, 0.133, 0.136, 0.139, 0.142, 0.146, 0.149, 0.152, 0.155, & - & 0.158, 0.162, 0.165, 0.168, 0.171, 0.174, 0.177, 0.181, 0.184, & - & 0.187, 0.190, 0.193, 0.196, 0.199, 0.203, 0.206, 0.209, 0.212, & - & 0.215, 0.218, 0.221, 0.224, 0.227, 0.230, 0.233, 0.236, 0.239, & - & 0.242, 0.245, 0.248, 0.251, 0.254, 0.257, 0.260, 0.263, 0.266, & - & 0.269, 0.272, 0.275, 0.278, 0.281, 0.284, 0.287, 0.290, 0.292, & - & 0.295, 0.298, 0.301, 0.304, 0.307, 0.310, 0.313, 0.315, 0.318, & - & 0.321, 0.324, 0.327, 0.330, 0.332, 0.335, 0.338, 0.341, 0.343, & - & 0.346, 0.349, 0.352, 0.355, 0.357, 0.360, 0.363, 0.366, 0.368, & - & 0.371, 0.374, 0.376, 0.379, 0.382, 0.384, 0.387, 0.390, 0.393, & - & 0.395, 0.398, 0.400, 0.403, 0.406, 0.408, 0.411, 0.414, 0.416, & - & 0.419, 0.422, 0.424, 0.427, 0.429, 0.432, 0.434, 0.437, 0.440, & - & 0.442, 0.445, 0.447, 0.450, 0.452, 0.455, 0.457, 0.460, 0.463, & - & 0.465, 0.468, 0.470, 0.473, 0.475, 0.478, 0.480, 0.483, 0.485, & - & 0.487, 0.490, 0.492, 0.495, 0.497, 0.500, 0.502, 0.505, 0.507, & - & 0.509, 0.512, 0.514, 0.517, 0.519, 0.522, 0.524, 0.526, 0.529, & - & 0.531, 0.533, 0.536, 0.538, 0.541, 0.543, 0.545, 0.548, 0.550, & - & 0.552, 0.555, 0.557, 0.559, 0.562, 0.564, 0.566, 0.569, 0.571, & - & 0.573, 0.575, 0.578, 0.580, 0.582, 0.585, 0.587, 0.589, 0.591, & - & 0.594, 0.596, 0.598, 0.600, 0.603, 0.605, 0.607, 0.609, 0.612, & - & 0.614, 0.616, 0.618, 0.621, 0.623, 0.625, 0.627, 0.629, 0.632, & - & 0.634, 0.636, 0.638, 0.640, 0.642, 0.645, 0.647, 0.649, 0.651, & - & 0.653, 0.655, 0.658, 0.660, 0.662, 0.664, 0.666, 0.668, 0.670, & - & 0.672, 0.675, 0.677, 0.679, 0.681, 0.683, 0.685, 0.687, 0.689, & - & 0.691, 0.693, 0.695, 0.698, 0.700, 0.702, 0.704, 0.706, 0.708, & - & 0.710, 0.712, 0.714, 0.716, 0.718, 0.720, 0.722, 0.724, 0.726, & - & 0.728, 0.730, 0.732, 0.734, 0.756, 0.775, 0.795, 0.814, 0.832, & - & 0.851, 0.869, 0.886, 0.904, 0.921, 0.938, 0.955, 0.972, 0.988, & - & 1.004, 1.020, 1.036, 1.051, 1.066, 1.081, 1.096, 1.111, 1.125, & - & 1.140, 1.154, 1.168, 1.181, 1.195, 1.208, 1.222, 1.235, 1.248, & - & 1.261, 1.273, 1.286, 1.298, 1.311, 1.323, 1.335, 1.347, 1.358, & - & 1.370, 1.381, 1.393, 1.404, 1.415, 1.426, 1.437, 1.448, 1.459, & - & 1.469, 1.480, 1.490, 1.500, 1.510, 1.521, 1.531, 1.540, 1.550, & - & 1.560, 1.570, 1.579, 1.589, 1.598, 1.607, 1.616, 1.625, 1.635, & - & 1.643, 1.652, 1.661, 1.670, 1.679, 1.687, 1.696, 1.704, 1.712, & - & 1.721, 1.729, 1.737, 1.745, 1.753, 1.761, 1.769, 1.777, 1.785, & - & 1.792, 1.800, 1.808, 1.815, 1.823, 1.830, 1.838, 1.845, 1.852, & - & 1.859, 1.866, 1.874, 1.881, 1.888, 1.895, 1.901, 1.908, 1.915, & - & 1.922, 1.929, 1.935, 1.942, 1.948, 1.955, 1.961, 1.968, 1.974, & - & 1.980, 1.987, 1.993, 1.999, 2.005, 2.011, 2.018, 2.024, 2.030, & - & 2.036, 2.041, 2.047, 2.053, 2.059, 2.065, 2.070, 2.076, 2.082, & - & 2.087, 2.093, 2.099, 2.104, 2.110, 2.115, 2.120, 2.126, 2.131, & - & 2.136, 2.142, 2.147, 2.152, 2.157, 2.163, 2.168, 2.173, 2.178, & - & 2.183, 2.188, 2.193, 2.198, 2.203, 2.208, 2.212, 2.217, 2.222, & - & 2.227, 2.232, 2.236 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.049,-0.112,-0.147,-0.173,-0.194,-0.213,-0.230,-0.245,-0.259, & - -0.272,-0.285,-0.297,-0.308,-0.319,-0.329,-0.339,-0.348,-0.358, & - -0.367,-0.376,-0.384,-0.392,-0.401,-0.408,-0.416,-0.424,-0.431, & - -0.439,-0.446,-0.453,-0.460,-0.466,-0.473,-0.479,-0.486,-0.492, & - -0.498,-0.504,-0.510,-0.516,-0.522,-0.528,-0.533,-0.539,-0.544, & - -0.550,-0.555,-0.560,-0.565,-0.571,-0.576,-0.580,-0.585,-0.590, & - -0.595,-0.600,-0.604,-0.609,-0.613,-0.618,-0.622,-0.627,-0.631, & - -0.635,-0.640,-0.644,-0.648,-0.652,-0.656,-0.660,-0.664,-0.668, & - -0.672,-0.676,-0.680,-0.684,-0.688,-0.692,-0.696,-0.700,-0.704, & - -0.707,-0.711,-0.715,-0.719,-0.722,-0.726,-0.730,-0.734,-0.737, & - -0.741,-0.745,-0.748,-0.752,-0.755,-0.759,-0.763,-0.766,-0.770, & - -0.773,-0.777,-0.780,-0.784,-0.788,-0.791,-0.795,-0.798,-0.801, & - -0.805,-0.808,-0.812,-0.815,-0.819,-0.822,-0.825,-0.829,-0.832, & - -0.835,-0.839,-0.842,-0.845,-0.849,-0.852,-0.855,-0.858,-0.862, & - -0.865,-0.868,-0.871,-0.874,-0.878,-0.881,-0.884,-0.887,-0.890, & - -0.893,-0.896,-0.899,-0.902,-0.905,-0.908,-0.911,-0.914,-0.917, & - -0.920,-0.923,-0.926,-0.929,-0.932,-0.935,-0.937,-0.940,-0.943, & - -0.946,-0.949,-0.951,-0.954,-0.957,-0.960,-0.963,-0.965,-0.968, & - -0.971,-0.973,-0.976,-0.979,-0.981,-0.984,-0.987,-0.989,-0.992, & - -0.994,-0.997,-0.999,-1.002,-1.005,-1.007,-1.010,-1.012,-1.015, & - -1.017,-1.020,-1.022,-1.024,-1.027,-1.029,-1.032,-1.034,-1.036, & - -1.039,-1.041,-1.044,-1.046,-1.048,-1.051,-1.053,-1.055,-1.057, & - -1.060,-1.062,-1.064,-1.067,-1.069,-1.071,-1.073,-1.075,-1.078, & - -1.080,-1.082,-1.084,-1.086,-1.089,-1.091,-1.093,-1.095,-1.097, & - -1.099,-1.101,-1.103,-1.106,-1.108,-1.110,-1.112,-1.114,-1.116, & - -1.118,-1.120,-1.122,-1.124,-1.126,-1.128,-1.130,-1.132,-1.134, & - -1.136,-1.138,-1.140,-1.142,-1.144,-1.145,-1.147,-1.149,-1.151, & - -1.153,-1.155,-1.157,-1.159,-1.160,-1.162,-1.164,-1.166,-1.168, & - -1.170,-1.171,-1.173,-1.175,-1.177,-1.179,-1.180,-1.182,-1.184, & - -1.186,-1.187,-1.189,-1.191,-1.193,-1.194,-1.196,-1.198,-1.199, & - -1.201,-1.203,-1.205,-1.206,-1.208,-1.210,-1.211,-1.213,-1.214, & - -1.216,-1.218,-1.219,-1.221,-1.223,-1.224,-1.226,-1.227,-1.229, & - -1.231,-1.232,-1.234,-1.235,-1.237,-1.238,-1.240,-1.241,-1.243, & - -1.244,-1.246,-1.248,-1.249,-1.251,-1.252,-1.254,-1.255,-1.256, & - -1.258,-1.259,-1.261,-1.262,-1.264,-1.265,-1.267,-1.268,-1.270, & - -1.271,-1.272,-1.274,-1.275,-1.277,-1.278,-1.279,-1.281,-1.282, & - -1.284,-1.285,-1.286,-1.288,-1.289,-1.290,-1.292,-1.293,-1.294, & - -1.296,-1.297,-1.298,-1.300,-1.301,-1.302,-1.304,-1.305,-1.306, & - -1.308,-1.309,-1.310,-1.311,-1.313,-1.314,-1.315,-1.316,-1.318, & - -1.319,-1.320,-1.321,-1.323,-1.324,-1.325,-1.326,-1.328,-1.329, & - -1.330,-1.331,-1.332,-1.334,-1.335,-1.336,-1.337,-1.338,-1.340, & - -1.341,-1.342,-1.343,-1.344,-1.345,-1.347,-1.348,-1.349,-1.350, & - -1.351,-1.352,-1.353,-1.355,-1.356,-1.357,-1.358,-1.359,-1.360, & - -1.361,-1.362,-1.364,-1.365,-1.366,-1.367,-1.368,-1.369,-1.370, & - -1.371,-1.372,-1.373,-1.374,-1.386,-1.396,-1.405,-1.415,-1.424, & - -1.433,-1.442,-1.450,-1.458,-1.466,-1.474,-1.482,-1.489,-1.496, & - -1.503,-1.510,-1.516,-1.523,-1.529,-1.535,-1.541,-1.547,-1.553, & - -1.558,-1.564,-1.569,-1.574,-1.580,-1.585,-1.589,-1.594,-1.599, & - -1.604,-1.608,-1.613,-1.617,-1.621,-1.626,-1.630,-1.634,-1.638, & - -1.642,-1.646,-1.650,-1.654,-1.657,-1.661,-1.665,-1.668,-1.672, & - -1.675,-1.679,-1.682,-1.685,-1.689,-1.692,-1.695,-1.698,-1.701, & - -1.705,-1.708,-1.711,-1.714,-1.717,-1.720,-1.723,-1.725,-1.728, & - -1.731,-1.734,-1.737,-1.739,-1.742,-1.745,-1.748,-1.750,-1.753, & - -1.755,-1.758,-1.761,-1.763,-1.766,-1.768,-1.771,-1.773,-1.776, & - -1.778,-1.781,-1.783,-1.785,-1.788,-1.790,-1.792,-1.795,-1.797, & - -1.799,-1.802,-1.804,-1.806,-1.809,-1.811,-1.813,-1.815,-1.817, & - -1.820,-1.822,-1.824,-1.826,-1.828,-1.830,-1.833,-1.835,-1.837, & - -1.839,-1.841,-1.843,-1.845,-1.847,-1.849,-1.851,-1.854,-1.856, & - -1.858,-1.860,-1.862,-1.864,-1.866,-1.868,-1.870,-1.872,-1.874, & - -1.876,-1.878,-1.880,-1.881,-1.883,-1.885,-1.887,-1.889,-1.891, & - -1.893,-1.895,-1.897,-1.899,-1.901,-1.903,-1.905,-1.906,-1.908, & - -1.910,-1.912,-1.914,-1.916,-1.918,-1.919,-1.921,-1.923,-1.925, & - -1.927,-1.929,-1.930 & - / - -! *** KCL - - DATA BNC20M/ & - -0.047,-0.100,-0.126,-0.143,-0.156,-0.167,-0.176,-0.183,-0.190, & - -0.195,-0.200,-0.205,-0.209,-0.212,-0.215,-0.218,-0.221,-0.224, & - -0.226,-0.228,-0.230,-0.232,-0.233,-0.235,-0.236,-0.238,-0.239, & - -0.240,-0.241,-0.242,-0.243,-0.244,-0.245,-0.246,-0.246,-0.247, & - -0.248,-0.248,-0.249,-0.249,-0.250,-0.250,-0.251,-0.251,-0.251, & - -0.252,-0.252,-0.252,-0.253,-0.253,-0.253,-0.253,-0.254,-0.254, & - -0.254,-0.254,-0.254,-0.254,-0.254,-0.255,-0.255,-0.255,-0.255, & - -0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.255, & - -0.255,-0.255,-0.255,-0.255,-0.255,-0.255,-0.254,-0.254,-0.254, & - -0.254,-0.254,-0.254,-0.254,-0.253,-0.253,-0.253,-0.253,-0.253, & - -0.252,-0.252,-0.252,-0.252,-0.251,-0.251,-0.251,-0.250,-0.250, & - -0.250,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.247,-0.247, & - -0.247,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244,-0.244,-0.243, & - -0.243,-0.243,-0.242,-0.242,-0.241,-0.241,-0.240,-0.240,-0.240, & - -0.239,-0.239,-0.238,-0.238,-0.237,-0.237,-0.236,-0.236,-0.235, & - -0.235,-0.234,-0.234,-0.234,-0.233,-0.233,-0.232,-0.232,-0.231, & - -0.231,-0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, & - -0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.224,-0.223,-0.223, & - -0.222,-0.222,-0.221,-0.221,-0.220,-0.220,-0.219,-0.219,-0.218, & - -0.218,-0.217,-0.217,-0.216,-0.216,-0.215,-0.215,-0.214,-0.214, & - -0.213,-0.213,-0.212,-0.212,-0.211,-0.211,-0.210,-0.210,-0.209, & - -0.209,-0.208,-0.208,-0.207,-0.207,-0.207,-0.206,-0.206,-0.205, & - -0.205,-0.204,-0.204,-0.203,-0.203,-0.202,-0.202,-0.201,-0.201, & - -0.200,-0.200,-0.199,-0.199,-0.198,-0.198,-0.197,-0.197,-0.196, & - -0.196,-0.195,-0.195,-0.194,-0.194,-0.194,-0.193,-0.193,-0.192, & - -0.192,-0.191,-0.191,-0.190,-0.190,-0.189,-0.189,-0.188,-0.188, & - -0.187,-0.187,-0.186,-0.186,-0.186,-0.185,-0.185,-0.184,-0.184, & - -0.183,-0.183,-0.182,-0.182,-0.181,-0.181,-0.180,-0.180,-0.180, & - -0.179,-0.179,-0.178,-0.178,-0.177,-0.177,-0.176,-0.176,-0.175, & - -0.175,-0.174,-0.174,-0.174,-0.173,-0.173,-0.172,-0.172,-0.171, & - -0.171,-0.170,-0.170,-0.170,-0.169,-0.169,-0.168,-0.168,-0.167, & - -0.167,-0.166,-0.166,-0.166,-0.165,-0.165,-0.164,-0.164,-0.163, & - -0.163,-0.162,-0.162,-0.162,-0.161,-0.161,-0.160,-0.160,-0.159, & - -0.159,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156,-0.156,-0.156, & - -0.155,-0.155,-0.154,-0.154,-0.153,-0.153,-0.153,-0.152,-0.152, & - -0.151,-0.151,-0.150,-0.150,-0.150,-0.149,-0.149,-0.148,-0.148, & - -0.148,-0.147,-0.147,-0.146,-0.146,-0.145,-0.145,-0.145,-0.144, & - -0.144,-0.143,-0.143,-0.143,-0.142,-0.142,-0.141,-0.141,-0.141, & - -0.140,-0.140,-0.139,-0.139,-0.139,-0.138,-0.138,-0.137,-0.137, & - -0.137,-0.136,-0.136,-0.135,-0.135,-0.135,-0.134,-0.134,-0.133, & - -0.133,-0.133,-0.132,-0.132,-0.131,-0.131,-0.131,-0.130,-0.130, & - -0.129,-0.129,-0.129,-0.128,-0.128,-0.128,-0.127,-0.127,-0.126, & - -0.126,-0.126,-0.125,-0.125,-0.124,-0.124,-0.124,-0.123,-0.123, & - -0.123,-0.122,-0.122,-0.121,-0.121,-0.121,-0.120,-0.120,-0.120, & - -0.119,-0.119,-0.118,-0.118,-0.114,-0.111,-0.107,-0.103,-0.100, & - -0.097,-0.093,-0.090,-0.087,-0.084,-0.080,-0.077,-0.074,-0.071, & - -0.068,-0.065,-0.063,-0.060,-0.057,-0.054,-0.052,-0.049,-0.046, & - -0.044,-0.041,-0.039,-0.036,-0.034,-0.031,-0.029,-0.027,-0.024, & - -0.022,-0.020,-0.018,-0.016,-0.013,-0.011,-0.009,-0.007,-0.005, & - -0.003,-0.001, 0.001, 0.003, 0.004, 0.006, 0.008, 0.010, 0.012, & - & 0.013, 0.015, 0.017, 0.018, 0.020, 0.022, 0.023, 0.025, 0.026, & - & 0.028, 0.030, 0.031, 0.032, 0.034, 0.035, 0.037, 0.038, 0.040, & - & 0.041, 0.042, 0.044, 0.045, 0.046, 0.047, 0.049, 0.050, 0.051, & - & 0.052, 0.053, 0.055, 0.056, 0.057, 0.058, 0.059, 0.060, 0.061, & - & 0.062, 0.063, 0.064, 0.065, 0.066, 0.067, 0.068, 0.069, 0.070, & - & 0.071, 0.072, 0.073, 0.074, 0.075, 0.075, 0.076, 0.077, 0.078, & - & 0.079, 0.079, 0.080, 0.081, 0.082, 0.083, 0.083, 0.084, 0.085, & - & 0.085, 0.086, 0.087, 0.087, 0.088, 0.089, 0.089, 0.090, 0.091, & - & 0.091, 0.092, 0.092, 0.093, 0.094, 0.094, 0.095, 0.095, 0.096, & - & 0.096, 0.097, 0.097, 0.098, 0.098, 0.099, 0.099, 0.100, 0.100, & - & 0.100, 0.101, 0.101, 0.102, 0.102, 0.103, 0.103, 0.103, 0.104, & - & 0.104, 0.104, 0.105, 0.105, 0.105, 0.106, 0.106, 0.106, 0.107, & - & 0.107, 0.107, 0.108 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.190,-0.411,-0.520,-0.597,-0.656,-0.705,-0.746,-0.782,-0.814, & - -0.843,-0.868,-0.892,-0.914,-0.934,-0.953,-0.970,-0.986,-1.002, & - -1.016,-1.030,-1.043,-1.056,-1.068,-1.079,-1.090,-1.100,-1.110, & - -1.120,-1.129,-1.138,-1.147,-1.155,-1.163,-1.171,-1.178,-1.186, & - -1.193,-1.200,-1.206,-1.213,-1.219,-1.225,-1.231,-1.237,-1.243, & - -1.249,-1.254,-1.260,-1.265,-1.270,-1.275,-1.280,-1.285,-1.289, & - -1.294,-1.299,-1.303,-1.307,-1.312,-1.316,-1.320,-1.324,-1.328, & - -1.332,-1.336,-1.340,-1.344,-1.347,-1.351,-1.354,-1.358,-1.361, & - -1.365,-1.368,-1.372,-1.375,-1.378,-1.381,-1.384,-1.387,-1.390, & - -1.393,-1.396,-1.399,-1.402,-1.405,-1.408,-1.411,-1.413,-1.416, & - -1.419,-1.421,-1.424,-1.426,-1.429,-1.431,-1.434,-1.436,-1.439, & - -1.441,-1.443,-1.446,-1.448,-1.450,-1.452,-1.455,-1.457,-1.459, & - -1.461,-1.463,-1.465,-1.467,-1.469,-1.471,-1.473,-1.475,-1.477, & - -1.479,-1.481,-1.483,-1.485,-1.487,-1.489,-1.491,-1.493,-1.494, & - -1.496,-1.498,-1.500,-1.501,-1.503,-1.505,-1.507,-1.508,-1.510, & - -1.512,-1.513,-1.515,-1.517,-1.518,-1.520,-1.521,-1.523,-1.525, & - -1.526,-1.528,-1.529,-1.531,-1.532,-1.534,-1.535,-1.537,-1.538, & - -1.540,-1.541,-1.543,-1.544,-1.546,-1.547,-1.548,-1.550,-1.551, & - -1.553,-1.554,-1.555,-1.557,-1.558,-1.559,-1.561,-1.562,-1.563, & - -1.565,-1.566,-1.567,-1.569,-1.570,-1.571,-1.573,-1.574,-1.575, & - -1.576,-1.578,-1.579,-1.580,-1.581,-1.583,-1.584,-1.585,-1.586, & - -1.587,-1.589,-1.590,-1.591,-1.592,-1.593,-1.594,-1.596,-1.597, & - -1.598,-1.599,-1.600,-1.601,-1.603,-1.604,-1.605,-1.606,-1.607, & - -1.608,-1.609,-1.610,-1.611,-1.613,-1.614,-1.615,-1.616,-1.617, & - -1.618,-1.619,-1.620,-1.621,-1.622,-1.623,-1.624,-1.625,-1.626, & - -1.627,-1.628,-1.630,-1.631,-1.632,-1.633,-1.634,-1.635,-1.636, & - -1.637,-1.638,-1.639,-1.640,-1.641,-1.642,-1.643,-1.644,-1.645, & - -1.646,-1.647,-1.647,-1.648,-1.649,-1.650,-1.651,-1.652,-1.653, & - -1.654,-1.655,-1.656,-1.657,-1.658,-1.659,-1.660,-1.661,-1.662, & - -1.663,-1.664,-1.664,-1.665,-1.666,-1.667,-1.668,-1.669,-1.670, & - -1.671,-1.672,-1.673,-1.674,-1.674,-1.675,-1.676,-1.677,-1.678, & - -1.679,-1.680,-1.681,-1.682,-1.682,-1.683,-1.684,-1.685,-1.686, & - -1.687,-1.688,-1.688,-1.689,-1.690,-1.691,-1.692,-1.693,-1.694, & - -1.694,-1.695,-1.696,-1.697,-1.698,-1.699,-1.700,-1.700,-1.701, & - -1.702,-1.703,-1.704,-1.705,-1.705,-1.706,-1.707,-1.708,-1.709, & - -1.709,-1.710,-1.711,-1.712,-1.713,-1.713,-1.714,-1.715,-1.716, & - -1.717,-1.718,-1.718,-1.719,-1.720,-1.721,-1.722,-1.722,-1.723, & - -1.724,-1.725,-1.725,-1.726,-1.727,-1.728,-1.729,-1.729,-1.730, & - -1.731,-1.732,-1.733,-1.733,-1.734,-1.735,-1.736,-1.736,-1.737, & - -1.738,-1.739,-1.739,-1.740,-1.741,-1.742,-1.743,-1.743,-1.744, & - -1.745,-1.746,-1.746,-1.747,-1.748,-1.749,-1.749,-1.750,-1.751, & - -1.752,-1.752,-1.753,-1.754,-1.755,-1.755,-1.756,-1.757,-1.758, & - -1.758,-1.759,-1.760,-1.760,-1.761,-1.762,-1.763,-1.763,-1.764, & - -1.765,-1.766,-1.766,-1.767,-1.768,-1.769,-1.769,-1.770,-1.771, & - -1.771,-1.772,-1.773,-1.774,-1.781,-1.788,-1.795,-1.802,-1.809, & - -1.816,-1.823,-1.830,-1.836,-1.843,-1.849,-1.856,-1.862,-1.869, & - -1.875,-1.882,-1.888,-1.894,-1.901,-1.907,-1.913,-1.919,-1.926, & - -1.932,-1.938,-1.944,-1.950,-1.956,-1.962,-1.968,-1.974,-1.981, & - -1.987,-1.993,-1.999,-2.004,-2.010,-2.016,-2.022,-2.028,-2.034, & - -2.040,-2.046,-2.052,-2.058,-2.064,-2.069,-2.075,-2.081,-2.087, & - -2.093,-2.099,-2.104,-2.110,-2.116,-2.122,-2.128,-2.133,-2.139, & - -2.145,-2.151,-2.157,-2.162,-2.168,-2.174,-2.180,-2.185,-2.191, & - -2.197,-2.202,-2.208,-2.214,-2.220,-2.225,-2.231,-2.237,-2.242, & - -2.248,-2.254,-2.260,-2.265,-2.271,-2.277,-2.282,-2.288,-2.294, & - -2.299,-2.305,-2.311,-2.316,-2.322,-2.328,-2.333,-2.339,-2.345, & - -2.350,-2.356,-2.361,-2.367,-2.373,-2.378,-2.384,-2.390,-2.395, & - -2.401,-2.407,-2.412,-2.418,-2.423,-2.429,-2.435,-2.440,-2.446, & - -2.452,-2.457,-2.463,-2.468,-2.474,-2.480,-2.485,-2.491,-2.496, & - -2.502,-2.508,-2.513,-2.519,-2.524,-2.530,-2.536,-2.541,-2.547, & - -2.552,-2.558,-2.564,-2.569,-2.575,-2.580,-2.586,-2.592,-2.597, & - -2.603,-2.608,-2.614,-2.620,-2.625,-2.631,-2.636,-2.642,-2.647, & - -2.653,-2.659,-2.664,-2.670,-2.675,-2.681,-2.686,-2.692,-2.698, & - -2.703,-2.709,-2.714 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.093,-0.193,-0.238,-0.268,-0.289,-0.305,-0.318,-0.328,-0.336, & - -0.343,-0.348,-0.352,-0.356,-0.359,-0.361,-0.362,-0.364,-0.364, & - -0.364,-0.364,-0.364,-0.364,-0.363,-0.362,-0.360,-0.359,-0.357, & - -0.355,-0.354,-0.352,-0.349,-0.347,-0.345,-0.342,-0.340,-0.337, & - -0.335,-0.332,-0.329,-0.326,-0.324,-0.321,-0.318,-0.315,-0.312, & - -0.309,-0.306,-0.303,-0.300,-0.297,-0.294,-0.290,-0.287,-0.284, & - -0.281,-0.278,-0.275,-0.271,-0.268,-0.265,-0.262,-0.258,-0.255, & - -0.252,-0.249,-0.245,-0.242,-0.239,-0.235,-0.232,-0.229,-0.225, & - -0.222,-0.218,-0.215,-0.211,-0.208,-0.204,-0.201,-0.197,-0.194, & - -0.190,-0.186,-0.183,-0.179,-0.175,-0.172,-0.168,-0.164,-0.160, & - -0.156,-0.152,-0.148,-0.144,-0.140,-0.136,-0.132,-0.128,-0.124, & - -0.120,-0.116,-0.112,-0.107,-0.103,-0.099,-0.095,-0.090,-0.086, & - -0.082,-0.078,-0.073,-0.069,-0.065,-0.060,-0.056,-0.051,-0.047, & - -0.043,-0.038,-0.034,-0.029,-0.025,-0.020,-0.016,-0.011,-0.007, & - -0.003, 0.002, 0.006, 0.011, 0.015, 0.020, 0.024, 0.029, 0.033, & - & 0.038, 0.042, 0.046, 0.051, 0.055, 0.060, 0.064, 0.069, 0.073, & - & 0.078, 0.082, 0.086, 0.091, 0.095, 0.100, 0.104, 0.109, 0.113, & - & 0.117, 0.122, 0.126, 0.130, 0.135, 0.139, 0.144, 0.148, 0.152, & - & 0.157, 0.161, 0.165, 0.170, 0.174, 0.178, 0.183, 0.187, 0.191, & - & 0.196, 0.200, 0.204, 0.209, 0.213, 0.217, 0.221, 0.226, 0.230, & - & 0.234, 0.239, 0.243, 0.247, 0.251, 0.256, 0.260, 0.264, 0.268, & - & 0.272, 0.277, 0.281, 0.285, 0.289, 0.293, 0.298, 0.302, 0.306, & - & 0.310, 0.314, 0.318, 0.323, 0.327, 0.331, 0.335, 0.339, 0.343, & - & 0.347, 0.351, 0.355, 0.360, 0.364, 0.368, 0.372, 0.376, 0.380, & - & 0.384, 0.388, 0.392, 0.396, 0.400, 0.404, 0.408, 0.412, 0.416, & - & 0.420, 0.424, 0.428, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, & - & 0.456, 0.460, 0.464, 0.468, 0.472, 0.475, 0.479, 0.483, 0.487, & - & 0.491, 0.495, 0.499, 0.503, 0.507, 0.510, 0.514, 0.518, 0.522, & - & 0.526, 0.530, 0.533, 0.537, 0.541, 0.545, 0.549, 0.552, 0.556, & - & 0.560, 0.564, 0.568, 0.571, 0.575, 0.579, 0.583, 0.586, 0.590, & - & 0.594, 0.598, 0.601, 0.605, 0.609, 0.612, 0.616, 0.620, 0.623, & - & 0.627, 0.631, 0.634, 0.638, 0.642, 0.645, 0.649, 0.653, 0.656, & - & 0.660, 0.664, 0.667, 0.671, 0.674, 0.678, 0.682, 0.685, 0.689, & - & 0.692, 0.696, 0.699, 0.703, 0.707, 0.710, 0.714, 0.717, 0.721, & - & 0.724, 0.728, 0.731, 0.735, 0.738, 0.742, 0.745, 0.749, 0.752, & - & 0.756, 0.759, 0.763, 0.766, 0.769, 0.773, 0.776, 0.780, 0.783, & - & 0.787, 0.790, 0.793, 0.797, 0.800, 0.804, 0.807, 0.810, 0.814, & - & 0.817, 0.821, 0.824, 0.827, 0.831, 0.834, 0.837, 0.841, 0.844, & - & 0.847, 0.851, 0.854, 0.857, 0.861, 0.864, 0.867, 0.870, 0.874, & - & 0.877, 0.880, 0.884, 0.887, 0.890, 0.893, 0.897, 0.900, 0.903, & - & 0.906, 0.910, 0.913, 0.916, 0.919, 0.922, 0.926, 0.929, 0.932, & - & 0.935, 0.938, 0.942, 0.945, 0.948, 0.951, 0.954, 0.957, 0.961, & - & 0.964, 0.967, 0.970, 0.973, 0.976, 0.979, 0.983, 0.986, 0.989, & - & 0.992, 0.995, 0.998, 1.001, 1.004, 1.007, 1.010, 1.013, 1.016, & - & 1.020, 1.023, 1.026, 1.029, 1.061, 1.091, 1.120, 1.149, 1.178, & - & 1.206, 1.233, 1.261, 1.288, 1.314, 1.340, 1.366, 1.391, 1.417, & - & 1.441, 1.466, 1.490, 1.514, 1.537, 1.560, 1.583, 1.606, 1.628, & - & 1.650, 1.672, 1.694, 1.715, 1.736, 1.757, 1.777, 1.797, 1.817, & - & 1.837, 1.857, 1.876, 1.895, 1.914, 1.933, 1.951, 1.970, 1.988, & - & 2.006, 2.023, 2.041, 2.058, 2.075, 2.092, 2.109, 2.126, 2.142, & - & 2.159, 2.175, 2.191, 2.207, 2.222, 2.238, 2.253, 2.268, 2.283, & - & 2.298, 2.313, 2.328, 2.342, 2.357, 2.371, 2.385, 2.399, 2.413, & - & 2.426, 2.440, 2.453, 2.467, 2.480, 2.493, 2.506, 2.519, 2.532, & - & 2.545, 2.557, 2.570, 2.582, 2.594, 2.606, 2.618, 2.630, 2.642, & - & 2.654, 2.666, 2.677, 2.689, 2.700, 2.711, 2.722, 2.733, 2.744, & - & 2.755, 2.766, 2.777, 2.788, 2.798, 2.809, 2.819, 2.829, 2.840, & - & 2.850, 2.860, 2.870, 2.880, 2.890, 2.900, 2.909, 2.919, 2.929, & - & 2.938, 2.948, 2.957, 2.966, 2.976, 2.985, 2.994, 3.003, 3.012, & - & 3.021, 3.030, 3.039, 3.047, 3.056, 3.065, 3.073, 3.082, 3.090, & - & 3.099, 3.107, 3.115, 3.123, 3.132, 3.140, 3.148, 3.156, 3.164, & - & 3.172, 3.179, 3.187, 3.195, 3.203, 3.210, 3.218, 3.225, 3.233, & - & 3.240, 3.248, 3.255, 3.262, 3.270, 3.277, 3.284, 3.291, 3.298, & - & 3.305, 3.312, 3.319 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.092,-0.190,-0.233,-0.261,-0.280,-0.295,-0.306,-0.314,-0.321, & - -0.326,-0.330,-0.333,-0.335,-0.336,-0.336,-0.336,-0.336,-0.335, & - -0.334,-0.332,-0.330,-0.328,-0.326,-0.323,-0.320,-0.317,-0.314, & - -0.311,-0.308,-0.304,-0.300,-0.297,-0.293,-0.289,-0.285,-0.281, & - -0.277,-0.272,-0.268,-0.264,-0.259,-0.255,-0.251,-0.246,-0.242, & - -0.237,-0.233,-0.228,-0.224,-0.219,-0.215,-0.210,-0.205,-0.201, & - -0.196,-0.192,-0.187,-0.182,-0.178,-0.173,-0.168,-0.164,-0.159, & - -0.154,-0.150,-0.145,-0.140,-0.135,-0.131,-0.126,-0.121,-0.116, & - -0.111,-0.106,-0.102,-0.097,-0.092,-0.087,-0.082,-0.077,-0.072, & - -0.067,-0.062,-0.056,-0.051,-0.046,-0.041,-0.036,-0.030,-0.025, & - -0.019,-0.014,-0.009,-0.003, 0.002, 0.008, 0.013, 0.019, 0.025, & - & 0.030, 0.036, 0.042, 0.047, 0.053, 0.059, 0.065, 0.071, 0.077, & - & 0.082, 0.088, 0.094, 0.100, 0.106, 0.112, 0.118, 0.124, 0.130, & - & 0.136, 0.142, 0.148, 0.154, 0.160, 0.166, 0.172, 0.178, 0.184, & - & 0.190, 0.196, 0.202, 0.208, 0.214, 0.220, 0.226, 0.232, 0.238, & - & 0.244, 0.250, 0.256, 0.262, 0.268, 0.274, 0.280, 0.286, 0.292, & - & 0.298, 0.304, 0.310, 0.316, 0.322, 0.328, 0.334, 0.340, 0.346, & - & 0.352, 0.358, 0.364, 0.370, 0.376, 0.382, 0.387, 0.393, 0.399, & - & 0.405, 0.411, 0.417, 0.423, 0.429, 0.434, 0.440, 0.446, 0.452, & - & 0.458, 0.463, 0.469, 0.475, 0.481, 0.487, 0.492, 0.498, 0.504, & - & 0.509, 0.515, 0.521, 0.527, 0.532, 0.538, 0.544, 0.549, 0.555, & - & 0.561, 0.566, 0.572, 0.578, 0.583, 0.589, 0.594, 0.600, 0.606, & - & 0.611, 0.617, 0.622, 0.628, 0.633, 0.639, 0.645, 0.650, 0.656, & - & 0.661, 0.667, 0.672, 0.678, 0.683, 0.688, 0.694, 0.699, 0.705, & - & 0.710, 0.716, 0.721, 0.726, 0.732, 0.737, 0.743, 0.748, 0.753, & - & 0.759, 0.764, 0.769, 0.775, 0.780, 0.785, 0.791, 0.796, 0.801, & - & 0.807, 0.812, 0.817, 0.822, 0.828, 0.833, 0.838, 0.843, 0.848, & - & 0.854, 0.859, 0.864, 0.869, 0.874, 0.879, 0.885, 0.890, 0.895, & - & 0.900, 0.905, 0.910, 0.915, 0.920, 0.925, 0.931, 0.936, 0.941, & - & 0.946, 0.951, 0.956, 0.961, 0.966, 0.971, 0.976, 0.981, 0.986, & - & 0.991, 0.996, 1.001, 1.006, 1.011, 1.015, 1.020, 1.025, 1.030, & - & 1.035, 1.040, 1.045, 1.050, 1.055, 1.059, 1.064, 1.069, 1.074, & - & 1.079, 1.084, 1.088, 1.093, 1.098, 1.103, 1.108, 1.112, 1.117, & - & 1.122, 1.127, 1.131, 1.136, 1.141, 1.146, 1.150, 1.155, 1.160, & - & 1.164, 1.169, 1.174, 1.178, 1.183, 1.188, 1.192, 1.197, 1.201, & - & 1.206, 1.211, 1.215, 1.220, 1.224, 1.229, 1.234, 1.238, 1.243, & - & 1.247, 1.252, 1.256, 1.261, 1.265, 1.270, 1.274, 1.279, 1.283, & - & 1.288, 1.292, 1.297, 1.301, 1.306, 1.310, 1.315, 1.319, 1.323, & - & 1.328, 1.332, 1.337, 1.341, 1.345, 1.350, 1.354, 1.359, 1.363, & - & 1.367, 1.372, 1.376, 1.380, 1.385, 1.389, 1.393, 1.398, 1.402, & - & 1.406, 1.410, 1.415, 1.419, 1.423, 1.428, 1.432, 1.436, 1.440, & - & 1.444, 1.449, 1.453, 1.457, 1.461, 1.466, 1.470, 1.474, 1.478, & - & 1.482, 1.486, 1.491, 1.495, 1.499, 1.503, 1.507, 1.511, 1.515, & - & 1.519, 1.524, 1.528, 1.532, 1.536, 1.540, 1.544, 1.548, 1.552, & - & 1.556, 1.560, 1.564, 1.568, 1.611, 1.651, 1.690, 1.728, 1.765, & - & 1.802, 1.839, 1.875, 1.911, 1.945, 1.980, 2.014, 2.048, 2.081, & - & 2.113, 2.146, 2.177, 2.209, 2.240, 2.270, 2.300, 2.330, 2.360, & - & 2.389, 2.417, 2.446, 2.474, 2.502, 2.529, 2.556, 2.583, 2.609, & - & 2.635, 2.661, 2.686, 2.712, 2.737, 2.761, 2.786, 2.810, 2.834, & - & 2.857, 2.881, 2.904, 2.927, 2.950, 2.972, 2.994, 3.016, 3.038, & - & 3.060, 3.081, 3.102, 3.123, 3.144, 3.164, 3.184, 3.205, 3.225, & - & 3.244, 3.264, 3.283, 3.302, 3.322, 3.340, 3.359, 3.378, 3.396, & - & 3.414, 3.432, 3.450, 3.468, 3.485, 3.503, 3.520, 3.537, 3.554, & - & 3.571, 3.588, 3.604, 3.621, 3.637, 3.653, 3.669, 3.685, 3.701, & - & 3.717, 3.732, 3.748, 3.763, 3.778, 3.793, 3.808, 3.823, 3.838, & - & 3.852, 3.867, 3.881, 3.896, 3.910, 3.924, 3.938, 3.952, 3.966, & - & 3.979, 3.993, 4.006, 4.020, 4.033, 4.046, 4.059, 4.072, 4.085, & - & 4.098, 4.111, 4.123, 4.136, 4.148, 4.161, 4.173, 4.185, 4.197, & - & 4.210, 4.222, 4.233, 4.245, 4.257, 4.269, 4.280, 4.292, 4.303, & - & 4.315, 4.326, 4.337, 4.348, 4.359, 4.370, 4.381, 4.392, 4.403, & - & 4.414, 4.424, 4.435, 4.446, 4.456, 4.466, 4.477, 4.487, 4.497, & - & 4.507, 4.518, 4.528, 4.538, 4.548, 4.557, 4.567, 4.577, 4.587, & - & 4.596, 4.606, 4.615 & - / - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM298 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 298K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM298 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC298/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM298 - - - BLOCK DATA KMCF298 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC298/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.045,-0.095,-0.117,-0.132,-0.142,-0.150,-0.157,-0.162,-0.166, & - -0.170,-0.173,-0.175,-0.177,-0.179,-0.180,-0.181,-0.182,-0.182, & - -0.183,-0.183,-0.183,-0.183,-0.182,-0.182,-0.182,-0.181,-0.181, & - -0.180,-0.179,-0.178,-0.178,-0.177,-0.176,-0.175,-0.174,-0.173, & - -0.172,-0.170,-0.169,-0.168,-0.167,-0.166,-0.164,-0.163,-0.162, & - -0.161,-0.159,-0.158,-0.157,-0.155,-0.154,-0.153,-0.151,-0.150, & - -0.148,-0.147,-0.146,-0.144,-0.143,-0.141,-0.140,-0.138,-0.137, & - -0.136,-0.134,-0.133,-0.131,-0.130,-0.128,-0.127,-0.125,-0.124, & - -0.122,-0.121,-0.119,-0.117,-0.116,-0.114,-0.113,-0.111,-0.110, & - -0.108,-0.106,-0.105,-0.103,-0.101,-0.100,-0.098,-0.096,-0.094, & - -0.093,-0.091,-0.089,-0.087,-0.086,-0.084,-0.082,-0.080,-0.078, & - -0.076,-0.075,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.061, & - -0.059,-0.057,-0.055,-0.053,-0.051,-0.049,-0.047,-0.046,-0.044, & - -0.042,-0.040,-0.038,-0.036,-0.034,-0.032,-0.030,-0.028,-0.026, & - -0.024,-0.022,-0.019,-0.017,-0.015,-0.013,-0.011,-0.009,-0.007, & - -0.005,-0.003,-0.001, 0.001, 0.003, 0.005, 0.007, 0.009, 0.011, & - & 0.013, 0.015, 0.017, 0.019, 0.021, 0.023, 0.025, 0.027, 0.029, & - & 0.031, 0.033, 0.035, 0.037, 0.039, 0.041, 0.043, 0.045, 0.047, & - & 0.049, 0.050, 0.052, 0.054, 0.056, 0.058, 0.060, 0.062, 0.064, & - & 0.066, 0.068, 0.070, 0.072, 0.074, 0.076, 0.078, 0.080, 0.082, & - & 0.084, 0.086, 0.088, 0.090, 0.091, 0.093, 0.095, 0.097, 0.099, & - & 0.101, 0.103, 0.105, 0.107, 0.109, 0.111, 0.113, 0.114, 0.116, & - & 0.118, 0.120, 0.122, 0.124, 0.126, 0.128, 0.130, 0.131, 0.133, & - & 0.135, 0.137, 0.139, 0.141, 0.143, 0.145, 0.146, 0.148, 0.150, & - & 0.152, 0.154, 0.156, 0.158, 0.159, 0.161, 0.163, 0.165, 0.167, & - & 0.169, 0.170, 0.172, 0.174, 0.176, 0.178, 0.180, 0.181, 0.183, & - & 0.185, 0.187, 0.189, 0.190, 0.192, 0.194, 0.196, 0.198, 0.199, & - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.212, 0.214, 0.215, & - & 0.217, 0.219, 0.221, 0.222, 0.224, 0.226, 0.228, 0.229, 0.231, & - & 0.233, 0.235, 0.236, 0.238, 0.240, 0.242, 0.243, 0.245, 0.247, & - & 0.248, 0.250, 0.252, 0.254, 0.255, 0.257, 0.259, 0.260, 0.262, & - & 0.264, 0.265, 0.267, 0.269, 0.271, 0.272, 0.274, 0.276, 0.277, & - & 0.279, 0.281, 0.282, 0.284, 0.286, 0.287, 0.289, 0.291, 0.292, & - & 0.294, 0.296, 0.297, 0.299, 0.301, 0.302, 0.304, 0.305, 0.307, & - & 0.309, 0.310, 0.312, 0.314, 0.315, 0.317, 0.318, 0.320, 0.322, & - & 0.323, 0.325, 0.327, 0.328, 0.330, 0.331, 0.333, 0.335, 0.336, & - & 0.338, 0.339, 0.341, 0.343, 0.344, 0.346, 0.347, 0.349, 0.350, & - & 0.352, 0.354, 0.355, 0.357, 0.358, 0.360, 0.361, 0.363, 0.364, & - & 0.366, 0.368, 0.369, 0.371, 0.372, 0.374, 0.375, 0.377, 0.378, & - & 0.380, 0.381, 0.383, 0.384, 0.386, 0.388, 0.389, 0.391, 0.392, & - & 0.394, 0.395, 0.397, 0.398, 0.400, 0.401, 0.403, 0.404, 0.406, & - & 0.407, 0.409, 0.410, 0.412, 0.413, 0.415, 0.416, 0.418, 0.419, & - & 0.421, 0.422, 0.423, 0.425, 0.426, 0.428, 0.429, 0.431, 0.432, & - & 0.434, 0.435, 0.437, 0.438, 0.440, 0.441, 0.442, 0.444, 0.445, & - & 0.447, 0.448, 0.450, 0.451, 0.466, 0.480, 0.494, 0.508, 0.522, & - & 0.535, 0.548, 0.561, 0.574, 0.586, 0.599, 0.611, 0.624, 0.636, & - & 0.648, 0.659, 0.671, 0.683, 0.694, 0.705, 0.716, 0.727, 0.738, & - & 0.749, 0.760, 0.770, 0.781, 0.791, 0.801, 0.811, 0.821, 0.831, & - & 0.841, 0.851, 0.861, 0.870, 0.879, 0.889, 0.898, 0.907, 0.916, & - & 0.925, 0.934, 0.943, 0.952, 0.961, 0.969, 0.978, 0.986, 0.995, & - & 1.003, 1.011, 1.019, 1.028, 1.036, 1.044, 1.051, 1.059, 1.067, & - & 1.075, 1.082, 1.090, 1.098, 1.105, 1.113, 1.120, 1.127, 1.135, & - & 1.142, 1.149, 1.156, 1.163, 1.170, 1.177, 1.184, 1.191, 1.198, & - & 1.204, 1.211, 1.218, 1.224, 1.231, 1.237, 1.244, 1.250, 1.257, & - & 1.263, 1.269, 1.276, 1.282, 1.288, 1.294, 1.300, 1.307, 1.313, & - & 1.319, 1.325, 1.330, 1.336, 1.342, 1.348, 1.354, 1.360, 1.365, & - & 1.371, 1.377, 1.382, 1.388, 1.393, 1.399, 1.404, 1.410, 1.415, & - & 1.421, 1.426, 1.431, 1.437, 1.442, 1.447, 1.453, 1.458, 1.463, & - & 1.468, 1.473, 1.478, 1.483, 1.488, 1.493, 1.498, 1.503, 1.508, & - & 1.513, 1.518, 1.523, 1.528, 1.532, 1.537, 1.542, 1.547, 1.551, & - & 1.556, 1.561, 1.565, 1.570, 1.575, 1.579, 1.584, 1.588, 1.593, & - & 1.597, 1.602, 1.606, 1.611, 1.615, 1.620, 1.624, 1.628, 1.633, & - & 1.637, 1.641, 1.645 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.093,-0.202,-0.256,-0.295,-0.325,-0.349,-0.371,-0.389,-0.405, & - -0.420,-0.434,-0.446,-0.457,-0.468,-0.478,-0.487,-0.496,-0.504, & - -0.512,-0.520,-0.527,-0.533,-0.540,-0.546,-0.552,-0.558,-0.563, & - -0.569,-0.574,-0.579,-0.584,-0.588,-0.593,-0.597,-0.602,-0.606, & - -0.610,-0.614,-0.618,-0.621,-0.625,-0.628,-0.632,-0.635,-0.639, & - -0.642,-0.645,-0.648,-0.651,-0.654,-0.657,-0.660,-0.663,-0.665, & - -0.668,-0.671,-0.673,-0.676,-0.678,-0.681,-0.683,-0.686,-0.688, & - -0.690,-0.692,-0.695,-0.697,-0.699,-0.701,-0.703,-0.705,-0.707, & - -0.709,-0.711,-0.713,-0.715,-0.717,-0.719,-0.721,-0.723,-0.724, & - -0.726,-0.728,-0.730,-0.731,-0.733,-0.735,-0.737,-0.738,-0.740, & - -0.741,-0.743,-0.745,-0.746,-0.748,-0.749,-0.751,-0.752,-0.754, & - -0.755,-0.757,-0.758,-0.760,-0.761,-0.763,-0.764,-0.766,-0.767, & - -0.768,-0.770,-0.771,-0.772,-0.774,-0.775,-0.776,-0.778,-0.779, & - -0.780,-0.782,-0.783,-0.784,-0.785,-0.787,-0.788,-0.789,-0.790, & - -0.791,-0.793,-0.794,-0.795,-0.796,-0.797,-0.798,-0.800,-0.801, & - -0.802,-0.803,-0.804,-0.805,-0.806,-0.807,-0.808,-0.810,-0.811, & - -0.812,-0.813,-0.814,-0.815,-0.816,-0.817,-0.818,-0.819,-0.820, & - -0.821,-0.822,-0.823,-0.824,-0.825,-0.826,-0.827,-0.828,-0.829, & - -0.830,-0.831,-0.832,-0.832,-0.833,-0.834,-0.835,-0.836,-0.837, & - -0.838,-0.839,-0.840,-0.841,-0.841,-0.842,-0.843,-0.844,-0.845, & - -0.846,-0.847,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852,-0.852, & - -0.853,-0.854,-0.855,-0.856,-0.856,-0.857,-0.858,-0.859,-0.860, & - -0.860,-0.861,-0.862,-0.863,-0.864,-0.864,-0.865,-0.866,-0.867, & - -0.867,-0.868,-0.869,-0.869,-0.870,-0.871,-0.872,-0.872,-0.873, & - -0.874,-0.875,-0.875,-0.876,-0.877,-0.877,-0.878,-0.879,-0.879, & - -0.880,-0.881,-0.882,-0.882,-0.883,-0.884,-0.884,-0.885,-0.886, & - -0.886,-0.887,-0.888,-0.888,-0.889,-0.889,-0.890,-0.891,-0.891, & - -0.892,-0.893,-0.893,-0.894,-0.895,-0.895,-0.896,-0.896,-0.897, & - -0.898,-0.898,-0.899,-0.899,-0.900,-0.901,-0.901,-0.902,-0.903, & - -0.903,-0.904,-0.904,-0.905,-0.905,-0.906,-0.907,-0.907,-0.908, & - -0.908,-0.909,-0.910,-0.910,-0.911,-0.911,-0.912,-0.912,-0.913, & - -0.913,-0.914,-0.915,-0.915,-0.916,-0.916,-0.917,-0.917,-0.918, & - -0.918,-0.919,-0.919,-0.920,-0.921,-0.921,-0.922,-0.922,-0.923, & - -0.923,-0.924,-0.924,-0.925,-0.925,-0.926,-0.926,-0.927,-0.927, & - -0.928,-0.928,-0.929,-0.929,-0.930,-0.930,-0.931,-0.931,-0.932, & - -0.932,-0.933,-0.933,-0.934,-0.934,-0.935,-0.935,-0.936,-0.936, & - -0.937,-0.937,-0.938,-0.938,-0.939,-0.939,-0.940,-0.940,-0.940, & - -0.941,-0.941,-0.942,-0.942,-0.943,-0.943,-0.944,-0.944,-0.945, & - -0.945,-0.946,-0.946,-0.946,-0.947,-0.947,-0.948,-0.948,-0.949, & - -0.949,-0.950,-0.950,-0.950,-0.951,-0.951,-0.952,-0.952,-0.953, & - -0.953,-0.954,-0.954,-0.954,-0.955,-0.955,-0.956,-0.956,-0.957, & - -0.957,-0.957,-0.958,-0.958,-0.959,-0.959,-0.959,-0.960,-0.960, & - -0.961,-0.961,-0.962,-0.962,-0.962,-0.963,-0.963,-0.964,-0.964, & - -0.964,-0.965,-0.965,-0.966,-0.966,-0.966,-0.967,-0.967,-0.968, & - -0.968,-0.968,-0.969,-0.969,-0.973,-0.977,-0.981,-0.984,-0.988, & - -0.991,-0.995,-0.998,-1.001,-1.004,-1.007,-1.010,-1.013,-1.016, & - -1.019,-1.022,-1.024,-1.027,-1.030,-1.032,-1.035,-1.037,-1.040, & - -1.042,-1.045,-1.047,-1.049,-1.052,-1.054,-1.056,-1.058,-1.061, & - -1.063,-1.065,-1.067,-1.069,-1.071,-1.073,-1.075,-1.077,-1.079, & - -1.080,-1.082,-1.084,-1.086,-1.088,-1.089,-1.091,-1.093,-1.095, & - -1.096,-1.098,-1.100,-1.101,-1.103,-1.104,-1.106,-1.108,-1.109, & - -1.111,-1.112,-1.114,-1.115,-1.117,-1.118,-1.119,-1.121,-1.122, & - -1.124,-1.125,-1.126,-1.128,-1.129,-1.130,-1.132,-1.133,-1.134, & - -1.135,-1.137,-1.138,-1.139,-1.140,-1.142,-1.143,-1.144,-1.145, & - -1.146,-1.148,-1.149,-1.150,-1.151,-1.152,-1.153,-1.154,-1.155, & - -1.157,-1.158,-1.159,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165, & - -1.166,-1.167,-1.168,-1.169,-1.170,-1.171,-1.172,-1.173,-1.174, & - -1.175,-1.176,-1.177,-1.178,-1.179,-1.180,-1.180,-1.181,-1.182, & - -1.183,-1.184,-1.185,-1.186,-1.187,-1.188,-1.188,-1.189,-1.190, & - -1.191,-1.192,-1.193,-1.193,-1.194,-1.195,-1.196,-1.197,-1.198, & - -1.198,-1.199,-1.200,-1.201,-1.201,-1.202,-1.203,-1.204,-1.205, & - -1.205,-1.206,-1.207,-1.208,-1.208,-1.209,-1.210,-1.210,-1.211, & - -1.212,-1.213,-1.213 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.047,-0.102,-0.129,-0.149,-0.164,-0.177,-0.188,-0.198,-0.206, & - -0.214,-0.221,-0.228,-0.234,-0.239,-0.245,-0.250,-0.255,-0.259, & - -0.263,-0.267,-0.271,-0.275,-0.279,-0.282,-0.285,-0.289,-0.292, & - -0.295,-0.298,-0.300,-0.303,-0.306,-0.308,-0.311,-0.313,-0.316, & - -0.318,-0.320,-0.322,-0.324,-0.326,-0.329,-0.331,-0.332,-0.334, & - -0.336,-0.338,-0.340,-0.342,-0.343,-0.345,-0.347,-0.348,-0.350, & - -0.352,-0.353,-0.355,-0.356,-0.358,-0.359,-0.360,-0.362,-0.363, & - -0.365,-0.366,-0.367,-0.369,-0.370,-0.371,-0.372,-0.374,-0.375, & - -0.376,-0.377,-0.378,-0.380,-0.381,-0.382,-0.383,-0.384,-0.385, & - -0.386,-0.388,-0.389,-0.390,-0.391,-0.392,-0.393,-0.394,-0.395, & - -0.396,-0.397,-0.398,-0.399,-0.400,-0.401,-0.402,-0.403,-0.404, & - -0.405,-0.406,-0.407,-0.408,-0.408,-0.409,-0.410,-0.411,-0.412, & - -0.413,-0.414,-0.415,-0.416,-0.416,-0.417,-0.418,-0.419,-0.420, & - -0.421,-0.422,-0.422,-0.423,-0.424,-0.425,-0.426,-0.427,-0.427, & - -0.428,-0.429,-0.430,-0.430,-0.431,-0.432,-0.433,-0.434,-0.434, & - -0.435,-0.436,-0.437,-0.437,-0.438,-0.439,-0.439,-0.440,-0.441, & - -0.442,-0.442,-0.443,-0.444,-0.444,-0.445,-0.446,-0.447,-0.447, & - -0.448,-0.449,-0.449,-0.450,-0.451,-0.451,-0.452,-0.453,-0.453, & - -0.454,-0.454,-0.455,-0.456,-0.456,-0.457,-0.458,-0.458,-0.459, & - -0.460,-0.460,-0.461,-0.461,-0.462,-0.463,-0.463,-0.464,-0.464, & - -0.465,-0.466,-0.466,-0.467,-0.467,-0.468,-0.468,-0.469,-0.470, & - -0.470,-0.471,-0.471,-0.472,-0.472,-0.473,-0.474,-0.474,-0.475, & - -0.475,-0.476,-0.476,-0.477,-0.477,-0.478,-0.478,-0.479,-0.479, & - -0.480,-0.480,-0.481,-0.482,-0.482,-0.483,-0.483,-0.484,-0.484, & - -0.485,-0.485,-0.486,-0.486,-0.487,-0.487,-0.488,-0.488,-0.489, & - -0.489,-0.490,-0.490,-0.491,-0.491,-0.491,-0.492,-0.492,-0.493, & - -0.493,-0.494,-0.494,-0.495,-0.495,-0.496,-0.496,-0.497,-0.497, & - -0.498,-0.498,-0.498,-0.499,-0.499,-0.500,-0.500,-0.501,-0.501, & - -0.502,-0.502,-0.502,-0.503,-0.503,-0.504,-0.504,-0.505,-0.505, & - -0.505,-0.506,-0.506,-0.507,-0.507,-0.508,-0.508,-0.508,-0.509, & - -0.509,-0.510,-0.510,-0.511,-0.511,-0.511,-0.512,-0.512,-0.513, & - -0.513,-0.513,-0.514,-0.514,-0.515,-0.515,-0.515,-0.516,-0.516, & - -0.517,-0.517,-0.517,-0.518,-0.518,-0.518,-0.519,-0.519,-0.520, & - -0.520,-0.520,-0.521,-0.521,-0.522,-0.522,-0.522,-0.523,-0.523, & - -0.523,-0.524,-0.524,-0.525,-0.525,-0.525,-0.526,-0.526,-0.526, & - -0.527,-0.527,-0.527,-0.528,-0.528,-0.529,-0.529,-0.529,-0.530, & - -0.530,-0.530,-0.531,-0.531,-0.531,-0.532,-0.532,-0.532,-0.533, & - -0.533,-0.533,-0.534,-0.534,-0.534,-0.535,-0.535,-0.535,-0.536, & - -0.536,-0.536,-0.537,-0.537,-0.537,-0.538,-0.538,-0.538,-0.539, & - -0.539,-0.539,-0.540,-0.540,-0.540,-0.541,-0.541,-0.541,-0.542, & - -0.542,-0.542,-0.543,-0.543,-0.543,-0.544,-0.544,-0.544,-0.545, & - -0.545,-0.545,-0.546,-0.546,-0.546,-0.546,-0.547,-0.547,-0.547, & - -0.548,-0.548,-0.548,-0.549,-0.549,-0.549,-0.549,-0.550,-0.550, & - -0.550,-0.551,-0.551,-0.551,-0.552,-0.552,-0.552,-0.552,-0.553, & - -0.553,-0.553,-0.554,-0.554,-0.557,-0.560,-0.563,-0.565,-0.568, & - -0.570,-0.573,-0.575,-0.578,-0.580,-0.583,-0.585,-0.587,-0.589, & - -0.592,-0.594,-0.596,-0.598,-0.600,-0.602,-0.604,-0.606,-0.608, & - -0.609,-0.611,-0.613,-0.615,-0.617,-0.618,-0.620,-0.622,-0.623, & - -0.625,-0.627,-0.628,-0.630,-0.631,-0.633,-0.634,-0.636,-0.637, & - -0.639,-0.640,-0.642,-0.643,-0.644,-0.646,-0.647,-0.648,-0.650, & - -0.651,-0.652,-0.653,-0.655,-0.656,-0.657,-0.658,-0.660,-0.661, & - -0.662,-0.663,-0.664,-0.665,-0.667,-0.668,-0.669,-0.670,-0.671, & - -0.672,-0.673,-0.674,-0.675,-0.676,-0.677,-0.678,-0.679,-0.680, & - -0.681,-0.682,-0.683,-0.684,-0.685,-0.686,-0.687,-0.688,-0.689, & - -0.690,-0.691,-0.692,-0.692,-0.693,-0.694,-0.695,-0.696,-0.697, & - -0.698,-0.698,-0.699,-0.700,-0.701,-0.702,-0.703,-0.703,-0.704, & - -0.705,-0.706,-0.706,-0.707,-0.708,-0.709,-0.709,-0.710,-0.711, & - -0.712,-0.712,-0.713,-0.714,-0.715,-0.715,-0.716,-0.717,-0.717, & - -0.718,-0.719,-0.719,-0.720,-0.721,-0.721,-0.722,-0.723,-0.723, & - -0.724,-0.725,-0.725,-0.726,-0.727,-0.727,-0.728,-0.729,-0.729, & - -0.730,-0.730,-0.731,-0.732,-0.732,-0.733,-0.733,-0.734,-0.735, & - -0.735,-0.736,-0.736,-0.737,-0.737,-0.738,-0.739,-0.739,-0.740, & - -0.740,-0.741,-0.741 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.093,-0.203,-0.257,-0.296,-0.326,-0.351,-0.372,-0.391,-0.408, & - -0.423,-0.436,-0.449,-0.460,-0.471,-0.481,-0.491,-0.500,-0.508, & - -0.516,-0.524,-0.531,-0.538,-0.545,-0.552,-0.558,-0.564,-0.569, & - -0.575,-0.580,-0.585,-0.590,-0.595,-0.600,-0.605,-0.609,-0.613, & - -0.618,-0.622,-0.626,-0.629,-0.633,-0.637,-0.641,-0.644,-0.648, & - -0.651,-0.654,-0.658,-0.661,-0.664,-0.667,-0.670,-0.673,-0.676, & - -0.678,-0.681,-0.684,-0.687,-0.689,-0.692,-0.694,-0.697,-0.699, & - -0.702,-0.704,-0.707,-0.709,-0.711,-0.713,-0.716,-0.718,-0.720, & - -0.722,-0.724,-0.726,-0.728,-0.730,-0.732,-0.734,-0.736,-0.738, & - -0.740,-0.742,-0.744,-0.746,-0.748,-0.749,-0.751,-0.753,-0.755, & - -0.756,-0.758,-0.760,-0.762,-0.763,-0.765,-0.767,-0.768,-0.770, & - -0.772,-0.773,-0.775,-0.776,-0.778,-0.779,-0.781,-0.782,-0.784, & - -0.786,-0.787,-0.788,-0.790,-0.791,-0.793,-0.794,-0.796,-0.797, & - -0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.807,-0.808,-0.809, & - -0.811,-0.812,-0.813,-0.815,-0.816,-0.817,-0.819,-0.820,-0.821, & - -0.822,-0.824,-0.825,-0.826,-0.827,-0.828,-0.830,-0.831,-0.832, & - -0.833,-0.834,-0.835,-0.837,-0.838,-0.839,-0.840,-0.841,-0.842, & - -0.843,-0.844,-0.846,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852, & - -0.853,-0.854,-0.855,-0.856,-0.857,-0.858,-0.859,-0.860,-0.861, & - -0.862,-0.863,-0.864,-0.865,-0.866,-0.867,-0.868,-0.869,-0.870, & - -0.871,-0.872,-0.873,-0.874,-0.875,-0.876,-0.877,-0.878,-0.878, & - -0.879,-0.880,-0.881,-0.882,-0.883,-0.884,-0.885,-0.886,-0.886, & - -0.887,-0.888,-0.889,-0.890,-0.891,-0.892,-0.893,-0.893,-0.894, & - -0.895,-0.896,-0.897,-0.898,-0.898,-0.899,-0.900,-0.901,-0.902, & - -0.902,-0.903,-0.904,-0.905,-0.906,-0.906,-0.907,-0.908,-0.909, & - -0.910,-0.910,-0.911,-0.912,-0.913,-0.913,-0.914,-0.915,-0.916, & - -0.916,-0.917,-0.918,-0.919,-0.919,-0.920,-0.921,-0.922,-0.922, & - -0.923,-0.924,-0.924,-0.925,-0.926,-0.927,-0.927,-0.928,-0.929, & - -0.929,-0.930,-0.931,-0.931,-0.932,-0.933,-0.933,-0.934,-0.935, & - -0.936,-0.936,-0.937,-0.938,-0.938,-0.939,-0.940,-0.940,-0.941, & - -0.941,-0.942,-0.943,-0.943,-0.944,-0.945,-0.945,-0.946,-0.947, & - -0.947,-0.948,-0.949,-0.949,-0.950,-0.950,-0.951,-0.952,-0.952, & - -0.953,-0.954,-0.954,-0.955,-0.955,-0.956,-0.957,-0.957,-0.958, & - -0.958,-0.959,-0.960,-0.960,-0.961,-0.961,-0.962,-0.962,-0.963, & - -0.964,-0.964,-0.965,-0.965,-0.966,-0.967,-0.967,-0.968,-0.968, & - -0.969,-0.969,-0.970,-0.970,-0.971,-0.972,-0.972,-0.973,-0.973, & - -0.974,-0.974,-0.975,-0.975,-0.976,-0.977,-0.977,-0.978,-0.978, & - -0.979,-0.979,-0.980,-0.980,-0.981,-0.981,-0.982,-0.982,-0.983, & - -0.983,-0.984,-0.984,-0.985,-0.986,-0.986,-0.987,-0.987,-0.988, & - -0.988,-0.989,-0.989,-0.990,-0.990,-0.991,-0.991,-0.992,-0.992, & - -0.993,-0.993,-0.994,-0.994,-0.995,-0.995,-0.996,-0.996,-0.997, & - -0.997,-0.998,-0.998,-0.998,-0.999,-0.999,-1.000,-1.000,-1.001, & - -1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.004,-1.005,-1.005, & - -1.006,-1.006,-1.006,-1.007,-1.007,-1.008,-1.008,-1.009,-1.009, & - -1.010,-1.010,-1.011,-1.011,-1.016,-1.020,-1.024,-1.029,-1.033, & - -1.037,-1.040,-1.044,-1.048,-1.052,-1.055,-1.059,-1.062,-1.065, & - -1.069,-1.072,-1.075,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093, & - -1.096,-1.099,-1.102,-1.104,-1.107,-1.110,-1.112,-1.115,-1.117, & - -1.120,-1.122,-1.125,-1.127,-1.129,-1.132,-1.134,-1.136,-1.139, & - -1.141,-1.143,-1.145,-1.147,-1.149,-1.151,-1.153,-1.155,-1.157, & - -1.159,-1.161,-1.163,-1.165,-1.167,-1.169,-1.171,-1.173,-1.174, & - -1.176,-1.178,-1.180,-1.181,-1.183,-1.185,-1.187,-1.188,-1.190, & - -1.191,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201,-1.202,-1.204, & - -1.205,-1.207,-1.208,-1.210,-1.211,-1.213,-1.214,-1.216,-1.217, & - -1.218,-1.220,-1.221,-1.223,-1.224,-1.225,-1.226,-1.228,-1.229, & - -1.230,-1.232,-1.233,-1.234,-1.235,-1.237,-1.238,-1.239,-1.240, & - -1.242,-1.243,-1.244,-1.245,-1.246,-1.247,-1.249,-1.250,-1.251, & - -1.252,-1.253,-1.254,-1.255,-1.256,-1.258,-1.259,-1.260,-1.261, & - -1.262,-1.263,-1.264,-1.265,-1.266,-1.267,-1.268,-1.269,-1.270, & - -1.271,-1.272,-1.273,-1.274,-1.275,-1.276,-1.277,-1.278,-1.279, & - -1.280,-1.281,-1.282,-1.283,-1.283,-1.284,-1.285,-1.286,-1.287, & - -1.288,-1.289,-1.290,-1.291,-1.292,-1.292,-1.293,-1.294,-1.295, & - -1.296,-1.297,-1.298 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.047,-0.104,-0.134,-0.155,-0.172,-0.187,-0.199,-0.211,-0.221, & - -0.230,-0.239,-0.247,-0.255,-0.262,-0.268,-0.275,-0.281,-0.287, & - -0.293,-0.298,-0.303,-0.308,-0.313,-0.318,-0.323,-0.327,-0.332, & - -0.336,-0.340,-0.344,-0.348,-0.352,-0.356,-0.359,-0.363,-0.366, & - -0.370,-0.373,-0.377,-0.380,-0.383,-0.386,-0.389,-0.392,-0.395, & - -0.398,-0.401,-0.404,-0.406,-0.409,-0.412,-0.414,-0.417,-0.420, & - -0.422,-0.425,-0.427,-0.429,-0.432,-0.434,-0.436,-0.439,-0.441, & - -0.443,-0.445,-0.447,-0.450,-0.452,-0.454,-0.456,-0.458,-0.460, & - -0.462,-0.464,-0.466,-0.468,-0.470,-0.472,-0.474,-0.476,-0.478, & - -0.480,-0.481,-0.483,-0.485,-0.487,-0.489,-0.491,-0.492,-0.494, & - -0.496,-0.498,-0.500,-0.501,-0.503,-0.505,-0.507,-0.508,-0.510, & - -0.512,-0.514,-0.515,-0.517,-0.519,-0.520,-0.522,-0.524,-0.525, & - -0.527,-0.529,-0.530,-0.532,-0.534,-0.535,-0.537,-0.538,-0.540, & - -0.542,-0.543,-0.545,-0.546,-0.548,-0.550,-0.551,-0.553,-0.554, & - -0.556,-0.557,-0.559,-0.560,-0.562,-0.563,-0.565,-0.566,-0.568, & - -0.569,-0.571,-0.572,-0.573,-0.575,-0.576,-0.578,-0.579,-0.580, & - -0.582,-0.583,-0.585,-0.586,-0.587,-0.589,-0.590,-0.591,-0.593, & - -0.594,-0.595,-0.597,-0.598,-0.599,-0.601,-0.602,-0.603,-0.604, & - -0.606,-0.607,-0.608,-0.610,-0.611,-0.612,-0.613,-0.615,-0.616, & - -0.617,-0.618,-0.619,-0.621,-0.622,-0.623,-0.624,-0.625,-0.627, & - -0.628,-0.629,-0.630,-0.631,-0.632,-0.634,-0.635,-0.636,-0.637, & - -0.638,-0.639,-0.640,-0.642,-0.643,-0.644,-0.645,-0.646,-0.647, & - -0.648,-0.649,-0.650,-0.651,-0.652,-0.654,-0.655,-0.656,-0.657, & - -0.658,-0.659,-0.660,-0.661,-0.662,-0.663,-0.664,-0.665,-0.666, & - -0.667,-0.668,-0.669,-0.670,-0.671,-0.672,-0.673,-0.674,-0.675, & - -0.676,-0.677,-0.678,-0.679,-0.680,-0.681,-0.682,-0.683,-0.684, & - -0.685,-0.686,-0.687,-0.688,-0.688,-0.689,-0.690,-0.691,-0.692, & - -0.693,-0.694,-0.695,-0.696,-0.697,-0.698,-0.699,-0.699,-0.700, & - -0.701,-0.702,-0.703,-0.704,-0.705,-0.706,-0.707,-0.707,-0.708, & - -0.709,-0.710,-0.711,-0.712,-0.713,-0.713,-0.714,-0.715,-0.716, & - -0.717,-0.718,-0.718,-0.719,-0.720,-0.721,-0.722,-0.723,-0.723, & - -0.724,-0.725,-0.726,-0.727,-0.727,-0.728,-0.729,-0.730,-0.731, & - -0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736,-0.737,-0.738, & - -0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743,-0.744,-0.744, & - -0.745,-0.746,-0.747,-0.747,-0.748,-0.749,-0.750,-0.750,-0.751, & - -0.752,-0.753,-0.753,-0.754,-0.755,-0.755,-0.756,-0.757,-0.758, & - -0.758,-0.759,-0.760,-0.760,-0.761,-0.762,-0.762,-0.763,-0.764, & - -0.764,-0.765,-0.766,-0.767,-0.767,-0.768,-0.769,-0.769,-0.770, & - -0.771,-0.771,-0.772,-0.773,-0.773,-0.774,-0.775,-0.775,-0.776, & - -0.777,-0.777,-0.778,-0.778,-0.779,-0.780,-0.780,-0.781,-0.782, & - -0.782,-0.783,-0.784,-0.784,-0.785,-0.785,-0.786,-0.787,-0.787, & - -0.788,-0.789,-0.789,-0.790,-0.790,-0.791,-0.792,-0.792,-0.793, & - -0.793,-0.794,-0.795,-0.795,-0.796,-0.796,-0.797,-0.798,-0.798, & - -0.799,-0.799,-0.800,-0.801,-0.801,-0.802,-0.802,-0.803,-0.804, & - -0.804,-0.805,-0.805,-0.806,-0.812,-0.817,-0.823,-0.828,-0.833, & - -0.838,-0.843,-0.848,-0.852,-0.857,-0.861,-0.866,-0.870,-0.874, & - -0.878,-0.882,-0.886,-0.890,-0.893,-0.897,-0.900,-0.904,-0.907, & - -0.911,-0.914,-0.917,-0.920,-0.924,-0.927,-0.930,-0.933,-0.936, & - -0.938,-0.941,-0.944,-0.947,-0.949,-0.952,-0.954,-0.957,-0.959, & - -0.962,-0.964,-0.967,-0.969,-0.971,-0.973,-0.976,-0.978,-0.980, & - -0.982,-0.984,-0.986,-0.988,-0.990,-0.992,-0.994,-0.996,-0.998, & - -1.000,-1.002,-1.003,-1.005,-1.007,-1.009,-1.010,-1.012,-1.014, & - -1.015,-1.017,-1.019,-1.020,-1.022,-1.023,-1.025,-1.026,-1.028, & - -1.029,-1.031,-1.032,-1.033,-1.035,-1.036,-1.037,-1.039,-1.040, & - -1.041,-1.043,-1.044,-1.045,-1.046,-1.048,-1.049,-1.050,-1.051, & - -1.052,-1.054,-1.055,-1.056,-1.057,-1.058,-1.059,-1.060,-1.061, & - -1.062,-1.063,-1.064,-1.066,-1.067,-1.068,-1.069,-1.070,-1.070, & - -1.071,-1.072,-1.073,-1.074,-1.075,-1.076,-1.077,-1.078,-1.079, & - -1.080,-1.081,-1.081,-1.082,-1.083,-1.084,-1.085,-1.086,-1.086, & - -1.087,-1.088,-1.089,-1.090,-1.090,-1.091,-1.092,-1.093,-1.093, & - -1.094,-1.095,-1.096,-1.096,-1.097,-1.098,-1.099,-1.099,-1.100, & - -1.101,-1.101,-1.102,-1.103,-1.103,-1.104,-1.105,-1.105,-1.106, & - -1.107,-1.107,-1.108 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.046,-0.098,-0.123,-0.140,-0.153,-0.163,-0.172,-0.180,-0.186, & - -0.191,-0.196,-0.201,-0.205,-0.208,-0.212,-0.215,-0.217,-0.220, & - -0.222,-0.224,-0.226,-0.228,-0.230,-0.231,-0.233,-0.234,-0.235, & - -0.237,-0.238,-0.239,-0.240,-0.241,-0.241,-0.242,-0.243,-0.244, & - -0.244,-0.245,-0.246,-0.246,-0.247,-0.247,-0.247,-0.248,-0.248, & - -0.249,-0.249,-0.249,-0.250,-0.250,-0.250,-0.250,-0.251,-0.251, & - -0.251,-0.251,-0.251,-0.251,-0.252,-0.252,-0.252,-0.252,-0.252, & - -0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252, & - -0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.252,-0.251,-0.251, & - -0.251,-0.251,-0.251,-0.251,-0.250,-0.250,-0.250,-0.250,-0.250, & - -0.249,-0.249,-0.249,-0.249,-0.248,-0.248,-0.248,-0.248,-0.247, & - -0.247,-0.247,-0.246,-0.246,-0.246,-0.245,-0.245,-0.245,-0.244, & - -0.244,-0.244,-0.243,-0.243,-0.243,-0.242,-0.242,-0.241,-0.241, & - -0.241,-0.240,-0.240,-0.239,-0.239,-0.239,-0.238,-0.238,-0.237, & - -0.237,-0.236,-0.236,-0.236,-0.235,-0.235,-0.234,-0.234,-0.233, & - -0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.230,-0.230,-0.229, & - -0.229,-0.228,-0.228,-0.228,-0.227,-0.227,-0.226,-0.226,-0.225, & - -0.225,-0.224,-0.224,-0.223,-0.223,-0.222,-0.222,-0.221,-0.221, & - -0.220,-0.220,-0.220,-0.219,-0.219,-0.218,-0.218,-0.217,-0.217, & - -0.216,-0.216,-0.215,-0.215,-0.214,-0.214,-0.213,-0.213,-0.212, & - -0.212,-0.211,-0.211,-0.210,-0.210,-0.210,-0.209,-0.209,-0.208, & - -0.208,-0.207,-0.207,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204, & - -0.203,-0.203,-0.202,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199, & - -0.199,-0.198,-0.198,-0.197,-0.197,-0.197,-0.196,-0.196,-0.195, & - -0.195,-0.194,-0.194,-0.193,-0.193,-0.192,-0.192,-0.191,-0.191, & - -0.190,-0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.187,-0.186, & - -0.186,-0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.183,-0.182, & - -0.182,-0.181,-0.181,-0.180,-0.180,-0.179,-0.179,-0.178,-0.178, & - -0.177,-0.177,-0.177,-0.176,-0.176,-0.175,-0.175,-0.174,-0.174, & - -0.173,-0.173,-0.172,-0.172,-0.171,-0.171,-0.170,-0.170,-0.170, & - -0.169,-0.169,-0.168,-0.168,-0.167,-0.167,-0.166,-0.166,-0.165, & - -0.165,-0.164,-0.164,-0.164,-0.163,-0.163,-0.162,-0.162,-0.161, & - -0.161,-0.160,-0.160,-0.159,-0.159,-0.159,-0.158,-0.158,-0.157, & - -0.157,-0.156,-0.156,-0.155,-0.155,-0.154,-0.154,-0.154,-0.153, & - -0.153,-0.152,-0.152,-0.151,-0.151,-0.150,-0.150,-0.149,-0.149, & - -0.149,-0.148,-0.148,-0.147,-0.147,-0.146,-0.146,-0.145,-0.145, & - -0.145,-0.144,-0.144,-0.143,-0.143,-0.142,-0.142,-0.142,-0.141, & - -0.141,-0.140,-0.140,-0.139,-0.139,-0.138,-0.138,-0.138,-0.137, & - -0.137,-0.136,-0.136,-0.135,-0.135,-0.135,-0.134,-0.134,-0.133, & - -0.133,-0.132,-0.132,-0.132,-0.131,-0.131,-0.130,-0.130,-0.129, & - -0.129,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126,-0.126,-0.126, & - -0.125,-0.125,-0.124,-0.124,-0.123,-0.123,-0.123,-0.122,-0.122, & - -0.121,-0.121,-0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.118, & - -0.118,-0.117,-0.117,-0.116,-0.116,-0.116,-0.115,-0.115,-0.114, & - -0.114,-0.114,-0.113,-0.113,-0.108,-0.104,-0.100,-0.096,-0.092, & - -0.089,-0.085,-0.081,-0.077,-0.074,-0.070,-0.066,-0.063,-0.059, & - -0.055,-0.052,-0.049,-0.045,-0.042,-0.038,-0.035,-0.032,-0.028, & - -0.025,-0.022,-0.019,-0.016,-0.012,-0.009,-0.006,-0.003, 0.000, & - & 0.003, 0.006, 0.009, 0.012, 0.014, 0.017, 0.020, 0.023, 0.026, & - & 0.029, 0.031, 0.034, 0.037, 0.040, 0.042, 0.045, 0.047, 0.050, & - & 0.053, 0.055, 0.058, 0.060, 0.063, 0.065, 0.068, 0.070, 0.073, & - & 0.075, 0.078, 0.080, 0.082, 0.085, 0.087, 0.089, 0.092, 0.094, & - & 0.096, 0.099, 0.101, 0.103, 0.105, 0.107, 0.110, 0.112, 0.114, & - & 0.116, 0.118, 0.120, 0.123, 0.125, 0.127, 0.129, 0.131, 0.133, & - & 0.135, 0.137, 0.139, 0.141, 0.143, 0.145, 0.147, 0.149, 0.151, & - & 0.153, 0.155, 0.157, 0.159, 0.160, 0.162, 0.164, 0.166, 0.168, & - & 0.170, 0.172, 0.173, 0.175, 0.177, 0.179, 0.181, 0.182, 0.184, & - & 0.186, 0.188, 0.189, 0.191, 0.193, 0.195, 0.196, 0.198, 0.200, & - & 0.201, 0.203, 0.205, 0.206, 0.208, 0.210, 0.211, 0.213, 0.215, & - & 0.216, 0.218, 0.219, 0.221, 0.223, 0.224, 0.226, 0.227, 0.229, & - & 0.230, 0.232, 0.233, 0.235, 0.236, 0.238, 0.239, 0.241, 0.242, & - & 0.244, 0.245, 0.247, 0.248, 0.250, 0.251, 0.253, 0.254, 0.256, & - & 0.257, 0.258, 0.260 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.093,-0.202,-0.255,-0.293,-0.323,-0.347,-0.368,-0.386,-0.402, & - -0.417,-0.430,-0.442,-0.453,-0.463,-0.473,-0.482,-0.490,-0.498, & - -0.506,-0.513,-0.520,-0.526,-0.532,-0.538,-0.544,-0.549,-0.555, & - -0.560,-0.565,-0.569,-0.574,-0.578,-0.583,-0.587,-0.591,-0.595, & - -0.598,-0.602,-0.606,-0.609,-0.613,-0.616,-0.619,-0.622,-0.625, & - -0.628,-0.631,-0.634,-0.637,-0.640,-0.642,-0.645,-0.648,-0.650, & - -0.653,-0.655,-0.657,-0.660,-0.662,-0.664,-0.666,-0.669,-0.671, & - -0.673,-0.675,-0.677,-0.679,-0.681,-0.683,-0.685,-0.687,-0.688, & - -0.690,-0.692,-0.694,-0.695,-0.697,-0.699,-0.701,-0.702,-0.704, & - -0.705,-0.707,-0.709,-0.710,-0.712,-0.713,-0.715,-0.716,-0.718, & - -0.719,-0.721,-0.722,-0.723,-0.725,-0.726,-0.727,-0.729,-0.730, & - -0.731,-0.733,-0.734,-0.735,-0.737,-0.738,-0.739,-0.740,-0.741, & - -0.743,-0.744,-0.745,-0.746,-0.747,-0.748,-0.750,-0.751,-0.752, & - -0.753,-0.754,-0.755,-0.756,-0.757,-0.758,-0.759,-0.760,-0.762, & - -0.763,-0.764,-0.765,-0.766,-0.767,-0.768,-0.769,-0.769,-0.770, & - -0.771,-0.772,-0.773,-0.774,-0.775,-0.776,-0.777,-0.778,-0.779, & - -0.780,-0.781,-0.781,-0.782,-0.783,-0.784,-0.785,-0.786,-0.787, & - -0.787,-0.788,-0.789,-0.790,-0.791,-0.792,-0.792,-0.793,-0.794, & - -0.795,-0.795,-0.796,-0.797,-0.798,-0.799,-0.799,-0.800,-0.801, & - -0.802,-0.802,-0.803,-0.804,-0.804,-0.805,-0.806,-0.807,-0.807, & - -0.808,-0.809,-0.809,-0.810,-0.811,-0.811,-0.812,-0.813,-0.814, & - -0.814,-0.815,-0.816,-0.816,-0.817,-0.817,-0.818,-0.819,-0.819, & - -0.820,-0.821,-0.821,-0.822,-0.823,-0.823,-0.824,-0.824,-0.825, & - -0.826,-0.826,-0.827,-0.827,-0.828,-0.829,-0.829,-0.830,-0.830, & - -0.831,-0.831,-0.832,-0.833,-0.833,-0.834,-0.834,-0.835,-0.835, & - -0.836,-0.837,-0.837,-0.838,-0.838,-0.839,-0.839,-0.840,-0.840, & - -0.841,-0.841,-0.842,-0.842,-0.843,-0.843,-0.844,-0.845,-0.845, & - -0.846,-0.846,-0.847,-0.847,-0.848,-0.848,-0.849,-0.849,-0.850, & - -0.850,-0.851,-0.851,-0.851,-0.852,-0.852,-0.853,-0.853,-0.854, & - -0.854,-0.855,-0.855,-0.856,-0.856,-0.857,-0.857,-0.858,-0.858, & - -0.859,-0.859,-0.859,-0.860,-0.860,-0.861,-0.861,-0.862,-0.862, & - -0.863,-0.863,-0.863,-0.864,-0.864,-0.865,-0.865,-0.866,-0.866, & - -0.866,-0.867,-0.867,-0.868,-0.868,-0.869,-0.869,-0.869,-0.870, & - -0.870,-0.871,-0.871,-0.871,-0.872,-0.872,-0.873,-0.873,-0.873, & - -0.874,-0.874,-0.875,-0.875,-0.875,-0.876,-0.876,-0.877,-0.877, & - -0.877,-0.878,-0.878,-0.878,-0.879,-0.879,-0.880,-0.880,-0.880, & - -0.881,-0.881,-0.881,-0.882,-0.882,-0.883,-0.883,-0.883,-0.884, & - -0.884,-0.884,-0.885,-0.885,-0.885,-0.886,-0.886,-0.887,-0.887, & - -0.887,-0.888,-0.888,-0.888,-0.889,-0.889,-0.889,-0.890,-0.890, & - -0.890,-0.891,-0.891,-0.891,-0.892,-0.892,-0.892,-0.893,-0.893, & - -0.893,-0.894,-0.894,-0.894,-0.895,-0.895,-0.895,-0.896,-0.896, & - -0.896,-0.897,-0.897,-0.897,-0.898,-0.898,-0.898,-0.899,-0.899, & - -0.899,-0.900,-0.900,-0.900,-0.901,-0.901,-0.901,-0.901,-0.902, & - -0.902,-0.902,-0.903,-0.903,-0.903,-0.904,-0.904,-0.904,-0.905, & - -0.905,-0.905,-0.905,-0.906,-0.909,-0.912,-0.915,-0.917,-0.920, & - -0.922,-0.925,-0.927,-0.930,-0.932,-0.935,-0.937,-0.939,-0.941, & - -0.943,-0.945,-0.947,-0.949,-0.951,-0.953,-0.955,-0.957,-0.959, & - -0.961,-0.962,-0.964,-0.966,-0.967,-0.969,-0.971,-0.972,-0.974, & - -0.975,-0.977,-0.978,-0.980,-0.981,-0.983,-0.984,-0.986,-0.987, & - -0.988,-0.990,-0.991,-0.992,-0.994,-0.995,-0.996,-0.997,-0.999, & - -1.000,-1.001,-1.002,-1.003,-1.004,-1.006,-1.007,-1.008,-1.009, & - -1.010,-1.011,-1.012,-1.013,-1.014,-1.015,-1.016,-1.017,-1.018, & - -1.019,-1.020,-1.021,-1.022,-1.023,-1.024,-1.025,-1.026,-1.027, & - -1.028,-1.028,-1.029,-1.030,-1.031,-1.032,-1.033,-1.034,-1.034, & - -1.035,-1.036,-1.037,-1.038,-1.039,-1.039,-1.040,-1.041,-1.042, & - -1.042,-1.043,-1.044,-1.045,-1.045,-1.046,-1.047,-1.048,-1.048, & - -1.049,-1.050,-1.050,-1.051,-1.052,-1.052,-1.053,-1.054,-1.055, & - -1.055,-1.056,-1.056,-1.057,-1.058,-1.058,-1.059,-1.060,-1.060, & - -1.061,-1.062,-1.062,-1.063,-1.063,-1.064,-1.065,-1.065,-1.066, & - -1.066,-1.067,-1.068,-1.068,-1.069,-1.069,-1.070,-1.070,-1.071, & - -1.071,-1.072,-1.073,-1.073,-1.074,-1.074,-1.075,-1.075,-1.076, & - -1.076,-1.077,-1.077,-1.078,-1.078,-1.079,-1.079,-1.080,-1.080, & - -1.081,-1.081,-1.082 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.044,-0.088,-0.106,-0.116,-0.123,-0.128,-0.131,-0.133,-0.134, & - -0.134,-0.134,-0.133,-0.131,-0.129,-0.127,-0.125,-0.122,-0.119, & - -0.115,-0.112,-0.108,-0.104,-0.100,-0.095,-0.091,-0.086,-0.081, & - -0.076,-0.071,-0.066,-0.060,-0.055,-0.049,-0.043,-0.037,-0.031, & - -0.025,-0.019,-0.013,-0.006, 0.000, 0.007, 0.013, 0.020, 0.027, & - & 0.034, 0.041, 0.048, 0.055, 0.062, 0.069, 0.076, 0.083, 0.090, & - & 0.098, 0.105, 0.113, 0.120, 0.127, 0.135, 0.143, 0.150, 0.158, & - & 0.166, 0.173, 0.181, 0.189, 0.197, 0.205, 0.212, 0.220, 0.228, & - & 0.236, 0.245, 0.253, 0.261, 0.269, 0.277, 0.286, 0.294, 0.302, & - & 0.311, 0.319, 0.328, 0.336, 0.345, 0.353, 0.362, 0.371, 0.380, & - & 0.388, 0.397, 0.406, 0.415, 0.424, 0.433, 0.442, 0.451, 0.460, & - & 0.469, 0.479, 0.488, 0.497, 0.506, 0.516, 0.525, 0.535, 0.544, & - & 0.553, 0.563, 0.572, 0.582, 0.591, 0.601, 0.610, 0.620, 0.629, & - & 0.639, 0.648, 0.658, 0.667, 0.677, 0.686, 0.696, 0.705, 0.715, & - & 0.725, 0.734, 0.744, 0.753, 0.763, 0.772, 0.782, 0.791, 0.800, & - & 0.810, 0.819, 0.829, 0.838, 0.848, 0.857, 0.866, 0.876, 0.885, & - & 0.894, 0.904, 0.913, 0.922, 0.932, 0.941, 0.950, 0.959, 0.968, & - & 0.978, 0.987, 0.996, 1.005, 1.014, 1.023, 1.032, 1.041, 1.050, & - & 1.059, 1.069, 1.077, 1.086, 1.095, 1.104, 1.113, 1.122, 1.131, & - & 1.140, 1.149, 1.158, 1.166, 1.175, 1.184, 1.193, 1.202, 1.210, & - & 1.219, 1.228, 1.236, 1.245, 1.254, 1.262, 1.271, 1.279, 1.288, & - & 1.296, 1.305, 1.314, 1.322, 1.330, 1.339, 1.347, 1.356, 1.364, & - & 1.373, 1.381, 1.389, 1.398, 1.406, 1.414, 1.422, 1.431, 1.439, & - & 1.447, 1.455, 1.464, 1.472, 1.480, 1.488, 1.496, 1.504, 1.512, & - & 1.520, 1.528, 1.537, 1.545, 1.553, 1.561, 1.568, 1.576, 1.584, & - & 1.592, 1.600, 1.608, 1.616, 1.624, 1.632, 1.639, 1.647, 1.655, & - & 1.663, 1.670, 1.678, 1.686, 1.694, 1.701, 1.709, 1.717, 1.724, & - & 1.732, 1.740, 1.747, 1.755, 1.762, 1.770, 1.777, 1.785, 1.792, & - & 1.800, 1.807, 1.815, 1.822, 1.830, 1.837, 1.844, 1.852, 1.859, & - & 1.866, 1.874, 1.881, 1.888, 1.896, 1.903, 1.910, 1.917, 1.925, & - & 1.932, 1.939, 1.946, 1.953, 1.961, 1.968, 1.975, 1.982, 1.989, & - & 1.996, 2.003, 2.010, 2.017, 2.024, 2.031, 2.038, 2.045, 2.052, & - & 2.059, 2.066, 2.073, 2.080, 2.087, 2.094, 2.101, 2.108, 2.114, & - & 2.121, 2.128, 2.135, 2.142, 2.148, 2.155, 2.162, 2.169, 2.175, & - & 2.182, 2.189, 2.196, 2.202, 2.209, 2.216, 2.222, 2.229, 2.236, & - & 2.242, 2.249, 2.255, 2.262, 2.268, 2.275, 2.281, 2.288, 2.295, & - & 2.301, 2.308, 2.314, 2.320, 2.327, 2.333, 2.340, 2.346, 2.353, & - & 2.359, 2.365, 2.372, 2.378, 2.384, 2.391, 2.397, 2.403, 2.410, & - & 2.416, 2.422, 2.429, 2.435, 2.441, 2.447, 2.453, 2.460, 2.466, & - & 2.472, 2.478, 2.484, 2.491, 2.497, 2.503, 2.509, 2.515, 2.521, & - & 2.527, 2.533, 2.539, 2.546, 2.552, 2.558, 2.564, 2.570, 2.576, & - & 2.582, 2.588, 2.594, 2.600, 2.606, 2.612, 2.617, 2.623, 2.629, & - & 2.635, 2.641, 2.647, 2.653, 2.659, 2.665, 2.670, 2.676, 2.682, & - & 2.688, 2.694, 2.700, 2.705, 2.711, 2.717, 2.723, 2.728, 2.734, & - & 2.740, 2.746, 2.751, 2.757, 2.818, 2.874, 2.928, 2.982, 3.035, & - & 3.087, 3.139, 3.190, 3.239, 3.289, 3.337, 3.385, 3.432, 3.479, & - & 3.525, 3.571, 3.615, 3.660, 3.703, 3.746, 3.789, 3.831, 3.873, & - & 3.914, 3.954, 3.995, 4.034, 4.073, 4.112, 4.151, 4.189, 4.226, & - & 4.263, 4.300, 4.336, 4.372, 4.408, 4.443, 4.478, 4.513, 4.547, & - & 4.581, 4.614, 4.647, 4.680, 4.713, 4.745, 4.777, 4.809, 4.840, & - & 4.871, 4.902, 4.933, 4.963, 4.993, 5.023, 5.052, 5.082, 5.111, & - & 5.140, 5.168, 5.196, 5.224, 5.252, 5.280, 5.307, 5.335, 5.362, & - & 5.388, 5.415, 5.441, 5.468, 5.494, 5.519, 5.545, 5.570, 5.596, & - & 5.621, 5.646, 5.670, 5.695, 5.719, 5.743, 5.767, 5.791, 5.815, & - & 5.838, 5.862, 5.885, 5.908, 5.931, 5.954, 5.976, 5.999, 6.021, & - & 6.043, 6.065, 6.087, 6.109, 6.130, 6.152, 6.173, 6.194, 6.215, & - & 6.236, 6.257, 6.278, 6.298, 6.319, 6.339, 6.359, 6.380, 6.400, & - & 6.419, 6.439, 6.459, 6.478, 6.498, 6.517, 6.536, 6.555, 6.574, & - & 6.593, 6.612, 6.631, 6.649, 6.668, 6.686, 6.705, 6.723, 6.741, & - & 6.759, 6.777, 6.795, 6.812, 6.830, 6.848, 6.865, 6.882, 6.900, & - & 6.917, 6.934, 6.951, 6.968, 6.985, 7.002, 7.018, 7.035, 7.052, & - & 7.068, 7.084, 7.101, 7.117, 7.133, 7.149, 7.165, 7.181, 7.197, & - & 7.213, 7.229, 7.244 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.046,-0.097,-0.122,-0.138,-0.151,-0.162,-0.170,-0.177,-0.184, & - -0.189,-0.194,-0.198,-0.202,-0.206,-0.209,-0.212,-0.214,-0.216, & - -0.218,-0.220,-0.222,-0.223,-0.224,-0.225,-0.226,-0.227,-0.227, & - -0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.228,-0.227, & - -0.227,-0.226,-0.225,-0.225,-0.224,-0.223,-0.222,-0.221,-0.220, & - -0.219,-0.218,-0.216,-0.215,-0.214,-0.212,-0.211,-0.209,-0.208, & - -0.206,-0.204,-0.203,-0.201,-0.199,-0.197,-0.195,-0.193,-0.192, & - -0.190,-0.188,-0.185,-0.183,-0.181,-0.179,-0.177,-0.175,-0.173, & - -0.170,-0.168,-0.166,-0.163,-0.161,-0.159,-0.156,-0.154,-0.151, & - -0.149,-0.146,-0.144,-0.141,-0.139,-0.136,-0.133,-0.131,-0.128, & - -0.125,-0.122,-0.120,-0.117,-0.114,-0.111,-0.108,-0.106,-0.103, & - -0.100,-0.097,-0.094,-0.091,-0.088,-0.085,-0.082,-0.079,-0.076, & - -0.073,-0.070,-0.067,-0.064,-0.061,-0.058,-0.055,-0.052,-0.049, & - -0.045,-0.042,-0.039,-0.036,-0.033,-0.030,-0.027,-0.024,-0.021, & - -0.018,-0.014,-0.011,-0.008,-0.005,-0.002, 0.001, 0.004, 0.007, & - & 0.010, 0.013, 0.016, 0.020, 0.023, 0.026, 0.029, 0.032, 0.035, & - & 0.038, 0.041, 0.044, 0.047, 0.050, 0.053, 0.056, 0.059, 0.062, & - & 0.065, 0.068, 0.071, 0.074, 0.077, 0.080, 0.083, 0.086, 0.089, & - & 0.092, 0.095, 0.098, 0.101, 0.104, 0.106, 0.109, 0.112, 0.115, & - & 0.118, 0.121, 0.124, 0.127, 0.130, 0.132, 0.135, 0.138, 0.141, & - & 0.144, 0.147, 0.150, 0.152, 0.155, 0.158, 0.161, 0.164, 0.166, & - & 0.169, 0.172, 0.175, 0.177, 0.180, 0.183, 0.186, 0.188, 0.191, & - & 0.194, 0.197, 0.199, 0.202, 0.205, 0.208, 0.210, 0.213, 0.216, & - & 0.218, 0.221, 0.224, 0.226, 0.229, 0.232, 0.234, 0.237, 0.239, & - & 0.242, 0.245, 0.247, 0.250, 0.253, 0.255, 0.258, 0.260, 0.263, & - & 0.265, 0.268, 0.271, 0.273, 0.276, 0.278, 0.281, 0.283, 0.286, & - & 0.288, 0.291, 0.293, 0.296, 0.298, 0.301, 0.303, 0.306, 0.308, & - & 0.311, 0.313, 0.316, 0.318, 0.321, 0.323, 0.326, 0.328, 0.330, & - & 0.333, 0.335, 0.338, 0.340, 0.343, 0.345, 0.347, 0.350, 0.352, & - & 0.355, 0.357, 0.359, 0.362, 0.364, 0.366, 0.369, 0.371, 0.374, & - & 0.376, 0.378, 0.381, 0.383, 0.385, 0.388, 0.390, 0.392, 0.394, & - & 0.397, 0.399, 0.401, 0.404, 0.406, 0.408, 0.410, 0.413, 0.415, & - & 0.417, 0.420, 0.422, 0.424, 0.426, 0.429, 0.431, 0.433, 0.435, & - & 0.437, 0.440, 0.442, 0.444, 0.446, 0.449, 0.451, 0.453, 0.455, & - & 0.457, 0.460, 0.462, 0.464, 0.466, 0.468, 0.470, 0.473, 0.475, & - & 0.477, 0.479, 0.481, 0.483, 0.485, 0.488, 0.490, 0.492, 0.494, & - & 0.496, 0.498, 0.500, 0.502, 0.504, 0.507, 0.509, 0.511, 0.513, & - & 0.515, 0.517, 0.519, 0.521, 0.523, 0.525, 0.527, 0.529, 0.531, & - & 0.534, 0.536, 0.538, 0.540, 0.542, 0.544, 0.546, 0.548, 0.550, & - & 0.552, 0.554, 0.556, 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, & - & 0.570, 0.572, 0.574, 0.576, 0.578, 0.580, 0.582, 0.584, 0.586, & - & 0.588, 0.590, 0.592, 0.593, 0.595, 0.597, 0.599, 0.601, 0.603, & - & 0.605, 0.607, 0.609, 0.611, 0.613, 0.615, 0.617, 0.619, 0.620, & - & 0.622, 0.624, 0.626, 0.628, 0.630, 0.632, 0.634, 0.636, 0.637, & - & 0.639, 0.641, 0.643, 0.645, 0.665, 0.683, 0.701, 0.719, 0.736, & - & 0.753, 0.770, 0.787, 0.803, 0.820, 0.836, 0.852, 0.867, 0.883, & - & 0.898, 0.913, 0.928, 0.942, 0.957, 0.971, 0.985, 0.999, 1.013, & - & 1.027, 1.040, 1.053, 1.067, 1.080, 1.093, 1.105, 1.118, 1.131, & - & 1.143, 1.155, 1.167, 1.179, 1.191, 1.203, 1.215, 1.226, 1.238, & - & 1.249, 1.260, 1.271, 1.283, 1.293, 1.304, 1.315, 1.326, 1.336, & - & 1.347, 1.357, 1.367, 1.377, 1.388, 1.398, 1.408, 1.417, 1.427, & - & 1.437, 1.446, 1.456, 1.466, 1.475, 1.484, 1.493, 1.503, 1.512, & - & 1.521, 1.530, 1.539, 1.548, 1.556, 1.565, 1.574, 1.582, 1.591, & - & 1.599, 1.608, 1.616, 1.624, 1.633, 1.641, 1.649, 1.657, 1.665, & - & 1.673, 1.681, 1.689, 1.697, 1.704, 1.712, 1.720, 1.727, 1.735, & - & 1.742, 1.750, 1.757, 1.765, 1.772, 1.779, 1.787, 1.794, 1.801, & - & 1.808, 1.815, 1.822, 1.829, 1.836, 1.843, 1.850, 1.857, 1.864, & - & 1.870, 1.877, 1.884, 1.890, 1.897, 1.904, 1.910, 1.917, 1.923, & - & 1.930, 1.936, 1.942, 1.949, 1.955, 1.961, 1.968, 1.974, 1.980, & - & 1.986, 1.992, 1.998, 2.004, 2.010, 2.016, 2.022, 2.028, 2.034, & - & 2.040, 2.046, 2.052, 2.058, 2.063, 2.069, 2.075, 2.080, 2.086, & - & 2.092, 2.097, 2.103, 2.108, 2.114, 2.119, 2.125, 2.130, 2.136, & - & 2.141, 2.147, 2.152 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.045,-0.094,-0.116,-0.130,-0.140,-0.147,-0.153,-0.158,-0.162, & - -0.165,-0.167,-0.169,-0.171,-0.172,-0.173,-0.173,-0.174,-0.174, & - -0.174,-0.173,-0.173,-0.172,-0.172,-0.171,-0.170,-0.169,-0.168, & - -0.167,-0.166,-0.165,-0.163,-0.162,-0.161,-0.159,-0.158,-0.156, & - -0.155,-0.153,-0.152,-0.150,-0.148,-0.147,-0.145,-0.143,-0.142, & - -0.140,-0.138,-0.136,-0.135,-0.133,-0.131,-0.129,-0.127,-0.126, & - -0.124,-0.122,-0.120,-0.118,-0.117,-0.115,-0.113,-0.111,-0.109, & - -0.107,-0.106,-0.104,-0.102,-0.100,-0.098,-0.096,-0.094,-0.092, & - -0.090,-0.088,-0.086,-0.084,-0.083,-0.081,-0.079,-0.077,-0.074, & - -0.072,-0.070,-0.068,-0.066,-0.064,-0.062,-0.060,-0.058,-0.056, & - -0.053,-0.051,-0.049,-0.047,-0.045,-0.042,-0.040,-0.038,-0.036, & - -0.033,-0.031,-0.029,-0.026,-0.024,-0.022,-0.019,-0.017,-0.015, & - -0.012,-0.010,-0.008,-0.005,-0.003, 0.000, 0.002, 0.004, 0.007, & - & 0.009, 0.012, 0.014, 0.017, 0.019, 0.022, 0.024, 0.026, 0.029, & - & 0.031, 0.034, 0.036, 0.039, 0.041, 0.044, 0.046, 0.049, 0.051, & - & 0.053, 0.056, 0.058, 0.061, 0.063, 0.066, 0.068, 0.071, 0.073, & - & 0.075, 0.078, 0.080, 0.083, 0.085, 0.088, 0.090, 0.092, 0.095, & - & 0.097, 0.100, 0.102, 0.105, 0.107, 0.109, 0.112, 0.114, 0.117, & - & 0.119, 0.121, 0.124, 0.126, 0.129, 0.131, 0.133, 0.136, 0.138, & - & 0.140, 0.143, 0.145, 0.148, 0.150, 0.152, 0.155, 0.157, 0.159, & - & 0.162, 0.164, 0.166, 0.169, 0.171, 0.173, 0.176, 0.178, 0.180, & - & 0.183, 0.185, 0.187, 0.190, 0.192, 0.194, 0.197, 0.199, 0.201, & - & 0.204, 0.206, 0.208, 0.210, 0.213, 0.215, 0.217, 0.220, 0.222, & - & 0.224, 0.226, 0.229, 0.231, 0.233, 0.235, 0.238, 0.240, 0.242, & - & 0.244, 0.247, 0.249, 0.251, 0.253, 0.256, 0.258, 0.260, 0.262, & - & 0.264, 0.267, 0.269, 0.271, 0.273, 0.275, 0.278, 0.280, 0.282, & - & 0.284, 0.286, 0.288, 0.291, 0.293, 0.295, 0.297, 0.299, 0.301, & - & 0.304, 0.306, 0.308, 0.310, 0.312, 0.314, 0.317, 0.319, 0.321, & - & 0.323, 0.325, 0.327, 0.329, 0.331, 0.333, 0.336, 0.338, 0.340, & - & 0.342, 0.344, 0.346, 0.348, 0.350, 0.352, 0.354, 0.356, 0.359, & - & 0.361, 0.363, 0.365, 0.367, 0.369, 0.371, 0.373, 0.375, 0.377, & - & 0.379, 0.381, 0.383, 0.385, 0.387, 0.389, 0.391, 0.393, 0.395, & - & 0.397, 0.399, 0.401, 0.403, 0.405, 0.407, 0.409, 0.411, 0.413, & - & 0.415, 0.417, 0.419, 0.421, 0.423, 0.425, 0.427, 0.429, 0.431, & - & 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.445, 0.447, 0.449, & - & 0.451, 0.453, 0.455, 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, & - & 0.468, 0.470, 0.472, 0.474, 0.476, 0.477, 0.479, 0.481, 0.483, & - & 0.485, 0.487, 0.489, 0.491, 0.493, 0.494, 0.496, 0.498, 0.500, & - & 0.502, 0.504, 0.506, 0.507, 0.509, 0.511, 0.513, 0.515, 0.517, & - & 0.518, 0.520, 0.522, 0.524, 0.526, 0.528, 0.529, 0.531, 0.533, & - & 0.535, 0.537, 0.539, 0.540, 0.542, 0.544, 0.546, 0.547, 0.549, & - & 0.551, 0.553, 0.555, 0.556, 0.558, 0.560, 0.562, 0.564, 0.565, & - & 0.567, 0.569, 0.571, 0.572, 0.574, 0.576, 0.578, 0.579, 0.581, & - & 0.583, 0.585, 0.586, 0.588, 0.590, 0.592, 0.593, 0.595, 0.597, & - & 0.598, 0.600, 0.602, 0.604, 0.622, 0.639, 0.655, 0.672, 0.688, & - & 0.704, 0.719, 0.735, 0.750, 0.765, 0.780, 0.795, 0.809, 0.824, & - & 0.838, 0.852, 0.866, 0.879, 0.893, 0.906, 0.919, 0.932, 0.945, & - & 0.958, 0.971, 0.983, 0.996, 1.008, 1.020, 1.032, 1.044, 1.055, & - & 1.067, 1.079, 1.090, 1.101, 1.112, 1.123, 1.134, 1.145, 1.156, & - & 1.167, 1.177, 1.188, 1.198, 1.208, 1.218, 1.228, 1.238, 1.248, & - & 1.258, 1.268, 1.278, 1.287, 1.297, 1.306, 1.315, 1.325, 1.334, & - & 1.343, 1.352, 1.361, 1.370, 1.379, 1.387, 1.396, 1.405, 1.413, & - & 1.422, 1.430, 1.438, 1.447, 1.455, 1.463, 1.471, 1.479, 1.487, & - & 1.495, 1.503, 1.511, 1.519, 1.527, 1.534, 1.542, 1.550, 1.557, & - & 1.565, 1.572, 1.579, 1.587, 1.594, 1.601, 1.608, 1.616, 1.623, & - & 1.630, 1.637, 1.644, 1.651, 1.657, 1.664, 1.671, 1.678, 1.685, & - & 1.691, 1.698, 1.704, 1.711, 1.718, 1.724, 1.730, 1.737, 1.743, & - & 1.750, 1.756, 1.762, 1.768, 1.775, 1.781, 1.787, 1.793, 1.799, & - & 1.805, 1.811, 1.817, 1.823, 1.829, 1.835, 1.841, 1.846, 1.852, & - & 1.858, 1.864, 1.869, 1.875, 1.881, 1.886, 1.892, 1.897, 1.903, & - & 1.908, 1.914, 1.919, 1.925, 1.930, 1.936, 1.941, 1.946, 1.952, & - & 1.957, 1.962, 1.967, 1.972, 1.978, 1.983, 1.988, 1.993, 1.998, & - & 2.003, 2.008, 2.013 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.044,-0.089,-0.107,-0.118,-0.125,-0.130,-0.133,-0.135,-0.136, & - -0.136,-0.136,-0.135,-0.134,-0.132,-0.130,-0.128,-0.125,-0.122, & - -0.119,-0.116,-0.113,-0.109,-0.105,-0.102,-0.098,-0.094,-0.089, & - -0.085,-0.081,-0.076,-0.072,-0.067,-0.062,-0.057,-0.053,-0.048, & - -0.043,-0.038,-0.033,-0.028,-0.022,-0.017,-0.012,-0.007,-0.001, & - & 0.004, 0.009, 0.015, 0.020, 0.025, 0.031, 0.036, 0.042, 0.047, & - & 0.053, 0.058, 0.064, 0.069, 0.075, 0.081, 0.086, 0.092, 0.097, & - & 0.103, 0.109, 0.114, 0.120, 0.126, 0.132, 0.137, 0.143, 0.149, & - & 0.155, 0.161, 0.167, 0.172, 0.178, 0.184, 0.190, 0.196, 0.202, & - & 0.208, 0.214, 0.220, 0.227, 0.233, 0.239, 0.245, 0.251, 0.258, & - & 0.264, 0.270, 0.277, 0.283, 0.290, 0.296, 0.303, 0.309, 0.316, & - & 0.322, 0.329, 0.335, 0.342, 0.349, 0.355, 0.362, 0.369, 0.376, & - & 0.382, 0.389, 0.396, 0.403, 0.409, 0.416, 0.423, 0.430, 0.437, & - & 0.444, 0.450, 0.457, 0.464, 0.471, 0.478, 0.485, 0.491, 0.498, & - & 0.505, 0.512, 0.519, 0.526, 0.533, 0.539, 0.546, 0.553, 0.560, & - & 0.567, 0.573, 0.580, 0.587, 0.594, 0.601, 0.607, 0.614, 0.621, & - & 0.628, 0.634, 0.641, 0.648, 0.654, 0.661, 0.668, 0.675, 0.681, & - & 0.688, 0.694, 0.701, 0.708, 0.714, 0.721, 0.728, 0.734, 0.741, & - & 0.747, 0.754, 0.760, 0.767, 0.773, 0.780, 0.786, 0.793, 0.799, & - & 0.806, 0.812, 0.819, 0.825, 0.831, 0.838, 0.844, 0.850, 0.857, & - & 0.863, 0.870, 0.876, 0.882, 0.888, 0.895, 0.901, 0.907, 0.914, & - & 0.920, 0.926, 0.932, 0.938, 0.945, 0.951, 0.957, 0.963, 0.969, & - & 0.975, 0.981, 0.988, 0.994, 1.000, 1.006, 1.012, 1.018, 1.024, & - & 1.030, 1.036, 1.042, 1.048, 1.054, 1.060, 1.066, 1.072, 1.078, & - & 1.084, 1.090, 1.096, 1.101, 1.107, 1.113, 1.119, 1.125, 1.131, & - & 1.137, 1.142, 1.148, 1.154, 1.160, 1.165, 1.171, 1.177, 1.183, & - & 1.188, 1.194, 1.200, 1.205, 1.211, 1.217, 1.222, 1.228, 1.234, & - & 1.239, 1.245, 1.251, 1.256, 1.262, 1.267, 1.273, 1.278, 1.284, & - & 1.289, 1.295, 1.300, 1.306, 1.311, 1.317, 1.322, 1.328, 1.333, & - & 1.339, 1.344, 1.349, 1.355, 1.360, 1.366, 1.371, 1.376, 1.382, & - & 1.387, 1.392, 1.398, 1.403, 1.408, 1.413, 1.419, 1.424, 1.429, & - & 1.434, 1.440, 1.445, 1.450, 1.455, 1.460, 1.466, 1.471, 1.476, & - & 1.481, 1.486, 1.491, 1.497, 1.502, 1.507, 1.512, 1.517, 1.522, & - & 1.527, 1.532, 1.537, 1.542, 1.547, 1.552, 1.557, 1.562, 1.567, & - & 1.572, 1.577, 1.582, 1.587, 1.592, 1.597, 1.602, 1.607, 1.612, & - & 1.617, 1.622, 1.626, 1.631, 1.636, 1.641, 1.646, 1.651, 1.656, & - & 1.660, 1.665, 1.670, 1.675, 1.680, 1.684, 1.689, 1.694, 1.699, & - & 1.703, 1.708, 1.713, 1.718, 1.722, 1.727, 1.732, 1.736, 1.741, & - & 1.746, 1.750, 1.755, 1.760, 1.764, 1.769, 1.774, 1.778, 1.783, & - & 1.787, 1.792, 1.797, 1.801, 1.806, 1.810, 1.815, 1.819, 1.824, & - & 1.828, 1.833, 1.838, 1.842, 1.847, 1.851, 1.855, 1.860, 1.864, & - & 1.869, 1.873, 1.878, 1.882, 1.887, 1.891, 1.895, 1.900, 1.904, & - & 1.909, 1.913, 1.917, 1.922, 1.926, 1.931, 1.935, 1.939, 1.944, & - & 1.948, 1.952, 1.957, 1.961, 1.965, 1.969, 1.974, 1.978, 1.982, & - & 1.987, 1.991, 1.995, 1.999, 2.045, 2.086, 2.127, 2.167, 2.206, & - & 2.245, 2.284, 2.322, 2.359, 2.396, 2.432, 2.468, 2.503, 2.538, & - & 2.572, 2.606, 2.639, 2.672, 2.705, 2.737, 2.769, 2.800, 2.831, & - & 2.862, 2.892, 2.922, 2.952, 2.981, 3.010, 3.039, 3.067, 3.095, & - & 3.123, 3.150, 3.178, 3.204, 3.231, 3.257, 3.283, 3.309, 3.335, & - & 3.360, 3.385, 3.410, 3.435, 3.459, 3.483, 3.507, 3.531, 3.554, & - & 3.577, 3.600, 3.623, 3.646, 3.668, 3.691, 3.713, 3.735, 3.756, & - & 3.778, 3.799, 3.820, 3.841, 3.862, 3.883, 3.903, 3.924, 3.944, & - & 3.964, 3.984, 4.003, 4.023, 4.043, 4.062, 4.081, 4.100, 4.119, & - & 4.138, 4.156, 4.175, 4.193, 4.211, 4.229, 4.247, 4.265, 4.283, & - & 4.300, 4.318, 4.335, 4.352, 4.369, 4.386, 4.403, 4.420, 4.437, & - & 4.453, 4.470, 4.486, 4.503, 4.519, 4.535, 4.551, 4.567, 4.582, & - & 4.598, 4.614, 4.629, 4.644, 4.660, 4.675, 4.690, 4.705, 4.720, & - & 4.735, 4.750, 4.764, 4.779, 4.794, 4.808, 4.822, 4.837, 4.851, & - & 4.865, 4.879, 4.893, 4.907, 4.921, 4.935, 4.948, 4.962, 4.975, & - & 4.989, 5.002, 5.016, 5.029, 5.042, 5.055, 5.068, 5.081, 5.094, & - & 5.107, 5.120, 5.133, 5.145, 5.158, 5.171, 5.183, 5.196, 5.208, & - & 5.220, 5.233, 5.245, 5.257, 5.269, 5.281, 5.293, 5.305, 5.317, & - & 5.329, 5.340, 5.352 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.045,-0.094,-0.116,-0.130,-0.140,-0.148,-0.155,-0.160,-0.164, & - -0.168,-0.170,-0.173,-0.174,-0.176,-0.177,-0.178,-0.178,-0.179, & - -0.179,-0.178,-0.178,-0.177,-0.177,-0.176,-0.175,-0.174,-0.172, & - -0.171,-0.170,-0.168,-0.166,-0.164,-0.162,-0.160,-0.158,-0.156, & - -0.154,-0.152,-0.149,-0.147,-0.144,-0.142,-0.139,-0.136,-0.134, & - -0.131,-0.128,-0.125,-0.122,-0.119,-0.116,-0.113,-0.110,-0.107, & - -0.103,-0.100,-0.097,-0.094,-0.090,-0.087,-0.084,-0.080,-0.077, & - -0.073,-0.070,-0.066,-0.063,-0.059,-0.055,-0.052,-0.048,-0.044, & - -0.040,-0.037,-0.033,-0.029,-0.025,-0.021,-0.017,-0.013,-0.010, & - -0.006,-0.002, 0.003, 0.007, 0.011, 0.015, 0.019, 0.023, 0.027, & - & 0.032, 0.036, 0.040, 0.045, 0.049, 0.053, 0.058, 0.062, 0.066, & - & 0.071, 0.075, 0.080, 0.084, 0.089, 0.094, 0.098, 0.103, 0.107, & - & 0.112, 0.116, 0.121, 0.126, 0.130, 0.135, 0.140, 0.144, 0.149, & - & 0.154, 0.158, 0.163, 0.168, 0.172, 0.177, 0.182, 0.186, 0.191, & - & 0.196, 0.200, 0.205, 0.210, 0.215, 0.219, 0.224, 0.229, 0.233, & - & 0.238, 0.242, 0.247, 0.252, 0.256, 0.261, 0.266, 0.270, 0.275, & - & 0.279, 0.284, 0.289, 0.293, 0.298, 0.302, 0.307, 0.311, 0.316, & - & 0.320, 0.325, 0.329, 0.334, 0.338, 0.343, 0.347, 0.352, 0.356, & - & 0.361, 0.365, 0.370, 0.374, 0.379, 0.383, 0.387, 0.392, 0.396, & - & 0.400, 0.405, 0.409, 0.414, 0.418, 0.422, 0.427, 0.431, 0.435, & - & 0.440, 0.444, 0.448, 0.452, 0.457, 0.461, 0.465, 0.469, 0.474, & - & 0.478, 0.482, 0.486, 0.490, 0.495, 0.499, 0.503, 0.507, 0.511, & - & 0.515, 0.520, 0.524, 0.528, 0.532, 0.536, 0.540, 0.544, 0.548, & - & 0.552, 0.556, 0.561, 0.565, 0.569, 0.573, 0.577, 0.581, 0.585, & - & 0.589, 0.593, 0.597, 0.601, 0.605, 0.609, 0.613, 0.616, 0.620, & - & 0.624, 0.628, 0.632, 0.636, 0.640, 0.644, 0.648, 0.652, 0.655, & - & 0.659, 0.663, 0.667, 0.671, 0.675, 0.679, 0.682, 0.686, 0.690, & - & 0.694, 0.697, 0.701, 0.705, 0.709, 0.713, 0.716, 0.720, 0.724, & - & 0.728, 0.731, 0.735, 0.739, 0.742, 0.746, 0.750, 0.753, 0.757, & - & 0.761, 0.764, 0.768, 0.772, 0.775, 0.779, 0.783, 0.786, 0.790, & - & 0.793, 0.797, 0.801, 0.804, 0.808, 0.811, 0.815, 0.818, 0.822, & - & 0.825, 0.829, 0.833, 0.836, 0.840, 0.843, 0.847, 0.850, 0.854, & - & 0.857, 0.861, 0.864, 0.867, 0.871, 0.874, 0.878, 0.881, 0.885, & - & 0.888, 0.892, 0.895, 0.898, 0.902, 0.905, 0.909, 0.912, 0.915, & - & 0.919, 0.922, 0.925, 0.929, 0.932, 0.935, 0.939, 0.942, 0.945, & - & 0.949, 0.952, 0.955, 0.959, 0.962, 0.965, 0.969, 0.972, 0.975, & - & 0.978, 0.982, 0.985, 0.988, 0.991, 0.995, 0.998, 1.001, 1.004, & - & 1.008, 1.011, 1.014, 1.017, 1.020, 1.024, 1.027, 1.030, 1.033, & - & 1.036, 1.039, 1.043, 1.046, 1.049, 1.052, 1.055, 1.058, 1.061, & - & 1.065, 1.068, 1.071, 1.074, 1.077, 1.080, 1.083, 1.086, 1.089, & - & 1.092, 1.096, 1.099, 1.102, 1.105, 1.108, 1.111, 1.114, 1.117, & - & 1.120, 1.123, 1.126, 1.129, 1.132, 1.135, 1.138, 1.141, 1.144, & - & 1.147, 1.150, 1.153, 1.156, 1.159, 1.162, 1.165, 1.168, 1.171, & - & 1.174, 1.177, 1.180, 1.183, 1.185, 1.188, 1.191, 1.194, 1.197, & - & 1.200, 1.203, 1.206, 1.209, 1.240, 1.268, 1.296, 1.323, 1.350, & - & 1.377, 1.403, 1.429, 1.454, 1.480, 1.505, 1.529, 1.553, 1.577, & - & 1.601, 1.624, 1.647, 1.670, 1.692, 1.715, 1.737, 1.758, 1.780, & - & 1.801, 1.822, 1.843, 1.863, 1.883, 1.903, 1.923, 1.943, 1.962, & - & 1.981, 2.000, 2.019, 2.038, 2.056, 2.075, 2.093, 2.111, 2.128, & - & 2.146, 2.163, 2.181, 2.198, 2.215, 2.231, 2.248, 2.264, 2.281, & - & 2.297, 2.313, 2.329, 2.345, 2.360, 2.376, 2.391, 2.406, 2.422, & - & 2.437, 2.451, 2.466, 2.481, 2.495, 2.510, 2.524, 2.538, 2.552, & - & 2.566, 2.580, 2.594, 2.608, 2.621, 2.635, 2.648, 2.661, 2.674, & - & 2.687, 2.700, 2.713, 2.726, 2.739, 2.751, 2.764, 2.776, 2.789, & - & 2.801, 2.813, 2.825, 2.838, 2.850, 2.861, 2.873, 2.885, 2.897, & - & 2.908, 2.920, 2.931, 2.943, 2.954, 2.965, 2.976, 2.987, 2.998, & - & 3.009, 3.020, 3.031, 3.042, 3.053, 3.063, 3.074, 3.084, 3.095, & - & 3.105, 3.116, 3.126, 3.136, 3.146, 3.156, 3.166, 3.176, 3.186, & - & 3.196, 3.206, 3.216, 3.226, 3.235, 3.245, 3.255, 3.264, 3.274, & - & 3.283, 3.292, 3.302, 3.311, 3.320, 3.330, 3.339, 3.348, 3.357, & - & 3.366, 3.375, 3.384, 3.393, 3.402, 3.410, 3.419, 3.428, 3.437, & - & 3.445, 3.454, 3.462, 3.471, 3.479, 3.488, 3.496, 3.505, 3.513, & - & 3.521, 3.529, 3.538 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.074,-0.160,-0.203,-0.233,-0.256,-0.275,-0.291,-0.306,-0.318, & - -0.329,-0.339,-0.349,-0.357,-0.365,-0.372,-0.379,-0.386,-0.392, & - -0.397,-0.402,-0.407,-0.412,-0.417,-0.421,-0.425,-0.429,-0.433, & - -0.436,-0.439,-0.443,-0.446,-0.448,-0.451,-0.454,-0.456,-0.459, & - -0.461,-0.463,-0.466,-0.468,-0.470,-0.471,-0.473,-0.475,-0.477, & - -0.478,-0.480,-0.481,-0.482,-0.484,-0.485,-0.486,-0.487,-0.488, & - -0.489,-0.490,-0.491,-0.492,-0.493,-0.494,-0.495,-0.496,-0.496, & - -0.497,-0.498,-0.498,-0.499,-0.499,-0.500,-0.500,-0.501,-0.501, & - -0.501,-0.502,-0.502,-0.502,-0.503,-0.503,-0.503,-0.503,-0.503, & - -0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504,-0.504, & - -0.504,-0.504,-0.504,-0.504,-0.504,-0.503,-0.503,-0.503,-0.503, & - -0.503,-0.503,-0.502,-0.502,-0.502,-0.502,-0.501,-0.501,-0.501, & - -0.501,-0.500,-0.500,-0.500,-0.499,-0.499,-0.498,-0.498,-0.498, & - -0.497,-0.497,-0.497,-0.496,-0.496,-0.495,-0.495,-0.494,-0.494, & - -0.494,-0.493,-0.493,-0.492,-0.492,-0.491,-0.491,-0.490,-0.490, & - -0.489,-0.489,-0.488,-0.488,-0.487,-0.487,-0.486,-0.486,-0.485, & - -0.485,-0.484,-0.484,-0.483,-0.483,-0.482,-0.482,-0.481,-0.481, & - -0.480,-0.479,-0.479,-0.478,-0.478,-0.477,-0.477,-0.476,-0.476, & - -0.475,-0.475,-0.474,-0.473,-0.473,-0.472,-0.472,-0.471,-0.471, & - -0.470,-0.470,-0.469,-0.468,-0.468,-0.467,-0.467,-0.466,-0.466, & - -0.465,-0.464,-0.464,-0.463,-0.463,-0.462,-0.462,-0.461,-0.461, & - -0.460,-0.459,-0.459,-0.458,-0.458,-0.457,-0.457,-0.456,-0.455, & - -0.455,-0.454,-0.454,-0.453,-0.453,-0.452,-0.451,-0.451,-0.450, & - -0.450,-0.449,-0.449,-0.448,-0.447,-0.447,-0.446,-0.446,-0.445, & - -0.445,-0.444,-0.443,-0.443,-0.442,-0.442,-0.441,-0.441,-0.440, & - -0.440,-0.439,-0.438,-0.438,-0.437,-0.437,-0.436,-0.436,-0.435, & - -0.434,-0.434,-0.433,-0.433,-0.432,-0.432,-0.431,-0.431,-0.430, & - -0.429,-0.429,-0.428,-0.428,-0.427,-0.427,-0.426,-0.426,-0.425, & - -0.424,-0.424,-0.423,-0.423,-0.422,-0.422,-0.421,-0.421,-0.420, & - -0.419,-0.419,-0.418,-0.418,-0.417,-0.417,-0.416,-0.416,-0.415, & - -0.415,-0.414,-0.413,-0.413,-0.412,-0.412,-0.411,-0.411,-0.410, & - -0.410,-0.409,-0.409,-0.408,-0.408,-0.407,-0.406,-0.406,-0.405, & - -0.405,-0.404,-0.404,-0.403,-0.403,-0.402,-0.402,-0.401,-0.401, & - -0.400,-0.399,-0.399,-0.398,-0.398,-0.397,-0.397,-0.396,-0.396, & - -0.395,-0.395,-0.394,-0.394,-0.393,-0.393,-0.392,-0.392,-0.391, & - -0.391,-0.390,-0.390,-0.389,-0.388,-0.388,-0.387,-0.387,-0.386, & - -0.386,-0.385,-0.385,-0.384,-0.384,-0.383,-0.383,-0.382,-0.382, & - -0.381,-0.381,-0.380,-0.380,-0.379,-0.379,-0.378,-0.378,-0.377, & - -0.377,-0.376,-0.376,-0.375,-0.375,-0.374,-0.374,-0.373,-0.373, & - -0.372,-0.372,-0.371,-0.371,-0.370,-0.370,-0.369,-0.369,-0.368, & - -0.368,-0.367,-0.367,-0.366,-0.366,-0.365,-0.365,-0.364,-0.364, & - -0.363,-0.363,-0.362,-0.362,-0.361,-0.361,-0.360,-0.360,-0.359, & - -0.359,-0.358,-0.358,-0.357,-0.357,-0.356,-0.356,-0.355,-0.355, & - -0.354,-0.354,-0.353,-0.353,-0.352,-0.352,-0.352,-0.351,-0.351, & - -0.350,-0.350,-0.349,-0.349,-0.344,-0.339,-0.334,-0.330,-0.325, & - -0.321,-0.316,-0.312,-0.307,-0.303,-0.299,-0.295,-0.290,-0.286, & - -0.282,-0.278,-0.274,-0.270,-0.266,-0.262,-0.258,-0.255,-0.251, & - -0.247,-0.243,-0.240,-0.236,-0.232,-0.229,-0.225,-0.222,-0.218, & - -0.215,-0.211,-0.208,-0.204,-0.201,-0.198,-0.194,-0.191,-0.188, & - -0.185,-0.182,-0.178,-0.175,-0.172,-0.169,-0.166,-0.163,-0.160, & - -0.157,-0.154,-0.151,-0.148,-0.145,-0.142,-0.139,-0.137,-0.134, & - -0.131,-0.128,-0.125,-0.123,-0.120,-0.117,-0.115,-0.112,-0.109, & - -0.107,-0.104,-0.101,-0.099,-0.096,-0.094,-0.091,-0.089,-0.086, & - -0.084,-0.081,-0.079,-0.076,-0.074,-0.071,-0.069,-0.067,-0.064, & - -0.062,-0.060,-0.057,-0.055,-0.053,-0.050,-0.048,-0.046,-0.043, & - -0.041,-0.039,-0.037,-0.035,-0.032,-0.030,-0.028,-0.026,-0.024, & - -0.022,-0.020,-0.017,-0.015,-0.013,-0.011,-0.009,-0.007,-0.005, & - -0.003,-0.001, 0.001, 0.003, 0.005, 0.007, 0.009, 0.011, 0.013, & - & 0.015, 0.017, 0.019, 0.021, 0.022, 0.024, 0.026, 0.028, 0.030, & - & 0.032, 0.034, 0.036, 0.037, 0.039, 0.041, 0.043, 0.045, 0.046, & - & 0.048, 0.050, 0.052, 0.053, 0.055, 0.057, 0.059, 0.060, 0.062, & - & 0.064, 0.066, 0.067, 0.069, 0.071, 0.072, 0.074, 0.076, 0.077, & - & 0.079, 0.081, 0.082 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.092,-0.196,-0.245,-0.279,-0.304,-0.325,-0.342,-0.356,-0.368, & - -0.379,-0.389,-0.397,-0.405,-0.412,-0.418,-0.424,-0.429,-0.433, & - -0.438,-0.442,-0.445,-0.448,-0.452,-0.454,-0.457,-0.459,-0.462, & - -0.464,-0.466,-0.467,-0.469,-0.470,-0.472,-0.473,-0.474,-0.475, & - -0.476,-0.477,-0.478,-0.479,-0.480,-0.480,-0.481,-0.482,-0.482, & - -0.483,-0.483,-0.483,-0.484,-0.484,-0.484,-0.484,-0.485,-0.485, & - -0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485,-0.485, & - -0.485,-0.485,-0.484,-0.484,-0.484,-0.484,-0.484,-0.483,-0.483, & - -0.483,-0.482,-0.482,-0.482,-0.481,-0.481,-0.480,-0.480,-0.479, & - -0.479,-0.478,-0.478,-0.477,-0.477,-0.476,-0.475,-0.475,-0.474, & - -0.474,-0.473,-0.472,-0.471,-0.471,-0.470,-0.469,-0.468,-0.467, & - -0.467,-0.466,-0.465,-0.464,-0.463,-0.462,-0.461,-0.460,-0.459, & - -0.459,-0.458,-0.457,-0.456,-0.455,-0.454,-0.453,-0.452,-0.451, & - -0.450,-0.448,-0.447,-0.446,-0.445,-0.444,-0.443,-0.442,-0.441, & - -0.440,-0.439,-0.438,-0.437,-0.436,-0.434,-0.433,-0.432,-0.431, & - -0.430,-0.429,-0.428,-0.427,-0.425,-0.424,-0.423,-0.422,-0.421, & - -0.420,-0.419,-0.417,-0.416,-0.415,-0.414,-0.413,-0.412,-0.411, & - -0.409,-0.408,-0.407,-0.406,-0.405,-0.404,-0.402,-0.401,-0.400, & - -0.399,-0.398,-0.397,-0.395,-0.394,-0.393,-0.392,-0.391,-0.390, & - -0.388,-0.387,-0.386,-0.385,-0.384,-0.383,-0.381,-0.380,-0.379, & - -0.378,-0.377,-0.376,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369, & - -0.367,-0.366,-0.365,-0.364,-0.363,-0.361,-0.360,-0.359,-0.358, & - -0.357,-0.356,-0.354,-0.353,-0.352,-0.351,-0.350,-0.349,-0.347, & - -0.346,-0.345,-0.344,-0.343,-0.342,-0.341,-0.339,-0.338,-0.337, & - -0.336,-0.335,-0.334,-0.332,-0.331,-0.330,-0.329,-0.328,-0.327, & - -0.325,-0.324,-0.323,-0.322,-0.321,-0.320,-0.319,-0.317,-0.316, & - -0.315,-0.314,-0.313,-0.312,-0.311,-0.309,-0.308,-0.307,-0.306, & - -0.305,-0.304,-0.303,-0.301,-0.300,-0.299,-0.298,-0.297,-0.296, & - -0.295,-0.294,-0.292,-0.291,-0.290,-0.289,-0.288,-0.287,-0.286, & - -0.285,-0.283,-0.282,-0.281,-0.280,-0.279,-0.278,-0.277,-0.276, & - -0.275,-0.273,-0.272,-0.271,-0.270,-0.269,-0.268,-0.267,-0.266, & - -0.265,-0.263,-0.262,-0.261,-0.260,-0.259,-0.258,-0.257,-0.256, & - -0.255,-0.254,-0.253,-0.251,-0.250,-0.249,-0.248,-0.247,-0.246, & - -0.245,-0.244,-0.243,-0.242,-0.241,-0.240,-0.238,-0.237,-0.236, & - -0.235,-0.234,-0.233,-0.232,-0.231,-0.230,-0.229,-0.228,-0.227, & - -0.226,-0.225,-0.224,-0.222,-0.221,-0.220,-0.219,-0.218,-0.217, & - -0.216,-0.215,-0.214,-0.213,-0.212,-0.211,-0.210,-0.209,-0.208, & - -0.207,-0.206,-0.205,-0.204,-0.203,-0.202,-0.201,-0.200,-0.198, & - -0.197,-0.196,-0.195,-0.194,-0.193,-0.192,-0.191,-0.190,-0.189, & - -0.188,-0.187,-0.186,-0.185,-0.184,-0.183,-0.182,-0.181,-0.180, & - -0.179,-0.178,-0.177,-0.176,-0.175,-0.174,-0.173,-0.172,-0.171, & - -0.170,-0.169,-0.168,-0.167,-0.166,-0.165,-0.164,-0.163,-0.162, & - -0.161,-0.160,-0.159,-0.158,-0.157,-0.156,-0.155,-0.154,-0.153, & - -0.152,-0.151,-0.150,-0.149,-0.148,-0.147,-0.146,-0.145,-0.144, & - -0.143,-0.142,-0.141,-0.140,-0.130,-0.121,-0.111,-0.102,-0.093, & - -0.083,-0.074,-0.066,-0.057,-0.048,-0.039,-0.031,-0.022,-0.014, & - -0.006, 0.003, 0.011, 0.019, 0.027, 0.035, 0.043, 0.050, 0.058, & - & 0.066, 0.073, 0.081, 0.088, 0.095, 0.103, 0.110, 0.117, 0.124, & - & 0.131, 0.138, 0.145, 0.152, 0.159, 0.165, 0.172, 0.179, 0.185, & - & 0.192, 0.198, 0.205, 0.211, 0.217, 0.223, 0.230, 0.236, 0.242, & - & 0.248, 0.254, 0.260, 0.266, 0.272, 0.278, 0.283, 0.289, 0.295, & - & 0.301, 0.306, 0.312, 0.317, 0.323, 0.328, 0.334, 0.339, 0.345, & - & 0.350, 0.355, 0.360, 0.366, 0.371, 0.376, 0.381, 0.386, 0.391, & - & 0.396, 0.401, 0.406, 0.411, 0.416, 0.421, 0.426, 0.431, 0.435, & - & 0.440, 0.445, 0.449, 0.454, 0.459, 0.463, 0.468, 0.472, 0.477, & - & 0.482, 0.486, 0.490, 0.495, 0.499, 0.504, 0.508, 0.512, 0.517, & - & 0.521, 0.525, 0.529, 0.534, 0.538, 0.542, 0.546, 0.550, 0.554, & - & 0.559, 0.563, 0.567, 0.571, 0.575, 0.579, 0.583, 0.587, 0.590, & - & 0.594, 0.598, 0.602, 0.606, 0.610, 0.614, 0.617, 0.621, 0.625, & - & 0.629, 0.632, 0.636, 0.640, 0.643, 0.647, 0.651, 0.654, 0.658, & - & 0.661, 0.665, 0.669, 0.672, 0.676, 0.679, 0.683, 0.686, 0.690, & - & 0.693, 0.696, 0.700, 0.703, 0.707, 0.710, 0.713, 0.717, 0.720, & - & 0.723, 0.727, 0.730 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.091,-0.188,-0.233,-0.261,-0.282,-0.298,-0.310,-0.320,-0.328, & - -0.335,-0.340,-0.345,-0.348,-0.351,-0.353,-0.355,-0.356,-0.356, & - -0.357,-0.357,-0.356,-0.356,-0.355,-0.354,-0.353,-0.351,-0.350, & - -0.348,-0.346,-0.344,-0.342,-0.340,-0.337,-0.335,-0.333,-0.330, & - -0.327,-0.325,-0.322,-0.319,-0.316,-0.314,-0.311,-0.308,-0.305, & - -0.302,-0.299,-0.296,-0.293,-0.290,-0.287,-0.283,-0.280,-0.277, & - -0.274,-0.271,-0.268,-0.264,-0.261,-0.258,-0.255,-0.252,-0.248, & - -0.245,-0.242,-0.238,-0.235,-0.232,-0.228,-0.225,-0.222,-0.218, & - -0.215,-0.211,-0.208,-0.204,-0.201,-0.197,-0.194,-0.190,-0.187, & - -0.183,-0.179,-0.176,-0.172,-0.168,-0.164,-0.161,-0.157,-0.153, & - -0.149,-0.145,-0.141,-0.137,-0.133,-0.129,-0.125,-0.121,-0.117, & - -0.113,-0.109,-0.105,-0.101,-0.096,-0.092,-0.088,-0.084,-0.080, & - -0.075,-0.071,-0.067,-0.062,-0.058,-0.054,-0.049,-0.045,-0.041, & - -0.036,-0.032,-0.027,-0.023,-0.019,-0.014,-0.010,-0.005,-0.001, & - & 0.003, 0.008, 0.012, 0.017, 0.021, 0.026, 0.030, 0.034, 0.039, & - & 0.043, 0.048, 0.052, 0.057, 0.061, 0.065, 0.070, 0.074, 0.079, & - & 0.083, 0.087, 0.092, 0.096, 0.101, 0.105, 0.109, 0.114, 0.118, & - & 0.123, 0.127, 0.131, 0.136, 0.140, 0.144, 0.149, 0.153, 0.157, & - & 0.162, 0.166, 0.170, 0.175, 0.179, 0.183, 0.188, 0.192, 0.196, & - & 0.201, 0.205, 0.209, 0.214, 0.218, 0.222, 0.226, 0.231, 0.235, & - & 0.239, 0.243, 0.248, 0.252, 0.256, 0.260, 0.265, 0.269, 0.273, & - & 0.277, 0.281, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.311, & - & 0.315, 0.319, 0.323, 0.327, 0.331, 0.336, 0.340, 0.344, 0.348, & - & 0.352, 0.356, 0.360, 0.364, 0.368, 0.372, 0.377, 0.381, 0.385, & - & 0.389, 0.393, 0.397, 0.401, 0.405, 0.409, 0.413, 0.417, 0.421, & - & 0.425, 0.429, 0.433, 0.437, 0.441, 0.445, 0.449, 0.453, 0.457, & - & 0.461, 0.465, 0.469, 0.473, 0.477, 0.481, 0.485, 0.488, 0.492, & - & 0.496, 0.500, 0.504, 0.508, 0.512, 0.516, 0.520, 0.524, 0.527, & - & 0.531, 0.535, 0.539, 0.543, 0.547, 0.550, 0.554, 0.558, 0.562, & - & 0.566, 0.570, 0.573, 0.577, 0.581, 0.585, 0.588, 0.592, 0.596, & - & 0.600, 0.604, 0.607, 0.611, 0.615, 0.618, 0.622, 0.626, 0.630, & - & 0.633, 0.637, 0.641, 0.644, 0.648, 0.652, 0.656, 0.659, 0.663, & - & 0.667, 0.670, 0.674, 0.677, 0.681, 0.685, 0.688, 0.692, 0.696, & - & 0.699, 0.703, 0.706, 0.710, 0.714, 0.717, 0.721, 0.724, 0.728, & - & 0.732, 0.735, 0.739, 0.742, 0.746, 0.749, 0.753, 0.756, 0.760, & - & 0.763, 0.767, 0.770, 0.774, 0.777, 0.781, 0.784, 0.788, 0.791, & - & 0.795, 0.798, 0.802, 0.805, 0.809, 0.812, 0.816, 0.819, 0.823, & - & 0.826, 0.829, 0.833, 0.836, 0.840, 0.843, 0.846, 0.850, 0.853, & - & 0.857, 0.860, 0.863, 0.867, 0.870, 0.873, 0.877, 0.880, 0.884, & - & 0.887, 0.890, 0.894, 0.897, 0.900, 0.904, 0.907, 0.910, 0.913, & - & 0.917, 0.920, 0.923, 0.927, 0.930, 0.933, 0.936, 0.940, 0.943, & - & 0.946, 0.950, 0.953, 0.956, 0.959, 0.963, 0.966, 0.969, 0.972, & - & 0.975, 0.979, 0.982, 0.985, 0.988, 0.991, 0.995, 0.998, 1.001, & - & 1.004, 1.007, 1.011, 1.014, 1.017, 1.020, 1.023, 1.026, 1.029, & - & 1.033, 1.036, 1.039, 1.042, 1.076, 1.106, 1.136, 1.166, 1.195, & - & 1.224, 1.253, 1.281, 1.309, 1.337, 1.364, 1.391, 1.417, 1.444, & - & 1.470, 1.495, 1.521, 1.546, 1.570, 1.595, 1.619, 1.643, 1.667, & - & 1.690, 1.713, 1.736, 1.759, 1.781, 1.803, 1.825, 1.847, 1.868, & - & 1.890, 1.911, 1.932, 1.952, 1.973, 1.993, 2.013, 2.033, 2.053, & - & 2.072, 2.092, 2.111, 2.130, 2.149, 2.167, 2.186, 2.204, 2.222, & - & 2.240, 2.258, 2.276, 2.293, 2.311, 2.328, 2.345, 2.362, 2.379, & - & 2.396, 2.412, 2.429, 2.445, 2.461, 2.478, 2.493, 2.509, 2.525, & - & 2.541, 2.556, 2.572, 2.587, 2.602, 2.617, 2.632, 2.647, 2.661, & - & 2.676, 2.691, 2.705, 2.719, 2.734, 2.748, 2.762, 2.776, 2.789, & - & 2.803, 2.817, 2.830, 2.844, 2.857, 2.871, 2.884, 2.897, 2.910, & - & 2.923, 2.936, 2.949, 2.961, 2.974, 2.987, 2.999, 3.012, 3.024, & - & 3.036, 3.048, 3.061, 3.073, 3.085, 3.097, 3.108, 3.120, 3.132, & - & 3.144, 3.155, 3.167, 3.178, 3.190, 3.201, 3.212, 3.224, 3.235, & - & 3.246, 3.257, 3.268, 3.279, 3.290, 3.300, 3.311, 3.322, 3.333, & - & 3.343, 3.354, 3.364, 3.375, 3.385, 3.395, 3.406, 3.416, 3.426, & - & 3.436, 3.446, 3.456, 3.466, 3.476, 3.486, 3.496, 3.506, 3.515, & - & 3.525, 3.535, 3.544, 3.554, 3.563, 3.573, 3.582, 3.592, 3.601, & - & 3.610, 3.620, 3.629 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.093,-0.203,-0.257,-0.296,-0.326,-0.351,-0.372,-0.391,-0.408, & - -0.423,-0.436,-0.449,-0.460,-0.471,-0.481,-0.491,-0.500,-0.508, & - -0.516,-0.524,-0.531,-0.538,-0.545,-0.552,-0.558,-0.564,-0.569, & - -0.575,-0.580,-0.585,-0.590,-0.595,-0.600,-0.605,-0.609,-0.613, & - -0.618,-0.622,-0.626,-0.629,-0.633,-0.637,-0.641,-0.644,-0.648, & - -0.651,-0.654,-0.658,-0.661,-0.664,-0.667,-0.670,-0.673,-0.676, & - -0.678,-0.681,-0.684,-0.687,-0.689,-0.692,-0.694,-0.697,-0.699, & - -0.702,-0.704,-0.707,-0.709,-0.711,-0.713,-0.716,-0.718,-0.720, & - -0.722,-0.724,-0.726,-0.728,-0.730,-0.732,-0.734,-0.736,-0.738, & - -0.740,-0.742,-0.744,-0.746,-0.748,-0.749,-0.751,-0.753,-0.755, & - -0.756,-0.758,-0.760,-0.762,-0.763,-0.765,-0.767,-0.768,-0.770, & - -0.772,-0.773,-0.775,-0.776,-0.778,-0.779,-0.781,-0.782,-0.784, & - -0.786,-0.787,-0.788,-0.790,-0.791,-0.793,-0.794,-0.796,-0.797, & - -0.799,-0.800,-0.801,-0.803,-0.804,-0.805,-0.807,-0.808,-0.809, & - -0.811,-0.812,-0.813,-0.815,-0.816,-0.817,-0.819,-0.820,-0.821, & - -0.822,-0.824,-0.825,-0.826,-0.827,-0.828,-0.830,-0.831,-0.832, & - -0.833,-0.834,-0.835,-0.837,-0.838,-0.839,-0.840,-0.841,-0.842, & - -0.843,-0.844,-0.846,-0.847,-0.848,-0.849,-0.850,-0.851,-0.852, & - -0.853,-0.854,-0.855,-0.856,-0.857,-0.858,-0.859,-0.860,-0.861, & - -0.862,-0.863,-0.864,-0.865,-0.866,-0.867,-0.868,-0.869,-0.870, & - -0.871,-0.872,-0.873,-0.874,-0.875,-0.876,-0.877,-0.878,-0.878, & - -0.879,-0.880,-0.881,-0.882,-0.883,-0.884,-0.885,-0.886,-0.886, & - -0.887,-0.888,-0.889,-0.890,-0.891,-0.892,-0.893,-0.893,-0.894, & - -0.895,-0.896,-0.897,-0.898,-0.898,-0.899,-0.900,-0.901,-0.902, & - -0.902,-0.903,-0.904,-0.905,-0.906,-0.906,-0.907,-0.908,-0.909, & - -0.910,-0.910,-0.911,-0.912,-0.913,-0.913,-0.914,-0.915,-0.916, & - -0.916,-0.917,-0.918,-0.919,-0.919,-0.920,-0.921,-0.922,-0.922, & - -0.923,-0.924,-0.924,-0.925,-0.926,-0.927,-0.927,-0.928,-0.929, & - -0.929,-0.930,-0.931,-0.931,-0.932,-0.933,-0.933,-0.934,-0.935, & - -0.936,-0.936,-0.937,-0.938,-0.938,-0.939,-0.940,-0.940,-0.941, & - -0.941,-0.942,-0.943,-0.943,-0.944,-0.945,-0.945,-0.946,-0.947, & - -0.947,-0.948,-0.949,-0.949,-0.950,-0.950,-0.951,-0.952,-0.952, & - -0.953,-0.954,-0.954,-0.955,-0.955,-0.956,-0.957,-0.957,-0.958, & - -0.958,-0.959,-0.960,-0.960,-0.961,-0.961,-0.962,-0.962,-0.963, & - -0.964,-0.964,-0.965,-0.965,-0.966,-0.967,-0.967,-0.968,-0.968, & - -0.969,-0.969,-0.970,-0.970,-0.971,-0.972,-0.972,-0.973,-0.973, & - -0.974,-0.974,-0.975,-0.975,-0.976,-0.977,-0.977,-0.978,-0.978, & - -0.979,-0.979,-0.980,-0.980,-0.981,-0.981,-0.982,-0.982,-0.983, & - -0.983,-0.984,-0.984,-0.985,-0.986,-0.986,-0.987,-0.987,-0.988, & - -0.988,-0.989,-0.989,-0.990,-0.990,-0.991,-0.991,-0.992,-0.992, & - -0.993,-0.993,-0.994,-0.994,-0.995,-0.995,-0.996,-0.996,-0.997, & - -0.997,-0.998,-0.998,-0.998,-0.999,-0.999,-1.000,-1.000,-1.001, & - -1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.004,-1.005,-1.005, & - -1.006,-1.006,-1.006,-1.007,-1.007,-1.008,-1.008,-1.009,-1.009, & - -1.010,-1.010,-1.011,-1.011,-1.016,-1.020,-1.024,-1.029,-1.033, & - -1.037,-1.040,-1.044,-1.048,-1.052,-1.055,-1.059,-1.062,-1.065, & - -1.069,-1.072,-1.075,-1.078,-1.081,-1.084,-1.087,-1.090,-1.093, & - -1.096,-1.099,-1.102,-1.104,-1.107,-1.110,-1.112,-1.115,-1.117, & - -1.120,-1.122,-1.125,-1.127,-1.129,-1.132,-1.134,-1.136,-1.139, & - -1.141,-1.143,-1.145,-1.147,-1.149,-1.151,-1.153,-1.155,-1.157, & - -1.159,-1.161,-1.163,-1.165,-1.167,-1.169,-1.171,-1.173,-1.174, & - -1.176,-1.178,-1.180,-1.181,-1.183,-1.185,-1.187,-1.188,-1.190, & - -1.191,-1.193,-1.195,-1.196,-1.198,-1.199,-1.201,-1.202,-1.204, & - -1.205,-1.207,-1.208,-1.210,-1.211,-1.213,-1.214,-1.216,-1.217, & - -1.218,-1.220,-1.221,-1.223,-1.224,-1.225,-1.226,-1.228,-1.229, & - -1.230,-1.232,-1.233,-1.234,-1.235,-1.237,-1.238,-1.239,-1.240, & - -1.242,-1.243,-1.244,-1.245,-1.246,-1.247,-1.249,-1.250,-1.251, & - -1.252,-1.253,-1.254,-1.255,-1.256,-1.258,-1.259,-1.260,-1.261, & - -1.262,-1.263,-1.264,-1.265,-1.266,-1.267,-1.268,-1.269,-1.270, & - -1.271,-1.272,-1.273,-1.274,-1.275,-1.276,-1.277,-1.278,-1.279, & - -1.280,-1.281,-1.282,-1.283,-1.283,-1.284,-1.285,-1.286,-1.287, & - -1.288,-1.289,-1.290,-1.291,-1.292,-1.292,-1.293,-1.294,-1.295, & - -1.296,-1.297,-1.298 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.046,-0.097,-0.121,-0.138,-0.150,-0.161,-0.169,-0.176,-0.182, & - -0.188,-0.192,-0.196,-0.200,-0.203,-0.206,-0.209,-0.211,-0.213, & - -0.215,-0.217,-0.218,-0.219,-0.220,-0.221,-0.222,-0.223,-0.223, & - -0.223,-0.223,-0.224,-0.223,-0.223,-0.223,-0.223,-0.222,-0.222, & - -0.221,-0.220,-0.220,-0.219,-0.218,-0.217,-0.216,-0.215,-0.213, & - -0.212,-0.211,-0.209,-0.208,-0.206,-0.205,-0.203,-0.202,-0.200, & - -0.198,-0.196,-0.195,-0.193,-0.191,-0.189,-0.187,-0.185,-0.183, & - -0.181,-0.179,-0.177,-0.174,-0.172,-0.170,-0.168,-0.165,-0.163, & - -0.161,-0.158,-0.156,-0.153,-0.151,-0.148,-0.146,-0.143,-0.141, & - -0.138,-0.136,-0.133,-0.130,-0.127,-0.125,-0.122,-0.119,-0.116, & - -0.114,-0.111,-0.108,-0.105,-0.102,-0.099,-0.096,-0.093,-0.090, & - -0.087,-0.084,-0.081,-0.078,-0.075,-0.072,-0.069,-0.066,-0.063, & - -0.060,-0.056,-0.053,-0.050,-0.047,-0.044,-0.041,-0.037,-0.034, & - -0.031,-0.028,-0.025,-0.021,-0.018,-0.015,-0.012,-0.009,-0.005, & - -0.002, 0.001, 0.004, 0.007, 0.011, 0.014, 0.017, 0.020, 0.023, & - & 0.027, 0.030, 0.033, 0.036, 0.039, 0.043, 0.046, 0.049, 0.052, & - & 0.055, 0.058, 0.061, 0.065, 0.068, 0.071, 0.074, 0.077, 0.080, & - & 0.083, 0.086, 0.089, 0.093, 0.096, 0.099, 0.102, 0.105, 0.108, & - & 0.111, 0.114, 0.117, 0.120, 0.123, 0.126, 0.129, 0.132, 0.135, & - & 0.138, 0.141, 0.144, 0.147, 0.150, 0.153, 0.156, 0.159, 0.162, & - & 0.165, 0.168, 0.171, 0.174, 0.176, 0.179, 0.182, 0.185, 0.188, & - & 0.191, 0.194, 0.197, 0.199, 0.202, 0.205, 0.208, 0.211, 0.214, & - & 0.217, 0.219, 0.222, 0.225, 0.228, 0.231, 0.233, 0.236, 0.239, & - & 0.242, 0.244, 0.247, 0.250, 0.253, 0.255, 0.258, 0.261, 0.264, & - & 0.266, 0.269, 0.272, 0.274, 0.277, 0.280, 0.282, 0.285, 0.288, & - & 0.290, 0.293, 0.296, 0.298, 0.301, 0.304, 0.306, 0.309, 0.312, & - & 0.314, 0.317, 0.319, 0.322, 0.325, 0.327, 0.330, 0.332, 0.335, & - & 0.337, 0.340, 0.343, 0.345, 0.348, 0.350, 0.353, 0.355, 0.358, & - & 0.360, 0.363, 0.365, 0.368, 0.370, 0.373, 0.375, 0.378, 0.380, & - & 0.383, 0.385, 0.388, 0.390, 0.393, 0.395, 0.397, 0.400, 0.402, & - & 0.405, 0.407, 0.410, 0.412, 0.414, 0.417, 0.419, 0.422, 0.424, & - & 0.426, 0.429, 0.431, 0.434, 0.436, 0.438, 0.441, 0.443, 0.445, & - & 0.448, 0.450, 0.452, 0.455, 0.457, 0.459, 0.462, 0.464, 0.466, & - & 0.469, 0.471, 0.473, 0.475, 0.478, 0.480, 0.482, 0.485, 0.487, & - & 0.489, 0.491, 0.494, 0.496, 0.498, 0.500, 0.503, 0.505, 0.507, & - & 0.509, 0.512, 0.514, 0.516, 0.518, 0.520, 0.523, 0.525, 0.527, & - & 0.529, 0.531, 0.534, 0.536, 0.538, 0.540, 0.542, 0.544, 0.547, & - & 0.549, 0.551, 0.553, 0.555, 0.557, 0.560, 0.562, 0.564, 0.566, & - & 0.568, 0.570, 0.572, 0.574, 0.577, 0.579, 0.581, 0.583, 0.585, & - & 0.587, 0.589, 0.591, 0.593, 0.595, 0.597, 0.600, 0.602, 0.604, & - & 0.606, 0.608, 0.610, 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, & - & 0.624, 0.626, 0.628, 0.630, 0.632, 0.634, 0.636, 0.638, 0.640, & - & 0.642, 0.644, 0.646, 0.648, 0.650, 0.652, 0.654, 0.656, 0.658, & - & 0.660, 0.662, 0.664, 0.666, 0.668, 0.670, 0.672, 0.674, 0.676, & - & 0.678, 0.680, 0.682, 0.684, 0.704, 0.723, 0.742, 0.760, 0.778, & - & 0.796, 0.813, 0.831, 0.848, 0.865, 0.881, 0.898, 0.914, 0.930, & - & 0.946, 0.961, 0.977, 0.992, 1.007, 1.022, 1.036, 1.051, 1.065, & - & 1.079, 1.093, 1.107, 1.121, 1.134, 1.148, 1.161, 1.174, 1.187, & - & 1.200, 1.213, 1.225, 1.238, 1.250, 1.262, 1.275, 1.287, 1.298, & - & 1.310, 1.322, 1.333, 1.345, 1.356, 1.367, 1.379, 1.390, 1.401, & - & 1.411, 1.422, 1.433, 1.443, 1.454, 1.464, 1.475, 1.485, 1.495, & - & 1.505, 1.515, 1.525, 1.535, 1.545, 1.554, 1.564, 1.573, 1.583, & - & 1.592, 1.602, 1.611, 1.620, 1.629, 1.638, 1.647, 1.656, 1.665, & - & 1.674, 1.682, 1.691, 1.700, 1.708, 1.717, 1.725, 1.734, 1.742, & - & 1.750, 1.758, 1.767, 1.775, 1.783, 1.791, 1.799, 1.807, 1.815, & - & 1.822, 1.830, 1.838, 1.845, 1.853, 1.861, 1.868, 1.876, 1.883, & - & 1.891, 1.898, 1.905, 1.912, 1.920, 1.927, 1.934, 1.941, 1.948, & - & 1.955, 1.962, 1.969, 1.976, 1.983, 1.990, 1.997, 2.003, 2.010, & - & 2.017, 2.023, 2.030, 2.037, 2.043, 2.050, 2.056, 2.063, 2.069, & - & 2.075, 2.082, 2.088, 2.094, 2.101, 2.107, 2.113, 2.119, 2.125, & - & 2.131, 2.137, 2.143, 2.149, 2.155, 2.161, 2.167, 2.173, 2.179, & - & 2.185, 2.191, 2.197, 2.202, 2.208, 2.214, 2.219, 2.225, 2.231, & - & 2.236, 2.242, 2.248 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.048,-0.109,-0.141,-0.166,-0.186,-0.204,-0.219,-0.233,-0.246, & - -0.258,-0.270,-0.281,-0.291,-0.301,-0.310,-0.319,-0.328,-0.336, & - -0.344,-0.352,-0.360,-0.367,-0.375,-0.382,-0.389,-0.395,-0.402, & - -0.409,-0.415,-0.421,-0.427,-0.433,-0.439,-0.445,-0.451,-0.456, & - -0.462,-0.467,-0.472,-0.477,-0.483,-0.488,-0.492,-0.497,-0.502, & - -0.507,-0.511,-0.516,-0.521,-0.525,-0.529,-0.534,-0.538,-0.542, & - -0.546,-0.550,-0.554,-0.558,-0.562,-0.566,-0.570,-0.574,-0.578, & - -0.581,-0.585,-0.589,-0.592,-0.596,-0.600,-0.603,-0.607,-0.610, & - -0.613,-0.617,-0.620,-0.624,-0.627,-0.630,-0.634,-0.637,-0.640, & - -0.643,-0.647,-0.650,-0.653,-0.656,-0.660,-0.663,-0.666,-0.669, & - -0.672,-0.675,-0.678,-0.682,-0.685,-0.688,-0.691,-0.694,-0.697, & - -0.700,-0.703,-0.706,-0.709,-0.712,-0.715,-0.718,-0.721,-0.724, & - -0.727,-0.730,-0.733,-0.736,-0.739,-0.741,-0.744,-0.747,-0.750, & - -0.753,-0.756,-0.758,-0.761,-0.764,-0.767,-0.770,-0.772,-0.775, & - -0.778,-0.780,-0.783,-0.786,-0.789,-0.791,-0.794,-0.796,-0.799, & - -0.802,-0.804,-0.807,-0.809,-0.812,-0.814,-0.817,-0.819,-0.822, & - -0.824,-0.827,-0.829,-0.832,-0.834,-0.837,-0.839,-0.841,-0.844, & - -0.846,-0.848,-0.851,-0.853,-0.855,-0.858,-0.860,-0.862,-0.865, & - -0.867,-0.869,-0.871,-0.873,-0.876,-0.878,-0.880,-0.882,-0.884, & - -0.887,-0.889,-0.891,-0.893,-0.895,-0.897,-0.899,-0.901,-0.903, & - -0.905,-0.908,-0.910,-0.912,-0.914,-0.916,-0.918,-0.920,-0.922, & - -0.924,-0.925,-0.927,-0.929,-0.931,-0.933,-0.935,-0.937,-0.939, & - -0.941,-0.943,-0.945,-0.946,-0.948,-0.950,-0.952,-0.954,-0.956, & - -0.957,-0.959,-0.961,-0.963,-0.965,-0.966,-0.968,-0.970,-0.972, & - -0.973,-0.975,-0.977,-0.978,-0.980,-0.982,-0.984,-0.985,-0.987, & - -0.989,-0.990,-0.992,-0.993,-0.995,-0.997,-0.998,-1.000,-1.002, & - -1.003,-1.005,-1.006,-1.008,-1.009,-1.011,-1.013,-1.014,-1.016, & - -1.017,-1.019,-1.020,-1.022,-1.023,-1.025,-1.026,-1.028,-1.029, & - -1.031,-1.032,-1.034,-1.035,-1.036,-1.038,-1.039,-1.041,-1.042, & - -1.044,-1.045,-1.046,-1.048,-1.049,-1.051,-1.052,-1.053,-1.055, & - -1.056,-1.057,-1.059,-1.060,-1.061,-1.063,-1.064,-1.065,-1.067, & - -1.068,-1.069,-1.071,-1.072,-1.073,-1.074,-1.076,-1.077,-1.078, & - -1.079,-1.081,-1.082,-1.083,-1.084,-1.086,-1.087,-1.088,-1.089, & - -1.090,-1.092,-1.093,-1.094,-1.095,-1.096,-1.098,-1.099,-1.100, & - -1.101,-1.102,-1.103,-1.105,-1.106,-1.107,-1.108,-1.109,-1.110, & - -1.111,-1.112,-1.114,-1.115,-1.116,-1.117,-1.118,-1.119,-1.120, & - -1.121,-1.122,-1.123,-1.124,-1.125,-1.127,-1.128,-1.129,-1.130, & - -1.131,-1.132,-1.133,-1.134,-1.135,-1.136,-1.137,-1.138,-1.139, & - -1.140,-1.141,-1.142,-1.143,-1.144,-1.145,-1.146,-1.147,-1.148, & - -1.149,-1.150,-1.151,-1.152,-1.153,-1.153,-1.154,-1.155,-1.156, & - -1.157,-1.158,-1.159,-1.160,-1.161,-1.162,-1.163,-1.164,-1.165, & - -1.165,-1.166,-1.167,-1.168,-1.169,-1.170,-1.171,-1.172,-1.172, & - -1.173,-1.174,-1.175,-1.176,-1.177,-1.178,-1.178,-1.179,-1.180, & - -1.181,-1.182,-1.183,-1.183,-1.184,-1.185,-1.186,-1.187,-1.188, & - -1.188,-1.189,-1.190,-1.191,-1.199,-1.207,-1.214,-1.221,-1.228, & - -1.234,-1.240,-1.246,-1.252,-1.258,-1.263,-1.268,-1.273,-1.278, & - -1.283,-1.287,-1.292,-1.296,-1.300,-1.304,-1.308,-1.312,-1.315, & - -1.319,-1.322,-1.325,-1.329,-1.332,-1.335,-1.338,-1.341,-1.343, & - -1.346,-1.349,-1.351,-1.354,-1.356,-1.358,-1.361,-1.363,-1.365, & - -1.367,-1.369,-1.371,-1.373,-1.375,-1.377,-1.378,-1.380,-1.382, & - -1.383,-1.385,-1.387,-1.388,-1.390,-1.391,-1.393,-1.394,-1.395, & - -1.397,-1.398,-1.399,-1.400,-1.402,-1.403,-1.404,-1.405,-1.406, & - -1.407,-1.408,-1.409,-1.410,-1.411,-1.412,-1.413,-1.414,-1.415, & - -1.416,-1.417,-1.418,-1.419,-1.420,-1.420,-1.421,-1.422,-1.423, & - -1.424,-1.424,-1.425,-1.426,-1.427,-1.427,-1.428,-1.429,-1.429, & - -1.430,-1.430,-1.431,-1.432,-1.432,-1.433,-1.434,-1.434,-1.435, & - -1.435,-1.436,-1.436,-1.437,-1.437,-1.438,-1.438,-1.439,-1.439, & - -1.440,-1.440,-1.441,-1.441,-1.442,-1.442,-1.443,-1.443,-1.443, & - -1.444,-1.444,-1.445,-1.445,-1.445,-1.446,-1.446,-1.447,-1.447, & - -1.447,-1.448,-1.448,-1.448,-1.449,-1.449,-1.449,-1.450,-1.450, & - -1.450,-1.451,-1.451,-1.451,-1.452,-1.452,-1.452,-1.453,-1.453, & - -1.453,-1.454,-1.454,-1.454,-1.454,-1.455,-1.455,-1.455,-1.455, & - -1.456,-1.456,-1.456 & - / - -! *** KCL - - DATA BNC20M/ & - -0.046,-0.098,-0.123,-0.139,-0.152,-0.162,-0.171,-0.178,-0.184, & - -0.190,-0.195,-0.199,-0.203,-0.206,-0.209,-0.212,-0.215,-0.217, & - -0.219,-0.221,-0.223,-0.225,-0.226,-0.228,-0.229,-0.230,-0.231, & - -0.232,-0.233,-0.234,-0.235,-0.236,-0.236,-0.237,-0.238,-0.238, & - -0.239,-0.239,-0.240,-0.240,-0.240,-0.241,-0.241,-0.241,-0.242, & - -0.242,-0.242,-0.242,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243, & - -0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243, & - -0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.243,-0.242, & - -0.242,-0.242,-0.242,-0.242,-0.242,-0.241,-0.241,-0.241,-0.241, & - -0.241,-0.240,-0.240,-0.240,-0.239,-0.239,-0.239,-0.239,-0.238, & - -0.238,-0.238,-0.237,-0.237,-0.237,-0.236,-0.236,-0.235,-0.235, & - -0.235,-0.234,-0.234,-0.233,-0.233,-0.232,-0.232,-0.232,-0.231, & - -0.231,-0.230,-0.230,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, & - -0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.223,-0.223,-0.222, & - -0.222,-0.221,-0.220,-0.220,-0.219,-0.219,-0.218,-0.218,-0.217, & - -0.217,-0.216,-0.216,-0.215,-0.214,-0.214,-0.213,-0.213,-0.212, & - -0.212,-0.211,-0.210,-0.210,-0.209,-0.209,-0.208,-0.208,-0.207, & - -0.207,-0.206,-0.205,-0.205,-0.204,-0.204,-0.203,-0.203,-0.202, & - -0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.198,-0.197,-0.197, & - -0.196,-0.196,-0.195,-0.194,-0.194,-0.193,-0.193,-0.192,-0.192, & - -0.191,-0.190,-0.190,-0.189,-0.189,-0.188,-0.188,-0.187,-0.186, & - -0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.182,-0.182,-0.181, & - -0.181,-0.180,-0.180,-0.179,-0.178,-0.178,-0.177,-0.177,-0.176, & - -0.176,-0.175,-0.174,-0.174,-0.173,-0.173,-0.172,-0.172,-0.171, & - -0.170,-0.170,-0.169,-0.169,-0.168,-0.168,-0.167,-0.166,-0.166, & - -0.165,-0.165,-0.164,-0.164,-0.163,-0.162,-0.162,-0.161,-0.161, & - -0.160,-0.160,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156,-0.156, & - -0.155,-0.155,-0.154,-0.153,-0.153,-0.152,-0.152,-0.151,-0.151, & - -0.150,-0.150,-0.149,-0.148,-0.148,-0.147,-0.147,-0.146,-0.146, & - -0.145,-0.145,-0.144,-0.143,-0.143,-0.142,-0.142,-0.141,-0.141, & - -0.140,-0.140,-0.139,-0.139,-0.138,-0.137,-0.137,-0.136,-0.136, & - -0.135,-0.135,-0.134,-0.134,-0.133,-0.133,-0.132,-0.131,-0.131, & - -0.130,-0.130,-0.129,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126, & - -0.126,-0.125,-0.125,-0.124,-0.123,-0.123,-0.122,-0.122,-0.121, & - -0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.118,-0.117,-0.117, & - -0.116,-0.116,-0.115,-0.115,-0.114,-0.113,-0.113,-0.112,-0.112, & - -0.111,-0.111,-0.110,-0.110,-0.109,-0.109,-0.108,-0.108,-0.107, & - -0.107,-0.106,-0.106,-0.105,-0.105,-0.104,-0.104,-0.103,-0.103, & - -0.102,-0.102,-0.101,-0.101,-0.100,-0.100,-0.099,-0.099,-0.098, & - -0.098,-0.097,-0.097,-0.096,-0.096,-0.095,-0.095,-0.094,-0.094, & - -0.093,-0.093,-0.092,-0.092,-0.091,-0.091,-0.090,-0.090,-0.089, & - -0.089,-0.088,-0.088,-0.087,-0.087,-0.086,-0.086,-0.085,-0.085, & - -0.084,-0.084,-0.083,-0.083,-0.082,-0.082,-0.081,-0.081,-0.080, & - -0.080,-0.079,-0.079,-0.078,-0.078,-0.077,-0.077,-0.077,-0.076, & - -0.076,-0.075,-0.075,-0.074,-0.069,-0.064,-0.060,-0.055,-0.051, & - -0.046,-0.042,-0.037,-0.033,-0.028,-0.024,-0.020,-0.016,-0.012, & - -0.008,-0.004, 0.000, 0.004, 0.008, 0.012, 0.016, 0.020, 0.024, & - & 0.028, 0.031, 0.035, 0.039, 0.042, 0.046, 0.049, 0.053, 0.056, & - & 0.060, 0.063, 0.067, 0.070, 0.073, 0.077, 0.080, 0.083, 0.087, & - & 0.090, 0.093, 0.096, 0.099, 0.102, 0.105, 0.108, 0.111, 0.114, & - & 0.117, 0.120, 0.123, 0.126, 0.129, 0.132, 0.135, 0.138, 0.141, & - & 0.143, 0.146, 0.149, 0.152, 0.154, 0.157, 0.160, 0.162, 0.165, & - & 0.168, 0.170, 0.173, 0.176, 0.178, 0.181, 0.183, 0.186, 0.188, & - & 0.191, 0.193, 0.196, 0.198, 0.200, 0.203, 0.205, 0.208, 0.210, & - & 0.212, 0.215, 0.217, 0.219, 0.221, 0.224, 0.226, 0.228, 0.231, & - & 0.233, 0.235, 0.237, 0.239, 0.242, 0.244, 0.246, 0.248, 0.250, & - & 0.252, 0.254, 0.256, 0.258, 0.261, 0.263, 0.265, 0.267, 0.269, & - & 0.271, 0.273, 0.275, 0.277, 0.279, 0.281, 0.283, 0.285, 0.286, & - & 0.288, 0.290, 0.292, 0.294, 0.296, 0.298, 0.300, 0.302, 0.304, & - & 0.305, 0.307, 0.309, 0.311, 0.313, 0.314, 0.316, 0.318, 0.320, & - & 0.322, 0.323, 0.325, 0.327, 0.329, 0.330, 0.332, 0.334, 0.335, & - & 0.337, 0.339, 0.341, 0.342, 0.344, 0.346, 0.347, 0.349, 0.350, & - & 0.352, 0.354, 0.355 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.185,-0.400,-0.506,-0.579,-0.636,-0.683,-0.723,-0.757,-0.787, & - -0.814,-0.839,-0.861,-0.881,-0.900,-0.917,-0.934,-0.949,-0.963, & - -0.977,-0.989,-1.001,-1.013,-1.023,-1.034,-1.044,-1.053,-1.062, & - -1.071,-1.079,-1.087,-1.094,-1.102,-1.109,-1.116,-1.122,-1.129, & - -1.135,-1.141,-1.147,-1.152,-1.158,-1.163,-1.168,-1.173,-1.178, & - -1.183,-1.187,-1.192,-1.196,-1.200,-1.205,-1.209,-1.213,-1.216, & - -1.220,-1.224,-1.228,-1.231,-1.235,-1.238,-1.241,-1.244,-1.248, & - -1.251,-1.254,-1.257,-1.260,-1.263,-1.265,-1.268,-1.271,-1.274, & - -1.276,-1.279,-1.281,-1.284,-1.286,-1.288,-1.291,-1.293,-1.295, & - -1.297,-1.300,-1.302,-1.304,-1.306,-1.308,-1.310,-1.312,-1.314, & - -1.316,-1.317,-1.319,-1.321,-1.323,-1.324,-1.326,-1.328,-1.329, & - -1.331,-1.333,-1.334,-1.336,-1.337,-1.339,-1.340,-1.341,-1.343, & - -1.344,-1.346,-1.347,-1.348,-1.350,-1.351,-1.352,-1.353,-1.355, & - -1.356,-1.357,-1.358,-1.359,-1.360,-1.362,-1.363,-1.364,-1.365, & - -1.366,-1.367,-1.368,-1.369,-1.370,-1.371,-1.372,-1.373,-1.374, & - -1.375,-1.376,-1.377,-1.377,-1.378,-1.379,-1.380,-1.381,-1.382, & - -1.383,-1.383,-1.384,-1.385,-1.386,-1.387,-1.387,-1.388,-1.389, & - -1.390,-1.390,-1.391,-1.392,-1.393,-1.393,-1.394,-1.395,-1.395, & - -1.396,-1.397,-1.397,-1.398,-1.399,-1.399,-1.400,-1.401,-1.401, & - -1.402,-1.402,-1.403,-1.404,-1.404,-1.405,-1.405,-1.406,-1.406, & - -1.407,-1.407,-1.408,-1.408,-1.409,-1.410,-1.410,-1.411,-1.411, & - -1.412,-1.412,-1.412,-1.413,-1.413,-1.414,-1.414,-1.415,-1.415, & - -1.416,-1.416,-1.417,-1.417,-1.417,-1.418,-1.418,-1.419,-1.419, & - -1.420,-1.420,-1.420,-1.421,-1.421,-1.422,-1.422,-1.422,-1.423, & - -1.423,-1.423,-1.424,-1.424,-1.424,-1.425,-1.425,-1.426,-1.426, & - -1.426,-1.427,-1.427,-1.427,-1.428,-1.428,-1.428,-1.428,-1.429, & - -1.429,-1.429,-1.430,-1.430,-1.430,-1.431,-1.431,-1.431,-1.431, & - -1.432,-1.432,-1.432,-1.433,-1.433,-1.433,-1.433,-1.434,-1.434, & - -1.434,-1.434,-1.435,-1.435,-1.435,-1.435,-1.436,-1.436,-1.436, & - -1.436,-1.437,-1.437,-1.437,-1.437,-1.437,-1.438,-1.438,-1.438, & - -1.438,-1.439,-1.439,-1.439,-1.439,-1.439,-1.440,-1.440,-1.440, & - -1.440,-1.440,-1.441,-1.441,-1.441,-1.441,-1.441,-1.441,-1.442, & - -1.442,-1.442,-1.442,-1.442,-1.442,-1.443,-1.443,-1.443,-1.443, & - -1.443,-1.443,-1.444,-1.444,-1.444,-1.444,-1.444,-1.444,-1.445, & - -1.445,-1.445,-1.445,-1.445,-1.445,-1.445,-1.446,-1.446,-1.446, & - -1.446,-1.446,-1.446,-1.446,-1.446,-1.447,-1.447,-1.447,-1.447, & - -1.447,-1.447,-1.447,-1.447,-1.448,-1.448,-1.448,-1.448,-1.448, & - -1.448,-1.448,-1.448,-1.448,-1.449,-1.449,-1.449,-1.449,-1.449, & - -1.449,-1.449,-1.449,-1.449,-1.449,-1.450,-1.450,-1.450,-1.450, & - -1.450,-1.450,-1.450,-1.450,-1.450,-1.450,-1.450,-1.451,-1.451, & - -1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451,-1.451, & - -1.451,-1.451,-1.451,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452, & - -1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452,-1.452, & - -1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453,-1.453, & - -1.453,-1.453,-1.453,-1.453,-1.454,-1.454,-1.454,-1.455,-1.455, & - -1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455,-1.455, & - -1.454,-1.454,-1.454,-1.454,-1.453,-1.453,-1.453,-1.452,-1.452, & - -1.452,-1.451,-1.451,-1.450,-1.450,-1.450,-1.449,-1.449,-1.448, & - -1.448,-1.447,-1.447,-1.446,-1.446,-1.445,-1.445,-1.444,-1.444, & - -1.443,-1.442,-1.442,-1.441,-1.441,-1.440,-1.440,-1.439,-1.438, & - -1.438,-1.437,-1.437,-1.436,-1.436,-1.435,-1.434,-1.434,-1.433, & - -1.433,-1.432,-1.431,-1.431,-1.430,-1.430,-1.429,-1.428,-1.428, & - -1.427,-1.426,-1.426,-1.425,-1.425,-1.424,-1.423,-1.423,-1.422, & - -1.422,-1.421,-1.420,-1.420,-1.419,-1.418,-1.418,-1.417,-1.417, & - -1.416,-1.415,-1.415,-1.414,-1.414,-1.413,-1.412,-1.412,-1.411, & - -1.411,-1.410,-1.409,-1.409,-1.408,-1.408,-1.407,-1.406,-1.406, & - -1.405,-1.405,-1.404,-1.403,-1.403,-1.402,-1.402,-1.401,-1.400, & - -1.400,-1.399,-1.399,-1.398,-1.398,-1.397,-1.396,-1.396,-1.395, & - -1.395,-1.394,-1.394,-1.393,-1.392,-1.392,-1.391,-1.391,-1.390, & - -1.390,-1.389,-1.388,-1.388,-1.387,-1.387,-1.386,-1.386,-1.385, & - -1.385,-1.384,-1.383,-1.383,-1.382,-1.382,-1.381,-1.381,-1.380, & - -1.380,-1.379,-1.378,-1.378,-1.377,-1.377,-1.376,-1.376,-1.375, & - -1.375,-1.374,-1.374 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.091,-0.189,-0.233,-0.262,-0.283,-0.299,-0.312,-0.322,-0.330, & - -0.337,-0.343,-0.347,-0.351,-0.354,-0.356,-0.358,-0.359,-0.360, & - -0.361,-0.361,-0.361,-0.360,-0.360,-0.359,-0.358,-0.356,-0.355, & - -0.354,-0.352,-0.350,-0.348,-0.346,-0.344,-0.342,-0.340,-0.337, & - -0.335,-0.332,-0.330,-0.327,-0.325,-0.322,-0.319,-0.316,-0.314, & - -0.311,-0.308,-0.305,-0.302,-0.299,-0.297,-0.294,-0.291,-0.288, & - -0.285,-0.282,-0.279,-0.276,-0.273,-0.270,-0.267,-0.263,-0.260, & - -0.257,-0.254,-0.251,-0.248,-0.245,-0.242,-0.238,-0.235,-0.232, & - -0.229,-0.225,-0.222,-0.219,-0.215,-0.212,-0.209,-0.205,-0.202, & - -0.198,-0.195,-0.191,-0.188,-0.184,-0.181,-0.177,-0.173,-0.170, & - -0.166,-0.162,-0.159,-0.155,-0.151,-0.147,-0.143,-0.140,-0.136, & - -0.132,-0.128,-0.124,-0.120,-0.116,-0.112,-0.108,-0.104,-0.100, & - -0.096,-0.091,-0.087,-0.083,-0.079,-0.075,-0.071,-0.067,-0.062, & - -0.058,-0.054,-0.050,-0.046,-0.041,-0.037,-0.033,-0.029,-0.024, & - -0.020,-0.016,-0.012,-0.008,-0.003, 0.001, 0.005, 0.009, 0.014, & - & 0.018, 0.022, 0.026, 0.031, 0.035, 0.039, 0.043, 0.047, 0.052, & - & 0.056, 0.060, 0.064, 0.069, 0.073, 0.077, 0.081, 0.085, 0.090, & - & 0.094, 0.098, 0.102, 0.106, 0.110, 0.115, 0.119, 0.123, 0.127, & - & 0.131, 0.135, 0.140, 0.144, 0.148, 0.152, 0.156, 0.160, 0.164, & - & 0.169, 0.173, 0.177, 0.181, 0.185, 0.189, 0.193, 0.197, 0.201, & - & 0.205, 0.209, 0.214, 0.218, 0.222, 0.226, 0.230, 0.234, 0.238, & - & 0.242, 0.246, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, 0.274, & - & 0.278, 0.282, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.310, & - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.333, 0.337, 0.341, 0.345, & - & 0.349, 0.353, 0.357, 0.361, 0.364, 0.368, 0.372, 0.376, 0.380, & - & 0.384, 0.388, 0.391, 0.395, 0.399, 0.403, 0.407, 0.410, 0.414, & - & 0.418, 0.422, 0.426, 0.429, 0.433, 0.437, 0.441, 0.445, 0.448, & - & 0.452, 0.456, 0.459, 0.463, 0.467, 0.471, 0.474, 0.478, 0.482, & - & 0.486, 0.489, 0.493, 0.497, 0.500, 0.504, 0.508, 0.511, 0.515, & - & 0.519, 0.522, 0.526, 0.530, 0.533, 0.537, 0.540, 0.544, 0.548, & - & 0.551, 0.555, 0.559, 0.562, 0.566, 0.569, 0.573, 0.576, 0.580, & - & 0.584, 0.587, 0.591, 0.594, 0.598, 0.601, 0.605, 0.608, 0.612, & - & 0.615, 0.619, 0.622, 0.626, 0.629, 0.633, 0.636, 0.640, 0.643, & - & 0.647, 0.650, 0.654, 0.657, 0.661, 0.664, 0.668, 0.671, 0.674, & - & 0.678, 0.681, 0.685, 0.688, 0.691, 0.695, 0.698, 0.702, 0.705, & - & 0.708, 0.712, 0.715, 0.719, 0.722, 0.725, 0.729, 0.732, 0.735, & - & 0.739, 0.742, 0.745, 0.749, 0.752, 0.755, 0.759, 0.762, 0.765, & - & 0.768, 0.772, 0.775, 0.778, 0.782, 0.785, 0.788, 0.791, 0.795, & - & 0.798, 0.801, 0.804, 0.808, 0.811, 0.814, 0.817, 0.821, 0.824, & - & 0.827, 0.830, 0.833, 0.837, 0.840, 0.843, 0.846, 0.849, 0.853, & - & 0.856, 0.859, 0.862, 0.865, 0.868, 0.872, 0.875, 0.878, 0.881, & - & 0.884, 0.887, 0.890, 0.893, 0.897, 0.900, 0.903, 0.906, 0.909, & - & 0.912, 0.915, 0.918, 0.921, 0.924, 0.928, 0.931, 0.934, 0.937, & - & 0.940, 0.943, 0.946, 0.949, 0.952, 0.955, 0.958, 0.961, 0.964, & - & 0.967, 0.970, 0.973, 0.976, 1.008, 1.038, 1.067, 1.095, 1.124, & - & 1.152, 1.179, 1.206, 1.233, 1.260, 1.286, 1.312, 1.337, 1.363, & - & 1.387, 1.412, 1.437, 1.461, 1.484, 1.508, 1.531, 1.554, 1.577, & - & 1.600, 1.622, 1.644, 1.666, 1.687, 1.709, 1.730, 1.751, 1.772, & - & 1.792, 1.812, 1.832, 1.852, 1.872, 1.892, 1.911, 1.930, 1.949, & - & 1.968, 1.987, 2.005, 2.023, 2.042, 2.060, 2.077, 2.095, 2.113, & - & 2.130, 2.147, 2.164, 2.181, 2.198, 2.215, 2.231, 2.248, 2.264, & - & 2.280, 2.296, 2.312, 2.328, 2.343, 2.359, 2.374, 2.389, 2.405, & - & 2.420, 2.435, 2.449, 2.464, 2.479, 2.493, 2.508, 2.522, 2.536, & - & 2.550, 2.564, 2.578, 2.592, 2.606, 2.619, 2.633, 2.646, 2.660, & - & 2.673, 2.686, 2.699, 2.712, 2.725, 2.738, 2.751, 2.763, 2.776, & - & 2.788, 2.801, 2.813, 2.826, 2.838, 2.850, 2.862, 2.874, 2.886, & - & 2.898, 2.910, 2.921, 2.933, 2.945, 2.956, 2.967, 2.979, 2.990, & - & 3.001, 3.013, 3.024, 3.035, 3.046, 3.057, 3.068, 3.079, 3.089, & - & 3.100, 3.111, 3.121, 3.132, 3.142, 3.153, 3.163, 3.173, 3.184, & - & 3.194, 3.204, 3.214, 3.224, 3.234, 3.244, 3.254, 3.264, 3.274, & - & 3.284, 3.293, 3.303, 3.313, 3.322, 3.332, 3.341, 3.351, 3.360, & - & 3.370, 3.379, 3.388, 3.397, 3.407, 3.416, 3.425, 3.434, 3.443, & - & 3.452, 3.461, 3.470 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.090,-0.186,-0.229,-0.256,-0.276,-0.290,-0.302,-0.310,-0.317, & - -0.322,-0.327,-0.330,-0.332,-0.333,-0.334,-0.335,-0.335,-0.334, & - -0.333,-0.332,-0.331,-0.329,-0.327,-0.325,-0.322,-0.320,-0.317, & - -0.314,-0.311,-0.308,-0.305,-0.301,-0.298,-0.294,-0.291,-0.287, & - -0.283,-0.279,-0.275,-0.272,-0.268,-0.264,-0.260,-0.255,-0.251, & - -0.247,-0.243,-0.239,-0.235,-0.231,-0.226,-0.222,-0.218,-0.214, & - -0.209,-0.205,-0.201,-0.196,-0.192,-0.188,-0.184,-0.179,-0.175, & - -0.170,-0.166,-0.162,-0.157,-0.153,-0.148,-0.144,-0.139,-0.135, & - -0.130,-0.126,-0.121,-0.117,-0.112,-0.107,-0.103,-0.098,-0.093, & - -0.089,-0.084,-0.079,-0.074,-0.069,-0.065,-0.060,-0.055,-0.050, & - -0.045,-0.040,-0.034,-0.029,-0.024,-0.019,-0.014,-0.009,-0.003, & - & 0.002, 0.007, 0.013, 0.018, 0.023, 0.029, 0.034, 0.040, 0.045, & - & 0.050, 0.056, 0.061, 0.067, 0.073, 0.078, 0.084, 0.089, 0.095, & - & 0.100, 0.106, 0.112, 0.117, 0.123, 0.128, 0.134, 0.140, 0.145, & - & 0.151, 0.157, 0.162, 0.168, 0.174, 0.179, 0.185, 0.190, 0.196, & - & 0.202, 0.207, 0.213, 0.219, 0.224, 0.230, 0.235, 0.241, 0.247, & - & 0.252, 0.258, 0.263, 0.269, 0.275, 0.280, 0.286, 0.291, 0.297, & - & 0.302, 0.308, 0.313, 0.319, 0.325, 0.330, 0.336, 0.341, 0.347, & - & 0.352, 0.358, 0.363, 0.369, 0.374, 0.380, 0.385, 0.390, 0.396, & - & 0.401, 0.407, 0.412, 0.418, 0.423, 0.428, 0.434, 0.439, 0.445, & - & 0.450, 0.455, 0.461, 0.466, 0.471, 0.477, 0.482, 0.487, 0.493, & - & 0.498, 0.503, 0.509, 0.514, 0.519, 0.525, 0.530, 0.535, 0.540, & - & 0.546, 0.551, 0.556, 0.561, 0.567, 0.572, 0.577, 0.582, 0.587, & - & 0.593, 0.598, 0.603, 0.608, 0.613, 0.618, 0.624, 0.629, 0.634, & - & 0.639, 0.644, 0.649, 0.654, 0.659, 0.664, 0.669, 0.675, 0.680, & - & 0.685, 0.690, 0.695, 0.700, 0.705, 0.710, 0.715, 0.720, 0.725, & - & 0.730, 0.735, 0.740, 0.745, 0.750, 0.755, 0.759, 0.764, 0.769, & - & 0.774, 0.779, 0.784, 0.789, 0.794, 0.799, 0.804, 0.808, 0.813, & - & 0.818, 0.823, 0.828, 0.833, 0.837, 0.842, 0.847, 0.852, 0.857, & - & 0.861, 0.866, 0.871, 0.876, 0.880, 0.885, 0.890, 0.895, 0.899, & - & 0.904, 0.909, 0.914, 0.918, 0.923, 0.928, 0.932, 0.937, 0.942, & - & 0.946, 0.951, 0.955, 0.960, 0.965, 0.969, 0.974, 0.979, 0.983, & - & 0.988, 0.992, 0.997, 1.001, 1.006, 1.011, 1.015, 1.020, 1.024, & - & 1.029, 1.033, 1.038, 1.042, 1.047, 1.051, 1.056, 1.060, 1.065, & - & 1.069, 1.073, 1.078, 1.082, 1.087, 1.091, 1.096, 1.100, 1.104, & - & 1.109, 1.113, 1.118, 1.122, 1.126, 1.131, 1.135, 1.139, 1.144, & - & 1.148, 1.152, 1.157, 1.161, 1.165, 1.170, 1.174, 1.178, 1.183, & - & 1.187, 1.191, 1.195, 1.200, 1.204, 1.208, 1.212, 1.217, 1.221, & - & 1.225, 1.229, 1.234, 1.238, 1.242, 1.246, 1.250, 1.255, 1.259, & - & 1.263, 1.267, 1.271, 1.275, 1.279, 1.284, 1.288, 1.292, 1.296, & - & 1.300, 1.304, 1.308, 1.312, 1.316, 1.321, 1.325, 1.329, 1.333, & - & 1.337, 1.341, 1.345, 1.349, 1.353, 1.357, 1.361, 1.365, 1.369, & - & 1.373, 1.377, 1.381, 1.385, 1.389, 1.393, 1.397, 1.401, 1.405, & - & 1.409, 1.413, 1.417, 1.421, 1.425, 1.428, 1.432, 1.436, 1.440, & - & 1.444, 1.448, 1.452, 1.456, 1.497, 1.535, 1.573, 1.610, 1.646, & - & 1.682, 1.717, 1.752, 1.787, 1.821, 1.854, 1.888, 1.920, 1.953, & - & 1.985, 2.016, 2.048, 2.078, 2.109, 2.139, 2.169, 2.198, 2.227, & - & 2.256, 2.285, 2.313, 2.341, 2.368, 2.395, 2.422, 2.449, 2.475, & - & 2.501, 2.527, 2.553, 2.578, 2.603, 2.628, 2.653, 2.677, 2.701, & - & 2.725, 2.749, 2.772, 2.796, 2.819, 2.841, 2.864, 2.887, 2.909, & - & 2.931, 2.953, 2.974, 2.996, 3.017, 3.038, 3.059, 3.080, 3.100, & - & 3.121, 3.141, 3.161, 3.181, 3.201, 3.221, 3.240, 3.259, 3.279, & - & 3.298, 3.317, 3.335, 3.354, 3.372, 3.391, 3.409, 3.427, 3.445, & - & 3.463, 3.480, 3.498, 3.516, 3.533, 3.550, 3.567, 3.584, 3.601, & - & 3.618, 3.634, 3.651, 3.667, 3.684, 3.700, 3.716, 3.732, 3.748, & - & 3.764, 3.779, 3.795, 3.810, 3.826, 3.841, 3.856, 3.872, 3.887, & - & 3.902, 3.916, 3.931, 3.946, 3.961, 3.975, 3.989, 4.004, 4.018, & - & 4.032, 4.046, 4.060, 4.074, 4.088, 4.102, 4.116, 4.129, 4.143, & - & 4.157, 4.170, 4.183, 4.197, 4.210, 4.223, 4.236, 4.249, 4.262, & - & 4.275, 4.288, 4.300, 4.313, 4.326, 4.338, 4.351, 4.363, 4.376, & - & 4.388, 4.400, 4.412, 4.424, 4.436, 4.449, 4.460, 4.472, 4.484, & - & 4.496, 4.508, 4.519, 4.531, 4.543, 4.554, 4.566, 4.577, 4.588, & - & 4.600, 4.611, 4.622 & - / - END - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE KM323 -! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. -! THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN -! LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY -! 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. - -! TEMPERATURE IS 323K - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE KM323 (IONIC, BINARR) - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC323/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - REAL :: Binarr (23), Ionic - -! *** Find position in arrays for bincoef - - IF (Ionic <= 0.200000E+02) THEN - ipos = MIN(NINT( 0.200000E+02*Ionic) + 1, 400) - ELSE - ipos = 400+NINT( 0.200000E+01*Ionic- 0.400000E+02) - ENDIF - ipos = min(ipos, 561) - -! *** Assign values to return array - - Binarr(01) = BNC01M(ipos) - Binarr(02) = BNC02M(ipos) - Binarr(03) = BNC03M(ipos) - Binarr(04) = BNC04M(ipos) - Binarr(05) = BNC05M(ipos) - Binarr(06) = BNC06M(ipos) - Binarr(07) = BNC07M(ipos) - Binarr(08) = BNC08M(ipos) - Binarr(09) = BNC09M(ipos) - Binarr(10) = BNC10M(ipos) - Binarr(11) = BNC11M(ipos) - Binarr(12) = BNC12M(ipos) - Binarr(13) = BNC13M(ipos) - Binarr(14) = BNC14M(ipos) - Binarr(15) = BNC15M(ipos) - Binarr(16) = BNC16M(ipos) - Binarr(17) = BNC17M(ipos) - Binarr(18) = BNC18M(ipos) - Binarr(19) = BNC19M(ipos) - Binarr(20) = BNC20M(ipos) - Binarr(21) = BNC21M(ipos) - Binarr(22) = BNC22M(ipos) - Binarr(23) = BNC23M(ipos) - -! *** Return point ; End of subroutine - - RETURN - END SUBROUTINE KM323 - - - BLOCK DATA KMCF323 - -! *** Common block definition - - IMPLICIT real (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON /KMC323/ & - BNC01M( 561),BNC02M( 561),BNC03M( 561),BNC04M( 561), & - BNC05M( 561),BNC06M( 561),BNC07M( 561),BNC08M( 561), & - BNC09M( 561),BNC10M( 561),BNC11M( 561),BNC12M( 561), & - BNC13M( 561),BNC14M( 561),BNC15M( 561),BNC16M( 561), & - BNC17M( 561),BNC18M( 561),BNC19M( 561),BNC20M( 561), & - BNC21M( 561),BNC22M( 561),BNC23M( 561) - - -! *** NaCl - - DATA BNC01M/ & - -0.044,-0.092,-0.114,-0.129,-0.139,-0.147,-0.154,-0.159,-0.163, & - -0.167,-0.170,-0.172,-0.174,-0.176,-0.177,-0.178,-0.179,-0.180, & - -0.180,-0.181,-0.181,-0.181,-0.181,-0.180,-0.180,-0.180,-0.179, & - -0.179,-0.178,-0.177,-0.177,-0.176,-0.175,-0.174,-0.173,-0.172, & - -0.171,-0.170,-0.169,-0.168,-0.167,-0.166,-0.165,-0.163,-0.162, & - -0.161,-0.160,-0.159,-0.157,-0.156,-0.155,-0.153,-0.152,-0.151, & - -0.150,-0.148,-0.147,-0.146,-0.144,-0.143,-0.142,-0.140,-0.139, & - -0.137,-0.136,-0.135,-0.133,-0.132,-0.130,-0.129,-0.127,-0.126, & - -0.125,-0.123,-0.122,-0.120,-0.119,-0.117,-0.116,-0.114,-0.113, & - -0.111,-0.109,-0.108,-0.106,-0.105,-0.103,-0.101,-0.100,-0.098, & - -0.096,-0.095,-0.093,-0.091,-0.090,-0.088,-0.086,-0.084,-0.083, & - -0.081,-0.079,-0.077,-0.076,-0.074,-0.072,-0.070,-0.068,-0.066, & - -0.065,-0.063,-0.061,-0.059,-0.057,-0.055,-0.053,-0.052,-0.050, & - -0.048,-0.046,-0.044,-0.042,-0.040,-0.038,-0.036,-0.035,-0.033, & - -0.031,-0.029,-0.027,-0.025,-0.023,-0.021,-0.019,-0.017,-0.015, & - -0.013,-0.012,-0.010,-0.008,-0.006,-0.004,-0.002, 0.000, 0.002, & - & 0.004, 0.006, 0.008, 0.009, 0.011, 0.013, 0.015, 0.017, 0.019, & - & 0.021, 0.023, 0.025, 0.027, 0.028, 0.030, 0.032, 0.034, 0.036, & - & 0.038, 0.040, 0.042, 0.044, 0.045, 0.047, 0.049, 0.051, 0.053, & - & 0.055, 0.057, 0.059, 0.060, 0.062, 0.064, 0.066, 0.068, 0.070, & - & 0.072, 0.074, 0.075, 0.077, 0.079, 0.081, 0.083, 0.085, 0.086, & - & 0.088, 0.090, 0.092, 0.094, 0.096, 0.097, 0.099, 0.101, 0.103, & - & 0.105, 0.107, 0.108, 0.110, 0.112, 0.114, 0.116, 0.117, 0.119, & - & 0.121, 0.123, 0.125, 0.127, 0.128, 0.130, 0.132, 0.134, 0.135, & - & 0.137, 0.139, 0.141, 0.143, 0.144, 0.146, 0.148, 0.150, 0.151, & - & 0.153, 0.155, 0.157, 0.159, 0.160, 0.162, 0.164, 0.166, 0.167, & - & 0.169, 0.171, 0.173, 0.174, 0.176, 0.178, 0.180, 0.181, 0.183, & - & 0.185, 0.186, 0.188, 0.190, 0.192, 0.193, 0.195, 0.197, 0.198, & - & 0.200, 0.202, 0.204, 0.205, 0.207, 0.209, 0.210, 0.212, 0.214, & - & 0.215, 0.217, 0.219, 0.221, 0.222, 0.224, 0.226, 0.227, 0.229, & - & 0.231, 0.232, 0.234, 0.236, 0.237, 0.239, 0.241, 0.242, 0.244, & - & 0.246, 0.247, 0.249, 0.250, 0.252, 0.254, 0.255, 0.257, 0.259, & - & 0.260, 0.262, 0.264, 0.265, 0.267, 0.268, 0.270, 0.272, 0.273, & - & 0.275, 0.276, 0.278, 0.280, 0.281, 0.283, 0.285, 0.286, 0.288, & - & 0.289, 0.291, 0.293, 0.294, 0.296, 0.297, 0.299, 0.300, 0.302, & - & 0.304, 0.305, 0.307, 0.308, 0.310, 0.311, 0.313, 0.315, 0.316, & - & 0.318, 0.319, 0.321, 0.322, 0.324, 0.325, 0.327, 0.329, 0.330, & - & 0.332, 0.333, 0.335, 0.336, 0.338, 0.339, 0.341, 0.342, 0.344, & - & 0.345, 0.347, 0.349, 0.350, 0.352, 0.353, 0.355, 0.356, 0.358, & - & 0.359, 0.361, 0.362, 0.364, 0.365, 0.367, 0.368, 0.370, 0.371, & - & 0.373, 0.374, 0.376, 0.377, 0.379, 0.380, 0.382, 0.383, 0.384, & - & 0.386, 0.387, 0.389, 0.390, 0.392, 0.393, 0.395, 0.396, 0.398, & - & 0.399, 0.401, 0.402, 0.404, 0.405, 0.406, 0.408, 0.409, 0.411, & - & 0.412, 0.414, 0.415, 0.417, 0.418, 0.419, 0.421, 0.422, 0.424, & - & 0.425, 0.427, 0.428, 0.429, 0.445, 0.459, 0.472, 0.486, 0.499, & - & 0.513, 0.526, 0.539, 0.552, 0.565, 0.577, 0.590, 0.602, 0.614, & - & 0.626, 0.638, 0.650, 0.662, 0.674, 0.685, 0.697, 0.708, 0.719, & - & 0.730, 0.741, 0.752, 0.763, 0.773, 0.784, 0.795, 0.805, 0.815, & - & 0.825, 0.836, 0.846, 0.856, 0.866, 0.875, 0.885, 0.895, 0.904, & - & 0.914, 0.923, 0.933, 0.942, 0.951, 0.960, 0.969, 0.979, 0.987, & - & 0.996, 1.005, 1.014, 1.023, 1.031, 1.040, 1.049, 1.057, 1.065, & - & 1.074, 1.082, 1.090, 1.099, 1.107, 1.115, 1.123, 1.131, 1.139, & - & 1.147, 1.155, 1.163, 1.170, 1.178, 1.186, 1.193, 1.201, 1.209, & - & 1.216, 1.224, 1.231, 1.238, 1.246, 1.253, 1.260, 1.267, 1.275, & - & 1.282, 1.289, 1.296, 1.303, 1.310, 1.317, 1.324, 1.331, 1.338, & - & 1.345, 1.351, 1.358, 1.365, 1.372, 1.378, 1.385, 1.392, 1.398, & - & 1.405, 1.411, 1.418, 1.424, 1.431, 1.437, 1.443, 1.450, 1.456, & - & 1.462, 1.469, 1.475, 1.481, 1.487, 1.493, 1.500, 1.506, 1.512, & - & 1.518, 1.524, 1.530, 1.536, 1.542, 1.548, 1.554, 1.560, 1.565, & - & 1.571, 1.577, 1.583, 1.589, 1.594, 1.600, 1.606, 1.612, 1.617, & - & 1.623, 1.629, 1.634, 1.640, 1.645, 1.651, 1.656, 1.662, 1.667, & - & 1.673, 1.678, 1.684, 1.689, 1.695, 1.700, 1.705, 1.711, 1.716, & - & 1.721, 1.727, 1.732 & - / - -! *** Na2SO4 - - DATA BNC02M/ & - -0.091,-0.196,-0.249,-0.285,-0.314,-0.337,-0.358,-0.375,-0.390, & - -0.404,-0.417,-0.428,-0.439,-0.449,-0.458,-0.466,-0.475,-0.482, & - -0.489,-0.496,-0.502,-0.508,-0.514,-0.520,-0.525,-0.530,-0.535, & - -0.540,-0.544,-0.549,-0.553,-0.557,-0.561,-0.565,-0.569,-0.572, & - -0.576,-0.579,-0.582,-0.585,-0.588,-0.591,-0.594,-0.597,-0.600, & - -0.603,-0.605,-0.608,-0.610,-0.613,-0.615,-0.617,-0.620,-0.622, & - -0.624,-0.626,-0.628,-0.630,-0.632,-0.634,-0.636,-0.638,-0.640, & - -0.641,-0.643,-0.645,-0.647,-0.648,-0.650,-0.651,-0.653,-0.654, & - -0.656,-0.657,-0.659,-0.660,-0.662,-0.663,-0.665,-0.666,-0.667, & - -0.669,-0.670,-0.671,-0.672,-0.674,-0.675,-0.676,-0.677,-0.678, & - -0.679,-0.681,-0.682,-0.683,-0.684,-0.685,-0.686,-0.687,-0.688, & - -0.689,-0.690,-0.691,-0.692,-0.693,-0.694,-0.695,-0.696,-0.697, & - -0.698,-0.699,-0.700,-0.701,-0.701,-0.702,-0.703,-0.704,-0.705, & - -0.706,-0.706,-0.707,-0.708,-0.709,-0.710,-0.710,-0.711,-0.712, & - -0.713,-0.713,-0.714,-0.715,-0.716,-0.716,-0.717,-0.718,-0.718, & - -0.719,-0.720,-0.720,-0.721,-0.722,-0.722,-0.723,-0.724,-0.724, & - -0.725,-0.725,-0.726,-0.727,-0.727,-0.728,-0.728,-0.729,-0.730, & - -0.730,-0.731,-0.731,-0.732,-0.732,-0.733,-0.733,-0.734,-0.734, & - -0.735,-0.735,-0.736,-0.736,-0.737,-0.737,-0.738,-0.738,-0.739, & - -0.739,-0.740,-0.740,-0.741,-0.741,-0.742,-0.742,-0.742,-0.743, & - -0.743,-0.744,-0.744,-0.745,-0.745,-0.745,-0.746,-0.746,-0.747, & - -0.747,-0.747,-0.748,-0.748,-0.748,-0.749,-0.749,-0.750,-0.750, & - -0.750,-0.751,-0.751,-0.751,-0.752,-0.752,-0.752,-0.753,-0.753, & - -0.753,-0.754,-0.754,-0.754,-0.755,-0.755,-0.755,-0.755,-0.756, & - -0.756,-0.756,-0.757,-0.757,-0.757,-0.758,-0.758,-0.758,-0.758, & - -0.759,-0.759,-0.759,-0.759,-0.760,-0.760,-0.760,-0.760,-0.761, & - -0.761,-0.761,-0.761,-0.762,-0.762,-0.762,-0.762,-0.763,-0.763, & - -0.763,-0.763,-0.764,-0.764,-0.764,-0.764,-0.764,-0.765,-0.765, & - -0.765,-0.765,-0.765,-0.766,-0.766,-0.766,-0.766,-0.766,-0.767, & - -0.767,-0.767,-0.767,-0.767,-0.768,-0.768,-0.768,-0.768,-0.768, & - -0.768,-0.769,-0.769,-0.769,-0.769,-0.769,-0.769,-0.770,-0.770, & - -0.770,-0.770,-0.770,-0.770,-0.771,-0.771,-0.771,-0.771,-0.771, & - -0.771,-0.771,-0.771,-0.772,-0.772,-0.772,-0.772,-0.772,-0.772, & - -0.772,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773,-0.773, & - -0.773,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774,-0.774, & - -0.774,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775,-0.775, & - -0.775,-0.775,-0.775,-0.775,-0.776,-0.776,-0.776,-0.776,-0.776, & - -0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.776,-0.777, & - -0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777, & - -0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.777,-0.778, & - -0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, & - -0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, & - -0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778, & - -0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.778,-0.779,-0.779, & - -0.779,-0.779,-0.779,-0.779,-0.779,-0.779,-0.778,-0.778,-0.778, & - -0.778,-0.777,-0.777,-0.776,-0.776,-0.775,-0.774,-0.774,-0.773, & - -0.772,-0.771,-0.770,-0.769,-0.768,-0.767,-0.766,-0.765,-0.764, & - -0.763,-0.762,-0.760,-0.759,-0.758,-0.756,-0.755,-0.754,-0.752, & - -0.751,-0.749,-0.748,-0.746,-0.745,-0.743,-0.742,-0.740,-0.739, & - -0.737,-0.735,-0.734,-0.732,-0.730,-0.729,-0.727,-0.725,-0.723, & - -0.722,-0.720,-0.718,-0.716,-0.714,-0.713,-0.711,-0.709,-0.707, & - -0.705,-0.703,-0.701,-0.699,-0.697,-0.695,-0.693,-0.691,-0.690, & - -0.688,-0.686,-0.683,-0.681,-0.679,-0.677,-0.675,-0.673,-0.671, & - -0.669,-0.667,-0.665,-0.663,-0.661,-0.659,-0.656,-0.654,-0.652, & - -0.650,-0.648,-0.646,-0.644,-0.641,-0.639,-0.637,-0.635,-0.633, & - -0.630,-0.628,-0.626,-0.624,-0.621,-0.619,-0.617,-0.615,-0.612, & - -0.610,-0.608,-0.606,-0.603,-0.601,-0.599,-0.597,-0.594,-0.592, & - -0.590,-0.587,-0.585,-0.583,-0.580,-0.578,-0.576,-0.573,-0.571, & - -0.569,-0.566,-0.564,-0.562,-0.559,-0.557,-0.555,-0.552,-0.550, & - -0.547,-0.545,-0.543,-0.540,-0.538,-0.536,-0.533,-0.531,-0.528, & - -0.526,-0.524,-0.521,-0.519,-0.516,-0.514,-0.511,-0.509,-0.507, & - -0.504,-0.502,-0.499,-0.497,-0.494,-0.492,-0.490,-0.487,-0.485, & - -0.482,-0.480,-0.477 & - / - -! *** NaNO3 - - DATA BNC03M/ & - -0.045,-0.099,-0.125,-0.144,-0.159,-0.171,-0.181,-0.190,-0.198, & - -0.206,-0.212,-0.218,-0.224,-0.229,-0.234,-0.239,-0.243,-0.247, & - -0.251,-0.255,-0.258,-0.261,-0.265,-0.268,-0.271,-0.274,-0.276, & - -0.279,-0.281,-0.284,-0.286,-0.289,-0.291,-0.293,-0.295,-0.297, & - -0.299,-0.301,-0.303,-0.305,-0.306,-0.308,-0.310,-0.312,-0.313, & - -0.315,-0.316,-0.318,-0.319,-0.321,-0.322,-0.323,-0.325,-0.326, & - -0.327,-0.329,-0.330,-0.331,-0.332,-0.333,-0.335,-0.336,-0.337, & - -0.338,-0.339,-0.340,-0.341,-0.342,-0.343,-0.344,-0.345,-0.346, & - -0.347,-0.348,-0.349,-0.350,-0.350,-0.351,-0.352,-0.353,-0.354, & - -0.355,-0.356,-0.356,-0.357,-0.358,-0.359,-0.359,-0.360,-0.361, & - -0.362,-0.363,-0.363,-0.364,-0.365,-0.365,-0.366,-0.367,-0.368, & - -0.368,-0.369,-0.370,-0.370,-0.371,-0.372,-0.372,-0.373,-0.374, & - -0.374,-0.375,-0.375,-0.376,-0.377,-0.377,-0.378,-0.378,-0.379, & - -0.380,-0.380,-0.381,-0.381,-0.382,-0.383,-0.383,-0.384,-0.384, & - -0.385,-0.385,-0.386,-0.386,-0.387,-0.387,-0.388,-0.388,-0.389, & - -0.389,-0.390,-0.390,-0.391,-0.391,-0.392,-0.392,-0.393,-0.393, & - -0.394,-0.394,-0.395,-0.395,-0.396,-0.396,-0.397,-0.397,-0.397, & - -0.398,-0.398,-0.399,-0.399,-0.400,-0.400,-0.400,-0.401,-0.401, & - -0.402,-0.402,-0.402,-0.403,-0.403,-0.404,-0.404,-0.404,-0.405, & - -0.405,-0.406,-0.406,-0.406,-0.407,-0.407,-0.407,-0.408,-0.408, & - -0.408,-0.409,-0.409,-0.409,-0.410,-0.410,-0.411,-0.411,-0.411, & - -0.412,-0.412,-0.412,-0.413,-0.413,-0.413,-0.413,-0.414,-0.414, & - -0.414,-0.415,-0.415,-0.415,-0.416,-0.416,-0.416,-0.417,-0.417, & - -0.417,-0.417,-0.418,-0.418,-0.418,-0.419,-0.419,-0.419,-0.419, & - -0.420,-0.420,-0.420,-0.421,-0.421,-0.421,-0.421,-0.422,-0.422, & - -0.422,-0.422,-0.423,-0.423,-0.423,-0.423,-0.424,-0.424,-0.424, & - -0.424,-0.425,-0.425,-0.425,-0.425,-0.426,-0.426,-0.426,-0.426, & - -0.427,-0.427,-0.427,-0.427,-0.428,-0.428,-0.428,-0.428,-0.428, & - -0.429,-0.429,-0.429,-0.429,-0.430,-0.430,-0.430,-0.430,-0.430, & - -0.431,-0.431,-0.431,-0.431,-0.431,-0.432,-0.432,-0.432,-0.432, & - -0.432,-0.433,-0.433,-0.433,-0.433,-0.433,-0.434,-0.434,-0.434, & - -0.434,-0.434,-0.435,-0.435,-0.435,-0.435,-0.435,-0.435,-0.436, & - -0.436,-0.436,-0.436,-0.436,-0.436,-0.437,-0.437,-0.437,-0.437, & - -0.437,-0.438,-0.438,-0.438,-0.438,-0.438,-0.438,-0.438,-0.439, & - -0.439,-0.439,-0.439,-0.439,-0.439,-0.440,-0.440,-0.440,-0.440, & - -0.440,-0.440,-0.440,-0.441,-0.441,-0.441,-0.441,-0.441,-0.441, & - -0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.442,-0.443, & - -0.443,-0.443,-0.443,-0.443,-0.443,-0.443,-0.444,-0.444,-0.444, & - -0.444,-0.444,-0.444,-0.444,-0.444,-0.445,-0.445,-0.445,-0.445, & - -0.445,-0.445,-0.445,-0.445,-0.446,-0.446,-0.446,-0.446,-0.446, & - -0.446,-0.446,-0.446,-0.446,-0.447,-0.447,-0.447,-0.447,-0.447, & - -0.447,-0.447,-0.447,-0.447,-0.447,-0.448,-0.448,-0.448,-0.448, & - -0.448,-0.448,-0.448,-0.448,-0.448,-0.449,-0.449,-0.449,-0.449, & - -0.449,-0.449,-0.449,-0.449,-0.449,-0.449,-0.449,-0.450,-0.450, & - -0.450,-0.450,-0.450,-0.450,-0.451,-0.452,-0.452,-0.453,-0.454, & - -0.454,-0.455,-0.455,-0.456,-0.456,-0.457,-0.457,-0.457,-0.458, & - -0.458,-0.458,-0.458,-0.458,-0.458,-0.458,-0.459,-0.459,-0.459, & - -0.459,-0.459,-0.458,-0.458,-0.458,-0.458,-0.458,-0.458,-0.458, & - -0.457,-0.457,-0.457,-0.457,-0.456,-0.456,-0.456,-0.455,-0.455, & - -0.455,-0.454,-0.454,-0.453,-0.453,-0.453,-0.452,-0.452,-0.451, & - -0.451,-0.450,-0.450,-0.449,-0.449,-0.448,-0.448,-0.447,-0.446, & - -0.446,-0.445,-0.445,-0.444,-0.443,-0.443,-0.442,-0.442,-0.441, & - -0.440,-0.440,-0.439,-0.438,-0.437,-0.437,-0.436,-0.435,-0.435, & - -0.434,-0.433,-0.432,-0.432,-0.431,-0.430,-0.429,-0.429,-0.428, & - -0.427,-0.426,-0.425,-0.425,-0.424,-0.423,-0.422,-0.421,-0.420, & - -0.420,-0.419,-0.418,-0.417,-0.416,-0.415,-0.414,-0.414,-0.413, & - -0.412,-0.411,-0.410,-0.409,-0.408,-0.407,-0.406,-0.405,-0.404, & - -0.404,-0.403,-0.402,-0.401,-0.400,-0.399,-0.398,-0.397,-0.396, & - -0.395,-0.394,-0.393,-0.392,-0.391,-0.390,-0.389,-0.388,-0.387, & - -0.386,-0.385,-0.384,-0.383,-0.382,-0.381,-0.380,-0.379,-0.378, & - -0.377,-0.376,-0.375,-0.374,-0.373,-0.372,-0.371,-0.370,-0.369, & - -0.368,-0.367,-0.366,-0.365,-0.364,-0.363,-0.362,-0.361,-0.360, & - -0.359,-0.358,-0.356 & - / - -! *** (NH4)2SO4 - - DATA BNC04M/ & - -0.091,-0.197,-0.249,-0.286,-0.315,-0.339,-0.359,-0.377,-0.392, & - -0.406,-0.419,-0.431,-0.442,-0.452,-0.461,-0.470,-0.478,-0.486, & - -0.493,-0.500,-0.507,-0.513,-0.519,-0.525,-0.530,-0.535,-0.540, & - -0.545,-0.550,-0.554,-0.559,-0.563,-0.567,-0.571,-0.575,-0.579, & - -0.582,-0.586,-0.589,-0.592,-0.596,-0.599,-0.602,-0.605,-0.608, & - -0.611,-0.613,-0.616,-0.619,-0.621,-0.624,-0.626,-0.628,-0.631, & - -0.633,-0.635,-0.637,-0.640,-0.642,-0.644,-0.646,-0.648,-0.650, & - -0.652,-0.653,-0.655,-0.657,-0.659,-0.661,-0.662,-0.664,-0.666, & - -0.667,-0.669,-0.670,-0.672,-0.673,-0.675,-0.676,-0.678,-0.679, & - -0.681,-0.682,-0.683,-0.685,-0.686,-0.687,-0.689,-0.690,-0.691, & - -0.693,-0.694,-0.695,-0.696,-0.697,-0.699,-0.700,-0.701,-0.702, & - -0.703,-0.704,-0.705,-0.707,-0.708,-0.709,-0.710,-0.711,-0.712, & - -0.713,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719,-0.720,-0.721, & - -0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, & - -0.730,-0.731,-0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736, & - -0.737,-0.738,-0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743, & - -0.744,-0.744,-0.745,-0.746,-0.746,-0.747,-0.748,-0.748,-0.749, & - -0.750,-0.750,-0.751,-0.752,-0.752,-0.753,-0.754,-0.754,-0.755, & - -0.755,-0.756,-0.757,-0.757,-0.758,-0.758,-0.759,-0.759,-0.760, & - -0.761,-0.761,-0.762,-0.762,-0.763,-0.763,-0.764,-0.764,-0.765, & - -0.765,-0.766,-0.766,-0.767,-0.767,-0.768,-0.768,-0.769,-0.769, & - -0.770,-0.770,-0.771,-0.771,-0.772,-0.772,-0.772,-0.773,-0.773, & - -0.774,-0.774,-0.775,-0.775,-0.776,-0.776,-0.776,-0.777,-0.777, & - -0.778,-0.778,-0.778,-0.779,-0.779,-0.780,-0.780,-0.780,-0.781, & - -0.781,-0.781,-0.782,-0.782,-0.783,-0.783,-0.783,-0.784,-0.784, & - -0.784,-0.785,-0.785,-0.785,-0.786,-0.786,-0.786,-0.787,-0.787, & - -0.787,-0.788,-0.788,-0.788,-0.789,-0.789,-0.789,-0.790,-0.790, & - -0.790,-0.790,-0.791,-0.791,-0.791,-0.792,-0.792,-0.792,-0.793, & - -0.793,-0.793,-0.793,-0.794,-0.794,-0.794,-0.794,-0.795,-0.795, & - -0.795,-0.795,-0.796,-0.796,-0.796,-0.796,-0.797,-0.797,-0.797, & - -0.797,-0.798,-0.798,-0.798,-0.798,-0.799,-0.799,-0.799,-0.799, & - -0.800,-0.800,-0.800,-0.800,-0.800,-0.801,-0.801,-0.801,-0.801, & - -0.801,-0.802,-0.802,-0.802,-0.802,-0.802,-0.803,-0.803,-0.803, & - -0.803,-0.803,-0.804,-0.804,-0.804,-0.804,-0.804,-0.804,-0.805, & - -0.805,-0.805,-0.805,-0.805,-0.806,-0.806,-0.806,-0.806,-0.806, & - -0.806,-0.806,-0.807,-0.807,-0.807,-0.807,-0.807,-0.807,-0.808, & - -0.808,-0.808,-0.808,-0.808,-0.808,-0.808,-0.809,-0.809,-0.809, & - -0.809,-0.809,-0.809,-0.809,-0.810,-0.810,-0.810,-0.810,-0.810, & - -0.810,-0.810,-0.810,-0.810,-0.811,-0.811,-0.811,-0.811,-0.811, & - -0.811,-0.811,-0.811,-0.812,-0.812,-0.812,-0.812,-0.812,-0.812, & - -0.812,-0.812,-0.812,-0.812,-0.813,-0.813,-0.813,-0.813,-0.813, & - -0.813,-0.813,-0.813,-0.813,-0.813,-0.813,-0.814,-0.814,-0.814, & - -0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814, & - -0.814,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815, & - -0.815,-0.815,-0.815,-0.815,-0.816,-0.816,-0.817,-0.817,-0.817, & - -0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.816,-0.816, & - -0.816,-0.815,-0.815,-0.814,-0.813,-0.813,-0.812,-0.811,-0.811, & - -0.810,-0.809,-0.808,-0.807,-0.806,-0.805,-0.804,-0.803,-0.802, & - -0.801,-0.800,-0.799,-0.797,-0.796,-0.795,-0.794,-0.792,-0.791, & - -0.790,-0.788,-0.787,-0.786,-0.784,-0.783,-0.781,-0.780,-0.778, & - -0.777,-0.775,-0.774,-0.772,-0.771,-0.769,-0.767,-0.766,-0.764, & - -0.762,-0.761,-0.759,-0.757,-0.756,-0.754,-0.752,-0.750,-0.749, & - -0.747,-0.745,-0.743,-0.741,-0.740,-0.738,-0.736,-0.734,-0.732, & - -0.730,-0.728,-0.727,-0.725,-0.723,-0.721,-0.719,-0.717,-0.715, & - -0.713,-0.711,-0.709,-0.707,-0.705,-0.703,-0.701,-0.699,-0.697, & - -0.695,-0.693,-0.691,-0.689,-0.687,-0.685,-0.683,-0.681,-0.678, & - -0.676,-0.674,-0.672,-0.670,-0.668,-0.666,-0.664,-0.661,-0.659, & - -0.657,-0.655,-0.653,-0.651,-0.648,-0.646,-0.644,-0.642,-0.640, & - -0.638,-0.635,-0.633,-0.631,-0.629,-0.626,-0.624,-0.622,-0.620, & - -0.618,-0.615,-0.613,-0.611,-0.609,-0.606,-0.604,-0.602,-0.599, & - -0.597,-0.595,-0.593,-0.590,-0.588,-0.586,-0.583,-0.581,-0.579, & - -0.577,-0.574,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558, & - -0.556,-0.553,-0.551 & - / - -! *** NH4NO3 - - DATA BNC05M/ & - -0.046,-0.101,-0.129,-0.149,-0.166,-0.179,-0.191,-0.202,-0.211, & - -0.220,-0.228,-0.235,-0.242,-0.249,-0.255,-0.261,-0.266,-0.272, & - -0.277,-0.282,-0.286,-0.291,-0.295,-0.299,-0.303,-0.307,-0.311, & - -0.315,-0.319,-0.322,-0.326,-0.329,-0.332,-0.335,-0.339,-0.342, & - -0.345,-0.348,-0.350,-0.353,-0.356,-0.359,-0.361,-0.364,-0.366, & - -0.369,-0.371,-0.374,-0.376,-0.378,-0.380,-0.383,-0.385,-0.387, & - -0.389,-0.391,-0.393,-0.395,-0.397,-0.399,-0.401,-0.403,-0.405, & - -0.406,-0.408,-0.410,-0.412,-0.414,-0.415,-0.417,-0.419,-0.420, & - -0.422,-0.424,-0.425,-0.427,-0.428,-0.430,-0.432,-0.433,-0.435, & - -0.436,-0.438,-0.439,-0.441,-0.442,-0.444,-0.445,-0.447,-0.448, & - -0.449,-0.451,-0.452,-0.454,-0.455,-0.456,-0.458,-0.459,-0.461, & - -0.462,-0.463,-0.465,-0.466,-0.467,-0.469,-0.470,-0.471,-0.473, & - -0.474,-0.475,-0.477,-0.478,-0.479,-0.480,-0.482,-0.483,-0.484, & - -0.485,-0.487,-0.488,-0.489,-0.490,-0.492,-0.493,-0.494,-0.495, & - -0.496,-0.498,-0.499,-0.500,-0.501,-0.502,-0.503,-0.504,-0.506, & - -0.507,-0.508,-0.509,-0.510,-0.511,-0.512,-0.513,-0.514,-0.515, & - -0.516,-0.517,-0.519,-0.520,-0.521,-0.522,-0.523,-0.524,-0.525, & - -0.526,-0.527,-0.528,-0.529,-0.530,-0.531,-0.532,-0.533,-0.534, & - -0.535,-0.535,-0.536,-0.537,-0.538,-0.539,-0.540,-0.541,-0.542, & - -0.543,-0.544,-0.545,-0.546,-0.547,-0.547,-0.548,-0.549,-0.550, & - -0.551,-0.552,-0.553,-0.553,-0.554,-0.555,-0.556,-0.557,-0.558, & - -0.559,-0.559,-0.560,-0.561,-0.562,-0.563,-0.563,-0.564,-0.565, & - -0.566,-0.567,-0.567,-0.568,-0.569,-0.570,-0.570,-0.571,-0.572, & - -0.573,-0.574,-0.574,-0.575,-0.576,-0.576,-0.577,-0.578,-0.579, & - -0.579,-0.580,-0.581,-0.582,-0.582,-0.583,-0.584,-0.584,-0.585, & - -0.586,-0.586,-0.587,-0.588,-0.589,-0.589,-0.590,-0.591,-0.591, & - -0.592,-0.593,-0.593,-0.594,-0.595,-0.595,-0.596,-0.596,-0.597, & - -0.598,-0.598,-0.599,-0.600,-0.600,-0.601,-0.602,-0.602,-0.603, & - -0.603,-0.604,-0.605,-0.605,-0.606,-0.606,-0.607,-0.608,-0.608, & - -0.609,-0.609,-0.610,-0.611,-0.611,-0.612,-0.612,-0.613,-0.613, & - -0.614,-0.615,-0.615,-0.616,-0.616,-0.617,-0.617,-0.618,-0.618, & - -0.619,-0.620,-0.620,-0.621,-0.621,-0.622,-0.622,-0.623,-0.623, & - -0.624,-0.624,-0.625,-0.625,-0.626,-0.626,-0.627,-0.627,-0.628, & - -0.628,-0.629,-0.629,-0.630,-0.630,-0.631,-0.631,-0.632,-0.632, & - -0.633,-0.633,-0.634,-0.634,-0.635,-0.635,-0.636,-0.636,-0.637, & - -0.637,-0.638,-0.638,-0.639,-0.639,-0.639,-0.640,-0.640,-0.641, & - -0.641,-0.642,-0.642,-0.643,-0.643,-0.643,-0.644,-0.644,-0.645, & - -0.645,-0.646,-0.646,-0.647,-0.647,-0.647,-0.648,-0.648,-0.649, & - -0.649,-0.649,-0.650,-0.650,-0.651,-0.651,-0.652,-0.652,-0.652, & - -0.653,-0.653,-0.654,-0.654,-0.654,-0.655,-0.655,-0.656,-0.656, & - -0.656,-0.657,-0.657,-0.658,-0.658,-0.658,-0.659,-0.659,-0.659, & - -0.660,-0.660,-0.661,-0.661,-0.661,-0.662,-0.662,-0.662,-0.663, & - -0.663,-0.663,-0.664,-0.664,-0.665,-0.665,-0.665,-0.666,-0.666, & - -0.666,-0.667,-0.667,-0.667,-0.668,-0.668,-0.668,-0.669,-0.669, & - -0.669,-0.670,-0.670,-0.670,-0.674,-0.677,-0.680,-0.683,-0.686, & - -0.688,-0.691,-0.693,-0.696,-0.698,-0.700,-0.702,-0.705,-0.706, & - -0.708,-0.710,-0.712,-0.714,-0.715,-0.717,-0.718,-0.720,-0.721, & - -0.722,-0.723,-0.725,-0.726,-0.727,-0.728,-0.729,-0.730,-0.731, & - -0.732,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736,-0.736,-0.737, & - -0.737,-0.738,-0.738,-0.739,-0.739,-0.739,-0.740,-0.740,-0.740, & - -0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741, & - -0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741,-0.741, & - -0.741,-0.740,-0.740,-0.740,-0.740,-0.739,-0.739,-0.739,-0.739, & - -0.738,-0.738,-0.738,-0.737,-0.737,-0.736,-0.736,-0.736,-0.735, & - -0.735,-0.734,-0.734,-0.733,-0.733,-0.732,-0.732,-0.731,-0.731, & - -0.730,-0.729,-0.729,-0.728,-0.728,-0.727,-0.726,-0.726,-0.725, & - -0.725,-0.724,-0.723,-0.723,-0.722,-0.721,-0.721,-0.720,-0.719, & - -0.718,-0.718,-0.717,-0.716,-0.715,-0.715,-0.714,-0.713,-0.712, & - -0.711,-0.711,-0.710,-0.709,-0.708,-0.707,-0.707,-0.706,-0.705, & - -0.704,-0.703,-0.702,-0.701,-0.701,-0.700,-0.699,-0.698,-0.697, & - -0.696,-0.695,-0.694,-0.693,-0.692,-0.692,-0.691,-0.690,-0.689, & - -0.688,-0.687,-0.686,-0.685,-0.684,-0.683,-0.682,-0.681,-0.680, & - -0.679,-0.678,-0.677 & - / - -! *** NH4Cl - - DATA BNC06M/ & - -0.045,-0.096,-0.120,-0.136,-0.149,-0.159,-0.167,-0.174,-0.181, & - -0.186,-0.191,-0.195,-0.199,-0.202,-0.205,-0.208,-0.210,-0.213, & - -0.215,-0.217,-0.219,-0.220,-0.222,-0.223,-0.225,-0.226,-0.227, & - -0.228,-0.229,-0.230,-0.231,-0.232,-0.232,-0.233,-0.234,-0.234, & - -0.235,-0.235,-0.236,-0.236,-0.237,-0.237,-0.237,-0.238,-0.238, & - -0.238,-0.238,-0.238,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239, & - -0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239, & - -0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.239,-0.238,-0.238, & - -0.238,-0.238,-0.238,-0.238,-0.237,-0.237,-0.237,-0.237,-0.237, & - -0.236,-0.236,-0.236,-0.235,-0.235,-0.235,-0.235,-0.234,-0.234, & - -0.234,-0.233,-0.233,-0.233,-0.232,-0.232,-0.231,-0.231,-0.231, & - -0.230,-0.230,-0.229,-0.229,-0.229,-0.228,-0.228,-0.227,-0.227, & - -0.226,-0.226,-0.225,-0.225,-0.224,-0.224,-0.224,-0.223,-0.223, & - -0.222,-0.222,-0.221,-0.221,-0.220,-0.219,-0.219,-0.218,-0.218, & - -0.217,-0.217,-0.216,-0.216,-0.215,-0.215,-0.214,-0.214,-0.213, & - -0.213,-0.212,-0.211,-0.211,-0.210,-0.210,-0.209,-0.209,-0.208, & - -0.208,-0.207,-0.206,-0.206,-0.205,-0.205,-0.204,-0.204,-0.203, & - -0.203,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199,-0.199,-0.198, & - -0.197,-0.197,-0.196,-0.196,-0.195,-0.195,-0.194,-0.193,-0.193, & - -0.192,-0.192,-0.191,-0.191,-0.190,-0.189,-0.189,-0.188,-0.188, & - -0.187,-0.186,-0.186,-0.185,-0.185,-0.184,-0.184,-0.183,-0.182, & - -0.182,-0.181,-0.181,-0.180,-0.179,-0.179,-0.178,-0.178,-0.177, & - -0.177,-0.176,-0.175,-0.175,-0.174,-0.174,-0.173,-0.172,-0.172, & - -0.171,-0.171,-0.170,-0.170,-0.169,-0.168,-0.168,-0.167,-0.167, & - -0.166,-0.165,-0.165,-0.164,-0.164,-0.163,-0.163,-0.162,-0.161, & - -0.161,-0.160,-0.160,-0.159,-0.158,-0.158,-0.157,-0.157,-0.156, & - -0.156,-0.155,-0.154,-0.154,-0.153,-0.153,-0.152,-0.151,-0.151, & - -0.150,-0.150,-0.149,-0.149,-0.148,-0.147,-0.147,-0.146,-0.146, & - -0.145,-0.145,-0.144,-0.143,-0.143,-0.142,-0.142,-0.141,-0.140, & - -0.140,-0.139,-0.139,-0.138,-0.138,-0.137,-0.136,-0.136,-0.135, & - -0.135,-0.134,-0.134,-0.133,-0.132,-0.132,-0.131,-0.131,-0.130, & - -0.130,-0.129,-0.128,-0.128,-0.127,-0.127,-0.126,-0.126,-0.125, & - -0.125,-0.124,-0.123,-0.123,-0.122,-0.122,-0.121,-0.121,-0.120, & - -0.119,-0.119,-0.118,-0.118,-0.117,-0.117,-0.116,-0.115,-0.115, & - -0.114,-0.114,-0.113,-0.113,-0.112,-0.112,-0.111,-0.110,-0.110, & - -0.109,-0.109,-0.108,-0.108,-0.107,-0.107,-0.106,-0.105,-0.105, & - -0.104,-0.104,-0.103,-0.103,-0.102,-0.102,-0.101,-0.100,-0.100, & - -0.099,-0.099,-0.098,-0.098,-0.097,-0.097,-0.096,-0.096,-0.095, & - -0.094,-0.094,-0.093,-0.093,-0.092,-0.092,-0.091,-0.091,-0.090, & - -0.090,-0.089,-0.088,-0.088,-0.087,-0.087,-0.086,-0.086,-0.085, & - -0.085,-0.084,-0.084,-0.083,-0.083,-0.082,-0.081,-0.081,-0.080, & - -0.080,-0.079,-0.079,-0.078,-0.078,-0.077,-0.077,-0.076,-0.076, & - -0.075,-0.074,-0.074,-0.073,-0.073,-0.072,-0.072,-0.071,-0.071, & - -0.070,-0.070,-0.069,-0.069,-0.068,-0.068,-0.067,-0.067,-0.066, & - -0.065,-0.065,-0.064,-0.064,-0.058,-0.053,-0.048,-0.043,-0.038, & - -0.033,-0.028,-0.023,-0.018,-0.013,-0.008,-0.003, 0.002, 0.006, & - & 0.011, 0.016, 0.021, 0.025, 0.030, 0.035, 0.039, 0.044, 0.048, & - & 0.053, 0.057, 0.062, 0.066, 0.070, 0.075, 0.079, 0.083, 0.088, & - & 0.092, 0.096, 0.100, 0.105, 0.109, 0.113, 0.117, 0.121, 0.125, & - & 0.129, 0.133, 0.137, 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, & - & 0.165, 0.169, 0.173, 0.176, 0.180, 0.184, 0.188, 0.192, 0.195, & - & 0.199, 0.203, 0.207, 0.210, 0.214, 0.218, 0.221, 0.225, 0.228, & - & 0.232, 0.236, 0.239, 0.243, 0.246, 0.250, 0.253, 0.257, 0.260, & - & 0.264, 0.267, 0.271, 0.274, 0.278, 0.281, 0.285, 0.288, 0.291, & - & 0.295, 0.298, 0.301, 0.305, 0.308, 0.311, 0.315, 0.318, 0.321, & - & 0.325, 0.328, 0.331, 0.334, 0.338, 0.341, 0.344, 0.347, 0.350, & - & 0.354, 0.357, 0.360, 0.363, 0.366, 0.369, 0.373, 0.376, 0.379, & - & 0.382, 0.385, 0.388, 0.391, 0.394, 0.397, 0.400, 0.403, 0.406, & - & 0.409, 0.412, 0.416, 0.419, 0.422, 0.425, 0.428, 0.430, 0.433, & - & 0.436, 0.439, 0.442, 0.445, 0.448, 0.451, 0.454, 0.457, 0.460, & - & 0.463, 0.466, 0.469, 0.471, 0.474, 0.477, 0.480, 0.483, 0.486, & - & 0.489, 0.491, 0.494, 0.497, 0.500, 0.503, 0.506, 0.508, 0.511, & - & 0.514, 0.517, 0.520 & - / - -! *** (2H,SO4) - - DATA BNC07M/ & - -0.091,-0.196,-0.248,-0.284,-0.312,-0.336,-0.355,-0.372,-0.388, & - -0.401,-0.414,-0.425,-0.435,-0.445,-0.453,-0.462,-0.469,-0.477, & - -0.484,-0.490,-0.496,-0.502,-0.508,-0.513,-0.518,-0.523,-0.528, & - -0.532,-0.536,-0.540,-0.544,-0.548,-0.552,-0.556,-0.559,-0.562, & - -0.566,-0.569,-0.572,-0.575,-0.578,-0.580,-0.583,-0.586,-0.588, & - -0.591,-0.593,-0.595,-0.598,-0.600,-0.602,-0.604,-0.606,-0.608, & - -0.610,-0.612,-0.614,-0.616,-0.618,-0.620,-0.621,-0.623,-0.625, & - -0.626,-0.628,-0.629,-0.631,-0.632,-0.634,-0.635,-0.637,-0.638, & - -0.639,-0.641,-0.642,-0.643,-0.644,-0.646,-0.647,-0.648,-0.649, & - -0.650,-0.652,-0.653,-0.654,-0.655,-0.656,-0.657,-0.658,-0.659, & - -0.660,-0.661,-0.662,-0.663,-0.664,-0.665,-0.666,-0.666,-0.667, & - -0.668,-0.669,-0.670,-0.671,-0.671,-0.672,-0.673,-0.674,-0.675, & - -0.675,-0.676,-0.677,-0.678,-0.678,-0.679,-0.680,-0.680,-0.681, & - -0.682,-0.682,-0.683,-0.684,-0.684,-0.685,-0.686,-0.686,-0.687, & - -0.687,-0.688,-0.689,-0.689,-0.690,-0.690,-0.691,-0.691,-0.692, & - -0.692,-0.693,-0.693,-0.694,-0.694,-0.695,-0.695,-0.696,-0.696, & - -0.697,-0.697,-0.698,-0.698,-0.699,-0.699,-0.700,-0.700,-0.700, & - -0.701,-0.701,-0.702,-0.702,-0.702,-0.703,-0.703,-0.704,-0.704, & - -0.704,-0.705,-0.705,-0.705,-0.706,-0.706,-0.706,-0.707,-0.707, & - -0.707,-0.708,-0.708,-0.708,-0.709,-0.709,-0.709,-0.710,-0.710, & - -0.710,-0.711,-0.711,-0.711,-0.711,-0.712,-0.712,-0.712,-0.712, & - -0.713,-0.713,-0.713,-0.713,-0.714,-0.714,-0.714,-0.714,-0.715, & - -0.715,-0.715,-0.715,-0.716,-0.716,-0.716,-0.716,-0.716,-0.717, & - -0.717,-0.717,-0.717,-0.717,-0.718,-0.718,-0.718,-0.718,-0.718, & - -0.719,-0.719,-0.719,-0.719,-0.719,-0.719,-0.720,-0.720,-0.720, & - -0.720,-0.720,-0.720,-0.720,-0.721,-0.721,-0.721,-0.721,-0.721, & - -0.721,-0.721,-0.722,-0.722,-0.722,-0.722,-0.722,-0.722,-0.722, & - -0.722,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723,-0.723, & - -0.723,-0.723,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724, & - -0.724,-0.724,-0.724,-0.724,-0.724,-0.725,-0.725,-0.725,-0.725, & - -0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, & - -0.725,-0.725,-0.725,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.726, & - -0.726,-0.726,-0.726,-0.726,-0.726,-0.726,-0.725,-0.725,-0.725, & - -0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, & - -0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725,-0.725, & - -0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724, & - -0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.724,-0.723,-0.723, & - -0.723,-0.723,-0.723,-0.723,-0.722,-0.721,-0.721,-0.720,-0.719, & - -0.717,-0.716,-0.715,-0.714,-0.713,-0.711,-0.710,-0.709,-0.707, & - -0.706,-0.704,-0.703,-0.701,-0.700,-0.698,-0.696,-0.695,-0.693, & - -0.691,-0.689,-0.688,-0.686,-0.684,-0.682,-0.680,-0.678,-0.676, & - -0.675,-0.673,-0.671,-0.669,-0.667,-0.665,-0.663,-0.661,-0.658, & - -0.656,-0.654,-0.652,-0.650,-0.648,-0.646,-0.644,-0.642,-0.639, & - -0.637,-0.635,-0.633,-0.631,-0.628,-0.626,-0.624,-0.622,-0.619, & - -0.617,-0.615,-0.612,-0.610,-0.608,-0.605,-0.603,-0.601,-0.598, & - -0.596,-0.594,-0.591,-0.589,-0.587,-0.584,-0.582,-0.579,-0.577, & - -0.575,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558,-0.555, & - -0.553,-0.550,-0.548,-0.545,-0.543,-0.540,-0.538,-0.535,-0.533, & - -0.530,-0.528,-0.525,-0.523,-0.520,-0.518,-0.515,-0.513,-0.510, & - -0.508,-0.505,-0.503,-0.500,-0.498,-0.495,-0.493,-0.490,-0.487, & - -0.485,-0.482,-0.480,-0.477,-0.475,-0.472,-0.470,-0.467,-0.464, & - -0.462,-0.459,-0.457,-0.454,-0.451,-0.449,-0.446,-0.444,-0.441, & - -0.438,-0.436,-0.433,-0.431,-0.428,-0.425,-0.423,-0.420,-0.418, & - -0.415,-0.412,-0.410,-0.407,-0.404,-0.402,-0.399,-0.397,-0.394, & - -0.391,-0.389,-0.386,-0.383,-0.381,-0.378,-0.375,-0.373,-0.370, & - -0.367,-0.365,-0.362 & - / - -! *** (H,HSO4) - - DATA BNC08M/ & - -0.043,-0.086,-0.105,-0.116,-0.123,-0.128,-0.131,-0.134,-0.135, & - -0.136,-0.136,-0.135,-0.134,-0.133,-0.131,-0.129,-0.127,-0.124, & - -0.122,-0.118,-0.115,-0.112,-0.108,-0.104,-0.100,-0.096,-0.092, & - -0.088,-0.083,-0.079,-0.074,-0.069,-0.064,-0.059,-0.054,-0.048, & - -0.043,-0.037,-0.032,-0.026,-0.021,-0.015,-0.009,-0.003, 0.003, & - & 0.009, 0.015, 0.021, 0.027, 0.034, 0.040, 0.046, 0.053, 0.059, & - & 0.066, 0.072, 0.079, 0.086, 0.092, 0.099, 0.106, 0.112, 0.119, & - & 0.126, 0.133, 0.140, 0.147, 0.154, 0.161, 0.168, 0.175, 0.182, & - & 0.189, 0.196, 0.204, 0.211, 0.218, 0.226, 0.233, 0.240, 0.248, & - & 0.255, 0.263, 0.270, 0.278, 0.286, 0.293, 0.301, 0.309, 0.317, & - & 0.324, 0.332, 0.340, 0.348, 0.356, 0.364, 0.372, 0.380, 0.389, & - & 0.397, 0.405, 0.413, 0.421, 0.430, 0.438, 0.446, 0.455, 0.463, & - & 0.471, 0.480, 0.488, 0.497, 0.505, 0.514, 0.522, 0.530, 0.539, & - & 0.547, 0.556, 0.564, 0.573, 0.581, 0.590, 0.598, 0.607, 0.615, & - & 0.624, 0.632, 0.641, 0.649, 0.658, 0.666, 0.675, 0.683, 0.692, & - & 0.700, 0.708, 0.717, 0.725, 0.734, 0.742, 0.750, 0.759, 0.767, & - & 0.775, 0.784, 0.792, 0.800, 0.808, 0.817, 0.825, 0.833, 0.841, & - & 0.849, 0.858, 0.866, 0.874, 0.882, 0.890, 0.898, 0.906, 0.915, & - & 0.923, 0.931, 0.939, 0.947, 0.955, 0.963, 0.971, 0.979, 0.986, & - & 0.994, 1.002, 1.010, 1.018, 1.026, 1.034, 1.042, 1.049, 1.057, & - & 1.065, 1.073, 1.080, 1.088, 1.096, 1.104, 1.111, 1.119, 1.127, & - & 1.134, 1.142, 1.150, 1.157, 1.165, 1.172, 1.180, 1.187, 1.195, & - & 1.202, 1.210, 1.217, 1.225, 1.232, 1.240, 1.247, 1.254, 1.262, & - & 1.269, 1.276, 1.284, 1.291, 1.298, 1.306, 1.313, 1.320, 1.327, & - & 1.335, 1.342, 1.349, 1.356, 1.363, 1.371, 1.378, 1.385, 1.392, & - & 1.399, 1.406, 1.413, 1.420, 1.427, 1.434, 1.441, 1.448, 1.455, & - & 1.462, 1.469, 1.476, 1.483, 1.490, 1.497, 1.504, 1.510, 1.517, & - & 1.524, 1.531, 1.538, 1.545, 1.551, 1.558, 1.565, 1.572, 1.578, & - & 1.585, 1.592, 1.598, 1.605, 1.612, 1.618, 1.625, 1.632, 1.638, & - & 1.645, 1.651, 1.658, 1.664, 1.671, 1.678, 1.684, 1.691, 1.697, & - & 1.704, 1.710, 1.716, 1.723, 1.729, 1.736, 1.742, 1.749, 1.755, & - & 1.761, 1.768, 1.774, 1.780, 1.787, 1.793, 1.799, 1.805, 1.812, & - & 1.818, 1.824, 1.830, 1.837, 1.843, 1.849, 1.855, 1.861, 1.868, & - & 1.874, 1.880, 1.886, 1.892, 1.898, 1.904, 1.910, 1.916, 1.923, & - & 1.929, 1.935, 1.941, 1.947, 1.953, 1.959, 1.965, 1.971, 1.977, & - & 1.983, 1.988, 1.994, 2.000, 2.006, 2.012, 2.018, 2.024, 2.030, & - & 2.036, 2.041, 2.047, 2.053, 2.059, 2.065, 2.070, 2.076, 2.082, & - & 2.088, 2.094, 2.099, 2.105, 2.111, 2.116, 2.122, 2.128, 2.134, & - & 2.139, 2.145, 2.150, 2.156, 2.162, 2.167, 2.173, 2.179, 2.184, & - & 2.190, 2.195, 2.201, 2.206, 2.212, 2.218, 2.223, 2.229, 2.234, & - & 2.240, 2.245, 2.251, 2.256, 2.261, 2.267, 2.272, 2.278, 2.283, & - & 2.289, 2.294, 2.299, 2.305, 2.310, 2.316, 2.321, 2.326, 2.332, & - & 2.337, 2.342, 2.348, 2.353, 2.358, 2.364, 2.369, 2.374, 2.379, & - & 2.385, 2.390, 2.395, 2.400, 2.406, 2.411, 2.416, 2.421, 2.426, & - & 2.432, 2.437, 2.442, 2.447, 2.502, 2.553, 2.602, 2.651, 2.699, & - & 2.746, 2.793, 2.839, 2.884, 2.929, 2.973, 3.017, 3.060, 3.102, & - & 3.144, 3.186, 3.227, 3.267, 3.307, 3.346, 3.385, 3.424, 3.462, & - & 3.499, 3.536, 3.573, 3.610, 3.646, 3.681, 3.716, 3.751, 3.786, & - & 3.820, 3.854, 3.887, 3.920, 3.953, 3.985, 4.018, 4.049, 4.081, & - & 4.112, 4.143, 4.174, 4.204, 4.234, 4.264, 4.294, 4.323, 4.352, & - & 4.381, 4.410, 4.438, 4.466, 4.494, 4.522, 4.549, 4.577, 4.604, & - & 4.630, 4.657, 4.683, 4.710, 4.736, 4.761, 4.787, 4.812, 4.838, & - & 4.863, 4.888, 4.912, 4.937, 4.961, 4.985, 5.009, 5.033, 5.057, & - & 5.080, 5.104, 5.127, 5.150, 5.173, 5.196, 5.218, 5.241, 5.263, & - & 5.285, 5.307, 5.329, 5.351, 5.372, 5.394, 5.415, 5.436, 5.457, & - & 5.478, 5.499, 5.520, 5.541, 5.561, 5.581, 5.602, 5.622, 5.642, & - & 5.662, 5.682, 5.701, 5.721, 5.740, 5.760, 5.779, 5.798, 5.817, & - & 5.836, 5.855, 5.874, 5.892, 5.911, 5.929, 5.948, 5.966, 5.984, & - & 6.002, 6.020, 6.038, 6.056, 6.074, 6.092, 6.109, 6.127, 6.144, & - & 6.161, 6.179, 6.196, 6.213, 6.230, 6.247, 6.264, 6.280, 6.297, & - & 6.314, 6.330, 6.347, 6.363, 6.379, 6.396, 6.412, 6.428, 6.444, & - & 6.460, 6.476, 6.492, 6.507, 6.523, 6.539, 6.554, 6.570, 6.585, & - & 6.600, 6.616, 6.631 & - / - -! *** NH4HSO4 - - DATA BNC09M/ & - -0.045,-0.095,-0.119,-0.135,-0.147,-0.157,-0.166,-0.173,-0.179, & - -0.184,-0.189,-0.193,-0.196,-0.200,-0.203,-0.205,-0.208,-0.210, & - -0.212,-0.213,-0.215,-0.216,-0.217,-0.218,-0.219,-0.219,-0.220, & - -0.220,-0.221,-0.221,-0.221,-0.221,-0.221,-0.221,-0.220,-0.220, & - -0.219,-0.219,-0.218,-0.217,-0.217,-0.216,-0.215,-0.214,-0.213, & - -0.212,-0.211,-0.210,-0.208,-0.207,-0.206,-0.204,-0.203,-0.201, & - -0.200,-0.198,-0.197,-0.195,-0.193,-0.192,-0.190,-0.188,-0.186, & - -0.185,-0.183,-0.181,-0.179,-0.177,-0.175,-0.173,-0.171,-0.169, & - -0.167,-0.165,-0.162,-0.160,-0.158,-0.156,-0.154,-0.151,-0.149, & - -0.147,-0.144,-0.142,-0.140,-0.137,-0.135,-0.132,-0.130,-0.127, & - -0.125,-0.122,-0.120,-0.117,-0.115,-0.112,-0.109,-0.107,-0.104, & - -0.101,-0.099,-0.096,-0.093,-0.091,-0.088,-0.085,-0.082,-0.079, & - -0.077,-0.074,-0.071,-0.068,-0.065,-0.063,-0.060,-0.057,-0.054, & - -0.051,-0.048,-0.046,-0.043,-0.040,-0.037,-0.034,-0.031,-0.028, & - -0.025,-0.023,-0.020,-0.017,-0.014,-0.011,-0.008,-0.005,-0.003, & - & 0.000, 0.003, 0.006, 0.009, 0.012, 0.014, 0.017, 0.020, 0.023, & - & 0.026, 0.029, 0.031, 0.034, 0.037, 0.040, 0.043, 0.045, 0.048, & - & 0.051, 0.054, 0.057, 0.059, 0.062, 0.065, 0.068, 0.070, 0.073, & - & 0.076, 0.079, 0.081, 0.084, 0.087, 0.089, 0.092, 0.095, 0.098, & - & 0.100, 0.103, 0.106, 0.108, 0.111, 0.114, 0.116, 0.119, 0.122, & - & 0.124, 0.127, 0.130, 0.132, 0.135, 0.137, 0.140, 0.143, 0.145, & - & 0.148, 0.150, 0.153, 0.156, 0.158, 0.161, 0.163, 0.166, 0.168, & - & 0.171, 0.174, 0.176, 0.179, 0.181, 0.184, 0.186, 0.189, 0.191, & - & 0.194, 0.196, 0.199, 0.201, 0.204, 0.206, 0.209, 0.211, 0.214, & - & 0.216, 0.219, 0.221, 0.223, 0.226, 0.228, 0.231, 0.233, 0.236, & - & 0.238, 0.240, 0.243, 0.245, 0.248, 0.250, 0.252, 0.255, 0.257, & - & 0.260, 0.262, 0.264, 0.267, 0.269, 0.271, 0.274, 0.276, 0.278, & - & 0.281, 0.283, 0.285, 0.288, 0.290, 0.292, 0.295, 0.297, 0.299, & - & 0.302, 0.304, 0.306, 0.308, 0.311, 0.313, 0.315, 0.317, 0.320, & - & 0.322, 0.324, 0.326, 0.329, 0.331, 0.333, 0.335, 0.338, 0.340, & - & 0.342, 0.344, 0.346, 0.349, 0.351, 0.353, 0.355, 0.357, 0.360, & - & 0.362, 0.364, 0.366, 0.368, 0.371, 0.373, 0.375, 0.377, 0.379, & - & 0.381, 0.383, 0.386, 0.388, 0.390, 0.392, 0.394, 0.396, 0.398, & - & 0.400, 0.403, 0.405, 0.407, 0.409, 0.411, 0.413, 0.415, 0.417, & - & 0.419, 0.421, 0.423, 0.426, 0.428, 0.430, 0.432, 0.434, 0.436, & - & 0.438, 0.440, 0.442, 0.444, 0.446, 0.448, 0.450, 0.452, 0.454, & - & 0.456, 0.458, 0.460, 0.462, 0.464, 0.466, 0.468, 0.470, 0.472, & - & 0.474, 0.476, 0.478, 0.480, 0.482, 0.484, 0.486, 0.488, 0.490, & - & 0.492, 0.494, 0.496, 0.498, 0.500, 0.502, 0.504, 0.506, 0.508, & - & 0.510, 0.511, 0.513, 0.515, 0.517, 0.519, 0.521, 0.523, 0.525, & - & 0.527, 0.529, 0.531, 0.533, 0.534, 0.536, 0.538, 0.540, 0.542, & - & 0.544, 0.546, 0.548, 0.549, 0.551, 0.553, 0.555, 0.557, 0.559, & - & 0.561, 0.563, 0.564, 0.566, 0.568, 0.570, 0.572, 0.574, 0.575, & - & 0.577, 0.579, 0.581, 0.583, 0.585, 0.586, 0.588, 0.590, 0.592, & - & 0.594, 0.595, 0.597, 0.599, 0.618, 0.636, 0.653, 0.670, 0.687, & - & 0.704, 0.721, 0.737, 0.753, 0.769, 0.784, 0.800, 0.815, 0.830, & - & 0.845, 0.860, 0.875, 0.889, 0.904, 0.918, 0.932, 0.946, 0.959, & - & 0.973, 0.986, 1.000, 1.013, 1.026, 1.039, 1.052, 1.065, 1.077, & - & 1.090, 1.102, 1.114, 1.126, 1.138, 1.150, 1.162, 1.174, 1.186, & - & 1.197, 1.209, 1.220, 1.231, 1.242, 1.254, 1.265, 1.276, 1.286, & - & 1.297, 1.308, 1.318, 1.329, 1.339, 1.350, 1.360, 1.370, 1.381, & - & 1.391, 1.401, 1.411, 1.421, 1.430, 1.440, 1.450, 1.459, 1.469, & - & 1.479, 1.488, 1.497, 1.507, 1.516, 1.525, 1.534, 1.544, 1.553, & - & 1.562, 1.571, 1.579, 1.588, 1.597, 1.606, 1.615, 1.623, 1.632, & - & 1.640, 1.649, 1.657, 1.666, 1.674, 1.683, 1.691, 1.699, 1.707, & - & 1.715, 1.724, 1.732, 1.740, 1.748, 1.756, 1.764, 1.771, 1.779, & - & 1.787, 1.795, 1.803, 1.810, 1.818, 1.826, 1.833, 1.841, 1.848, & - & 1.856, 1.863, 1.871, 1.878, 1.885, 1.893, 1.900, 1.907, 1.915, & - & 1.922, 1.929, 1.936, 1.943, 1.950, 1.957, 1.964, 1.971, 1.978, & - & 1.985, 1.992, 1.999, 2.006, 2.013, 2.019, 2.026, 2.033, 2.040, & - & 2.046, 2.053, 2.060, 2.066, 2.073, 2.079, 2.086, 2.093, 2.099, & - & 2.105, 2.112, 2.118, 2.125, 2.131, 2.138, 2.144, 2.150, 2.156, & - & 2.163, 2.169, 2.175 & - / - -! *** (H,NO3) - - DATA BNC10M/ & - -0.044,-0.092,-0.113,-0.127,-0.137,-0.145,-0.151,-0.156,-0.160, & - -0.163,-0.165,-0.167,-0.169,-0.170,-0.171,-0.172,-0.172,-0.172, & - -0.172,-0.172,-0.172,-0.172,-0.171,-0.171,-0.170,-0.169,-0.168, & - -0.167,-0.166,-0.165,-0.164,-0.163,-0.162,-0.160,-0.159,-0.158, & - -0.156,-0.155,-0.153,-0.152,-0.151,-0.149,-0.147,-0.146,-0.144, & - -0.143,-0.141,-0.140,-0.138,-0.136,-0.135,-0.133,-0.131,-0.130, & - -0.128,-0.126,-0.125,-0.123,-0.121,-0.120,-0.118,-0.116,-0.114, & - -0.113,-0.111,-0.109,-0.107,-0.106,-0.104,-0.102,-0.100,-0.099, & - -0.097,-0.095,-0.093,-0.091,-0.089,-0.088,-0.086,-0.084,-0.082, & - -0.080,-0.078,-0.076,-0.074,-0.072,-0.070,-0.068,-0.066,-0.064, & - -0.062,-0.060,-0.058,-0.056,-0.054,-0.052,-0.050,-0.048,-0.045, & - -0.043,-0.041,-0.039,-0.037,-0.035,-0.032,-0.030,-0.028,-0.026, & - -0.024,-0.021,-0.019,-0.017,-0.015,-0.012,-0.010,-0.008,-0.006, & - -0.003,-0.001, 0.001, 0.004, 0.006, 0.008, 0.010, 0.013, 0.015, & - & 0.017, 0.020, 0.022, 0.024, 0.027, 0.029, 0.031, 0.033, 0.036, & - & 0.038, 0.040, 0.043, 0.045, 0.047, 0.049, 0.052, 0.054, 0.056, & - & 0.059, 0.061, 0.063, 0.066, 0.068, 0.070, 0.072, 0.075, 0.077, & - & 0.079, 0.081, 0.084, 0.086, 0.088, 0.091, 0.093, 0.095, 0.097, & - & 0.100, 0.102, 0.104, 0.106, 0.109, 0.111, 0.113, 0.115, 0.118, & - & 0.120, 0.122, 0.124, 0.127, 0.129, 0.131, 0.133, 0.135, 0.138, & - & 0.140, 0.142, 0.144, 0.147, 0.149, 0.151, 0.153, 0.155, 0.158, & - & 0.160, 0.162, 0.164, 0.166, 0.169, 0.171, 0.173, 0.175, 0.177, & - & 0.179, 0.182, 0.184, 0.186, 0.188, 0.190, 0.192, 0.195, 0.197, & - & 0.199, 0.201, 0.203, 0.205, 0.207, 0.210, 0.212, 0.214, 0.216, & - & 0.218, 0.220, 0.222, 0.224, 0.227, 0.229, 0.231, 0.233, 0.235, & - & 0.237, 0.239, 0.241, 0.243, 0.245, 0.248, 0.250, 0.252, 0.254, & - & 0.256, 0.258, 0.260, 0.262, 0.264, 0.266, 0.268, 0.270, 0.272, & - & 0.274, 0.276, 0.278, 0.281, 0.283, 0.285, 0.287, 0.289, 0.291, & - & 0.293, 0.295, 0.297, 0.299, 0.301, 0.303, 0.305, 0.307, 0.309, & - & 0.311, 0.313, 0.315, 0.317, 0.319, 0.321, 0.323, 0.325, 0.327, & - & 0.329, 0.331, 0.333, 0.335, 0.337, 0.339, 0.341, 0.343, 0.344, & - & 0.346, 0.348, 0.350, 0.352, 0.354, 0.356, 0.358, 0.360, 0.362, & - & 0.364, 0.366, 0.368, 0.370, 0.372, 0.373, 0.375, 0.377, 0.379, & - & 0.381, 0.383, 0.385, 0.387, 0.389, 0.391, 0.393, 0.394, 0.396, & - & 0.398, 0.400, 0.402, 0.404, 0.406, 0.408, 0.409, 0.411, 0.413, & - & 0.415, 0.417, 0.419, 0.421, 0.422, 0.424, 0.426, 0.428, 0.430, & - & 0.432, 0.433, 0.435, 0.437, 0.439, 0.441, 0.443, 0.444, 0.446, & - & 0.448, 0.450, 0.452, 0.454, 0.455, 0.457, 0.459, 0.461, 0.463, & - & 0.464, 0.466, 0.468, 0.470, 0.471, 0.473, 0.475, 0.477, 0.479, & - & 0.480, 0.482, 0.484, 0.486, 0.487, 0.489, 0.491, 0.493, 0.494, & - & 0.496, 0.498, 0.500, 0.501, 0.503, 0.505, 0.507, 0.508, 0.510, & - & 0.512, 0.514, 0.515, 0.517, 0.519, 0.521, 0.522, 0.524, 0.526, & - & 0.527, 0.529, 0.531, 0.533, 0.534, 0.536, 0.538, 0.539, 0.541, & - & 0.543, 0.544, 0.546, 0.548, 0.549, 0.551, 0.553, 0.554, 0.556, & - & 0.558, 0.560, 0.561, 0.563, 0.581, 0.597, 0.613, 0.629, 0.645, & - & 0.660, 0.676, 0.691, 0.706, 0.721, 0.736, 0.750, 0.765, 0.779, & - & 0.793, 0.807, 0.820, 0.834, 0.848, 0.861, 0.874, 0.887, 0.900, & - & 0.913, 0.926, 0.938, 0.951, 0.963, 0.975, 0.987, 0.999, 1.011, & - & 1.023, 1.035, 1.046, 1.058, 1.069, 1.081, 1.092, 1.103, 1.114, & - & 1.125, 1.136, 1.147, 1.157, 1.168, 1.178, 1.189, 1.199, 1.210, & - & 1.220, 1.230, 1.240, 1.250, 1.260, 1.270, 1.279, 1.289, 1.299, & - & 1.308, 1.318, 1.327, 1.337, 1.346, 1.355, 1.365, 1.374, 1.383, & - & 1.392, 1.401, 1.410, 1.419, 1.427, 1.436, 1.445, 1.454, 1.462, & - & 1.471, 1.479, 1.488, 1.496, 1.504, 1.513, 1.521, 1.529, 1.537, & - & 1.546, 1.554, 1.562, 1.570, 1.578, 1.586, 1.593, 1.601, 1.609, & - & 1.617, 1.624, 1.632, 1.640, 1.647, 1.655, 1.662, 1.670, 1.677, & - & 1.685, 1.692, 1.700, 1.707, 1.714, 1.721, 1.729, 1.736, 1.743, & - & 1.750, 1.757, 1.764, 1.771, 1.778, 1.785, 1.792, 1.799, 1.806, & - & 1.813, 1.820, 1.826, 1.833, 1.840, 1.847, 1.853, 1.860, 1.866, & - & 1.873, 1.880, 1.886, 1.893, 1.899, 1.906, 1.912, 1.918, 1.925, & - & 1.931, 1.938, 1.944, 1.950, 1.956, 1.963, 1.969, 1.975, 1.981, & - & 1.987, 1.994, 2.000, 2.006, 2.012, 2.018, 2.024, 2.030, 2.036, & - & 2.042, 2.048, 2.054 & - / - -! *** (H,Cl) - - DATA BNC11M/ & - -0.043,-0.087,-0.106,-0.117,-0.124,-0.130,-0.133,-0.135,-0.137, & - -0.138,-0.138,-0.137,-0.136,-0.135,-0.134,-0.132,-0.130,-0.127, & - -0.125,-0.122,-0.119,-0.116,-0.113,-0.110,-0.107,-0.103,-0.099, & - -0.096,-0.092,-0.088,-0.084,-0.080,-0.076,-0.071,-0.067,-0.063, & - -0.058,-0.054,-0.049,-0.045,-0.040,-0.036,-0.031,-0.027,-0.022, & - -0.017,-0.012,-0.008,-0.003, 0.002, 0.007, 0.012, 0.017, 0.022, & - & 0.027, 0.031, 0.036, 0.041, 0.046, 0.051, 0.056, 0.061, 0.066, & - & 0.071, 0.077, 0.082, 0.087, 0.092, 0.097, 0.102, 0.107, 0.113, & - & 0.118, 0.123, 0.128, 0.134, 0.139, 0.144, 0.149, 0.155, 0.160, & - & 0.166, 0.171, 0.177, 0.182, 0.188, 0.193, 0.199, 0.204, 0.210, & - & 0.216, 0.221, 0.227, 0.233, 0.239, 0.244, 0.250, 0.256, 0.262, & - & 0.268, 0.274, 0.280, 0.286, 0.292, 0.298, 0.304, 0.310, 0.316, & - & 0.322, 0.328, 0.334, 0.340, 0.346, 0.352, 0.358, 0.364, 0.370, & - & 0.377, 0.383, 0.389, 0.395, 0.401, 0.407, 0.413, 0.420, 0.426, & - & 0.432, 0.438, 0.444, 0.450, 0.457, 0.463, 0.469, 0.475, 0.481, & - & 0.487, 0.493, 0.499, 0.505, 0.512, 0.518, 0.524, 0.530, 0.536, & - & 0.542, 0.548, 0.554, 0.560, 0.566, 0.572, 0.578, 0.584, 0.590, & - & 0.596, 0.602, 0.608, 0.614, 0.620, 0.626, 0.632, 0.638, 0.643, & - & 0.649, 0.655, 0.661, 0.667, 0.673, 0.679, 0.684, 0.690, 0.696, & - & 0.702, 0.708, 0.713, 0.719, 0.725, 0.731, 0.737, 0.742, 0.748, & - & 0.754, 0.759, 0.765, 0.771, 0.776, 0.782, 0.788, 0.793, 0.799, & - & 0.805, 0.810, 0.816, 0.821, 0.827, 0.833, 0.838, 0.844, 0.849, & - & 0.855, 0.860, 0.866, 0.871, 0.877, 0.882, 0.888, 0.893, 0.899, & - & 0.904, 0.909, 0.915, 0.920, 0.926, 0.931, 0.936, 0.942, 0.947, & - & 0.953, 0.958, 0.963, 0.969, 0.974, 0.979, 0.984, 0.990, 0.995, & - & 1.000, 1.005, 1.011, 1.016, 1.021, 1.026, 1.032, 1.037, 1.042, & - & 1.047, 1.052, 1.057, 1.062, 1.068, 1.073, 1.078, 1.083, 1.088, & - & 1.093, 1.098, 1.103, 1.108, 1.113, 1.118, 1.123, 1.128, 1.133, & - & 1.138, 1.143, 1.148, 1.153, 1.158, 1.163, 1.168, 1.173, 1.178, & - & 1.183, 1.188, 1.193, 1.198, 1.202, 1.207, 1.212, 1.217, 1.222, & - & 1.227, 1.232, 1.236, 1.241, 1.246, 1.251, 1.256, 1.260, 1.265, & - & 1.270, 1.275, 1.279, 1.284, 1.289, 1.293, 1.298, 1.303, 1.307, & - & 1.312, 1.317, 1.321, 1.326, 1.331, 1.335, 1.340, 1.345, 1.349, & - & 1.354, 1.358, 1.363, 1.368, 1.372, 1.377, 1.381, 1.386, 1.390, & - & 1.395, 1.399, 1.404, 1.408, 1.413, 1.417, 1.422, 1.426, 1.431, & - & 1.435, 1.440, 1.444, 1.449, 1.453, 1.457, 1.462, 1.466, 1.471, & - & 1.475, 1.479, 1.484, 1.488, 1.492, 1.497, 1.501, 1.506, 1.510, & - & 1.514, 1.518, 1.523, 1.527, 1.531, 1.536, 1.540, 1.544, 1.548, & - & 1.553, 1.557, 1.561, 1.565, 1.570, 1.574, 1.578, 1.582, 1.587, & - & 1.591, 1.595, 1.599, 1.603, 1.607, 1.612, 1.616, 1.620, 1.624, & - & 1.628, 1.632, 1.636, 1.640, 1.645, 1.649, 1.653, 1.657, 1.661, & - & 1.665, 1.669, 1.673, 1.677, 1.681, 1.685, 1.689, 1.693, 1.697, & - & 1.701, 1.705, 1.709, 1.713, 1.717, 1.721, 1.725, 1.729, 1.733, & - & 1.737, 1.741, 1.745, 1.749, 1.753, 1.757, 1.761, 1.765, 1.769, & - & 1.772, 1.776, 1.780, 1.784, 1.826, 1.864, 1.901, 1.938, 1.974, & - & 2.010, 2.045, 2.080, 2.114, 2.148, 2.181, 2.214, 2.246, 2.278, & - & 2.310, 2.341, 2.372, 2.403, 2.433, 2.463, 2.492, 2.522, 2.550, & - & 2.579, 2.607, 2.635, 2.663, 2.690, 2.717, 2.744, 2.770, 2.796, & - & 2.822, 2.848, 2.873, 2.898, 2.923, 2.948, 2.972, 2.996, 3.020, & - & 3.044, 3.068, 3.091, 3.114, 3.137, 3.160, 3.182, 3.205, 3.227, & - & 3.249, 3.271, 3.292, 3.314, 3.335, 3.356, 3.377, 3.398, 3.418, & - & 3.439, 3.459, 3.479, 3.499, 3.519, 3.539, 3.558, 3.578, 3.597, & - & 3.616, 3.635, 3.654, 3.673, 3.691, 3.710, 3.728, 3.746, 3.765, & - & 3.783, 3.800, 3.818, 3.836, 3.853, 3.871, 3.888, 3.905, 3.922, & - & 3.939, 3.956, 3.973, 3.990, 4.006, 4.023, 4.039, 4.055, 4.071, & - & 4.088, 4.104, 4.119, 4.135, 4.151, 4.167, 4.182, 4.198, 4.213, & - & 4.228, 4.243, 4.259, 4.274, 4.289, 4.304, 4.318, 4.333, 4.348, & - & 4.362, 4.377, 4.391, 4.406, 4.420, 4.434, 4.448, 4.462, 4.476, & - & 4.490, 4.504, 4.518, 4.532, 4.545, 4.559, 4.572, 4.586, 4.599, & - & 4.613, 4.626, 4.639, 4.652, 4.665, 4.678, 4.691, 4.704, 4.717, & - & 4.730, 4.743, 4.756, 4.768, 4.781, 4.793, 4.806, 4.818, 4.831, & - & 4.843, 4.855, 4.867, 4.880, 4.892, 4.904, 4.916, 4.928, 4.940, & - & 4.952, 4.964, 4.975 & - / - -! *** NaHSO4 - - DATA BNC12M/ & - -0.044,-0.092,-0.113,-0.127,-0.138,-0.146,-0.152,-0.157,-0.162, & - -0.165,-0.168,-0.170,-0.172,-0.174,-0.175,-0.176,-0.176,-0.177, & - -0.177,-0.177,-0.176,-0.176,-0.176,-0.175,-0.174,-0.173,-0.172, & - -0.171,-0.169,-0.168,-0.167,-0.165,-0.163,-0.161,-0.160,-0.158, & - -0.156,-0.154,-0.151,-0.149,-0.147,-0.145,-0.142,-0.140,-0.137, & - -0.135,-0.132,-0.130,-0.127,-0.124,-0.122,-0.119,-0.116,-0.113, & - -0.110,-0.107,-0.104,-0.101,-0.098,-0.095,-0.092,-0.089,-0.086, & - -0.083,-0.080,-0.076,-0.073,-0.070,-0.067,-0.063,-0.060,-0.057, & - -0.053,-0.050,-0.046,-0.043,-0.039,-0.036,-0.032,-0.029,-0.025, & - -0.021,-0.018,-0.014,-0.010,-0.007,-0.003, 0.001, 0.005, 0.009, & - & 0.012, 0.016, 0.020, 0.024, 0.028, 0.032, 0.036, 0.040, 0.044, & - & 0.048, 0.052, 0.056, 0.060, 0.064, 0.068, 0.073, 0.077, 0.081, & - & 0.085, 0.089, 0.093, 0.098, 0.102, 0.106, 0.110, 0.115, 0.119, & - & 0.123, 0.127, 0.131, 0.136, 0.140, 0.144, 0.148, 0.153, 0.157, & - & 0.161, 0.165, 0.170, 0.174, 0.178, 0.182, 0.187, 0.191, 0.195, & - & 0.199, 0.204, 0.208, 0.212, 0.216, 0.220, 0.225, 0.229, 0.233, & - & 0.237, 0.241, 0.245, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, & - & 0.274, 0.279, 0.283, 0.287, 0.291, 0.295, 0.299, 0.303, 0.307, & - & 0.311, 0.315, 0.319, 0.323, 0.327, 0.331, 0.335, 0.339, 0.343, & - & 0.347, 0.351, 0.355, 0.359, 0.363, 0.367, 0.371, 0.375, 0.379, & - & 0.383, 0.387, 0.391, 0.395, 0.399, 0.402, 0.406, 0.410, 0.414, & - & 0.418, 0.422, 0.426, 0.429, 0.433, 0.437, 0.441, 0.445, 0.449, & - & 0.452, 0.456, 0.460, 0.464, 0.467, 0.471, 0.475, 0.479, 0.482, & - & 0.486, 0.490, 0.494, 0.497, 0.501, 0.505, 0.508, 0.512, 0.516, & - & 0.519, 0.523, 0.527, 0.530, 0.534, 0.538, 0.541, 0.545, 0.548, & - & 0.552, 0.556, 0.559, 0.563, 0.566, 0.570, 0.573, 0.577, 0.581, & - & 0.584, 0.588, 0.591, 0.595, 0.598, 0.602, 0.605, 0.609, 0.612, & - & 0.616, 0.619, 0.623, 0.626, 0.630, 0.633, 0.636, 0.640, 0.643, & - & 0.647, 0.650, 0.654, 0.657, 0.660, 0.664, 0.667, 0.671, 0.674, & - & 0.677, 0.681, 0.684, 0.687, 0.691, 0.694, 0.697, 0.701, 0.704, & - & 0.707, 0.711, 0.714, 0.717, 0.721, 0.724, 0.727, 0.730, 0.734, & - & 0.737, 0.740, 0.743, 0.747, 0.750, 0.753, 0.756, 0.760, 0.763, & - & 0.766, 0.769, 0.773, 0.776, 0.779, 0.782, 0.785, 0.788, 0.792, & - & 0.795, 0.798, 0.801, 0.804, 0.807, 0.811, 0.814, 0.817, 0.820, & - & 0.823, 0.826, 0.829, 0.832, 0.835, 0.839, 0.842, 0.845, 0.848, & - & 0.851, 0.854, 0.857, 0.860, 0.863, 0.866, 0.869, 0.872, 0.875, & - & 0.878, 0.881, 0.884, 0.887, 0.890, 0.893, 0.896, 0.899, 0.902, & - & 0.905, 0.908, 0.911, 0.914, 0.917, 0.920, 0.923, 0.926, 0.929, & - & 0.932, 0.935, 0.938, 0.941, 0.944, 0.947, 0.949, 0.952, 0.955, & - & 0.958, 0.961, 0.964, 0.967, 0.970, 0.973, 0.975, 0.978, 0.981, & - & 0.984, 0.987, 0.990, 0.993, 0.995, 0.998, 1.001, 1.004, 1.007, & - & 1.010, 1.012, 1.015, 1.018, 1.021, 1.024, 1.026, 1.029, 1.032, & - & 1.035, 1.038, 1.040, 1.043, 1.046, 1.049, 1.051, 1.054, 1.057, & - & 1.060, 1.062, 1.065, 1.068, 1.071, 1.073, 1.076, 1.079, 1.082, & - & 1.084, 1.087, 1.090, 1.092, 1.121, 1.148, 1.174, 1.199, 1.225, & - & 1.250, 1.274, 1.299, 1.323, 1.346, 1.370, 1.393, 1.416, 1.438, & - & 1.461, 1.483, 1.504, 1.526, 1.547, 1.568, 1.589, 1.610, 1.630, & - & 1.650, 1.670, 1.690, 1.710, 1.729, 1.748, 1.767, 1.786, 1.805, & - & 1.823, 1.841, 1.860, 1.878, 1.895, 1.913, 1.930, 1.948, 1.965, & - & 1.982, 1.999, 2.015, 2.032, 2.048, 2.065, 2.081, 2.097, 2.113, & - & 2.129, 2.144, 2.160, 2.175, 2.191, 2.206, 2.221, 2.236, 2.251, & - & 2.265, 2.280, 2.294, 2.309, 2.323, 2.337, 2.352, 2.366, 2.379, & - & 2.393, 2.407, 2.421, 2.434, 2.448, 2.461, 2.474, 2.488, 2.501, & - & 2.514, 2.527, 2.540, 2.552, 2.565, 2.578, 2.590, 2.603, 2.615, & - & 2.628, 2.640, 2.652, 2.664, 2.676, 2.688, 2.700, 2.712, 2.724, & - & 2.735, 2.747, 2.759, 2.770, 2.782, 2.793, 2.805, 2.816, 2.827, & - & 2.838, 2.849, 2.860, 2.871, 2.882, 2.893, 2.904, 2.915, 2.926, & - & 2.936, 2.947, 2.957, 2.968, 2.978, 2.989, 2.999, 3.010, 3.020, & - & 3.030, 3.040, 3.050, 3.060, 3.070, 3.080, 3.090, 3.100, 3.110, & - & 3.120, 3.130, 3.139, 3.149, 3.159, 3.168, 3.178, 3.188, 3.197, & - & 3.206, 3.216, 3.225, 3.235, 3.244, 3.253, 3.262, 3.272, 3.281, & - & 3.290, 3.299, 3.308, 3.317, 3.326, 3.335, 3.344, 3.353, 3.361, & - & 3.370, 3.379, 3.388 & - / - -! *** (NH4)3H(SO4)2 - - DATA BNC13M/ & - -0.072,-0.156,-0.197,-0.226,-0.248,-0.266,-0.282,-0.295,-0.307, & - -0.317,-0.327,-0.336,-0.344,-0.351,-0.358,-0.364,-0.370,-0.375, & - -0.380,-0.385,-0.390,-0.394,-0.398,-0.402,-0.406,-0.409,-0.412, & - -0.415,-0.418,-0.421,-0.424,-0.426,-0.429,-0.431,-0.433,-0.435, & - -0.437,-0.439,-0.441,-0.442,-0.444,-0.446,-0.447,-0.449,-0.450, & - -0.451,-0.452,-0.453,-0.454,-0.456,-0.456,-0.457,-0.458,-0.459, & - -0.460,-0.461,-0.461,-0.462,-0.462,-0.463,-0.463,-0.464,-0.464, & - -0.465,-0.465,-0.465,-0.466,-0.466,-0.466,-0.467,-0.467,-0.467, & - -0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467,-0.467, & - -0.467,-0.467,-0.467,-0.467,-0.467,-0.466,-0.466,-0.466,-0.466, & - -0.466,-0.465,-0.465,-0.465,-0.464,-0.464,-0.464,-0.463,-0.463, & - -0.463,-0.462,-0.462,-0.461,-0.461,-0.460,-0.460,-0.459,-0.459, & - -0.458,-0.458,-0.457,-0.457,-0.456,-0.456,-0.455,-0.455,-0.454, & - -0.454,-0.453,-0.452,-0.452,-0.451,-0.451,-0.450,-0.449,-0.449, & - -0.448,-0.447,-0.447,-0.446,-0.445,-0.445,-0.444,-0.443,-0.443, & - -0.442,-0.441,-0.441,-0.440,-0.439,-0.439,-0.438,-0.437,-0.437, & - -0.436,-0.435,-0.434,-0.434,-0.433,-0.432,-0.432,-0.431,-0.430, & - -0.429,-0.429,-0.428,-0.427,-0.427,-0.426,-0.425,-0.424,-0.424, & - -0.423,-0.422,-0.421,-0.421,-0.420,-0.419,-0.418,-0.418,-0.417, & - -0.416,-0.415,-0.415,-0.414,-0.413,-0.412,-0.412,-0.411,-0.410, & - -0.409,-0.409,-0.408,-0.407,-0.406,-0.406,-0.405,-0.404,-0.403, & - -0.403,-0.402,-0.401,-0.400,-0.400,-0.399,-0.398,-0.397,-0.397, & - -0.396,-0.395,-0.394,-0.394,-0.393,-0.392,-0.391,-0.391,-0.390, & - -0.389,-0.388,-0.388,-0.387,-0.386,-0.385,-0.385,-0.384,-0.383, & - -0.382,-0.381,-0.381,-0.380,-0.379,-0.378,-0.378,-0.377,-0.376, & - -0.375,-0.375,-0.374,-0.373,-0.372,-0.372,-0.371,-0.370,-0.369, & - -0.369,-0.368,-0.367,-0.366,-0.366,-0.365,-0.364,-0.363,-0.363, & - -0.362,-0.361,-0.360,-0.360,-0.359,-0.358,-0.357,-0.357,-0.356, & - -0.355,-0.354,-0.354,-0.353,-0.352,-0.351,-0.351,-0.350,-0.349, & - -0.348,-0.348,-0.347,-0.346,-0.345,-0.345,-0.344,-0.343,-0.342, & - -0.342,-0.341,-0.340,-0.339,-0.339,-0.338,-0.337,-0.336,-0.336, & - -0.335,-0.334,-0.333,-0.333,-0.332,-0.331,-0.331,-0.330,-0.329, & - -0.328,-0.328,-0.327,-0.326,-0.325,-0.325,-0.324,-0.323,-0.322, & - -0.322,-0.321,-0.320,-0.320,-0.319,-0.318,-0.317,-0.317,-0.316, & - -0.315,-0.314,-0.314,-0.313,-0.312,-0.312,-0.311,-0.310,-0.309, & - -0.309,-0.308,-0.307,-0.306,-0.306,-0.305,-0.304,-0.304,-0.303, & - -0.302,-0.301,-0.301,-0.300,-0.299,-0.299,-0.298,-0.297,-0.296, & - -0.296,-0.295,-0.294,-0.294,-0.293,-0.292,-0.291,-0.291,-0.290, & - -0.289,-0.289,-0.288,-0.287,-0.286,-0.286,-0.285,-0.284,-0.284, & - -0.283,-0.282,-0.281,-0.281,-0.280,-0.279,-0.279,-0.278,-0.277, & - -0.277,-0.276,-0.275,-0.274,-0.274,-0.273,-0.272,-0.272,-0.271, & - -0.270,-0.270,-0.269,-0.268,-0.267,-0.267,-0.266,-0.265,-0.265, & - -0.264,-0.263,-0.263,-0.262,-0.261,-0.261,-0.260,-0.259,-0.258, & - -0.258,-0.257,-0.256,-0.256,-0.255,-0.254,-0.254,-0.253,-0.252, & - -0.252,-0.251,-0.250,-0.250,-0.242,-0.235,-0.229,-0.222,-0.215, & - -0.209,-0.202,-0.196,-0.189,-0.183,-0.176,-0.170,-0.164,-0.157, & - -0.151,-0.145,-0.139,-0.133,-0.127,-0.121,-0.115,-0.109,-0.103, & - -0.097,-0.091,-0.085,-0.079,-0.073,-0.067,-0.062,-0.056,-0.050, & - -0.045,-0.039,-0.033,-0.028,-0.022,-0.017,-0.011,-0.006, 0.000, & - & 0.005, 0.010, 0.016, 0.021, 0.026, 0.032, 0.037, 0.042, 0.048, & - & 0.053, 0.058, 0.063, 0.068, 0.073, 0.079, 0.084, 0.089, 0.094, & - & 0.099, 0.104, 0.109, 0.114, 0.119, 0.124, 0.129, 0.134, 0.138, & - & 0.143, 0.148, 0.153, 0.158, 0.163, 0.167, 0.172, 0.177, 0.182, & - & 0.186, 0.191, 0.196, 0.201, 0.205, 0.210, 0.215, 0.219, 0.224, & - & 0.228, 0.233, 0.238, 0.242, 0.247, 0.251, 0.256, 0.260, 0.265, & - & 0.269, 0.274, 0.278, 0.283, 0.287, 0.291, 0.296, 0.300, 0.305, & - & 0.309, 0.313, 0.318, 0.322, 0.326, 0.331, 0.335, 0.339, 0.344, & - & 0.348, 0.352, 0.357, 0.361, 0.365, 0.369, 0.374, 0.378, 0.382, & - & 0.386, 0.390, 0.395, 0.399, 0.403, 0.407, 0.411, 0.415, 0.419, & - & 0.424, 0.428, 0.432, 0.436, 0.440, 0.444, 0.448, 0.452, 0.456, & - & 0.460, 0.464, 0.468, 0.472, 0.476, 0.480, 0.484, 0.488, 0.492, & - & 0.496, 0.500, 0.504, 0.508, 0.512, 0.516, 0.520, 0.524, 0.528, & - & 0.532, 0.536, 0.540 & - / - -! *** CASO4 - - DATA BNC14M/ & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000 & - / - -! *** CANO32 - - DATA BNC15M/ & - -0.090,-0.191,-0.239,-0.271,-0.296,-0.316,-0.332,-0.346,-0.358, & - -0.368,-0.378,-0.386,-0.393,-0.400,-0.405,-0.411,-0.416,-0.420, & - -0.424,-0.428,-0.431,-0.434,-0.437,-0.440,-0.442,-0.444,-0.446, & - -0.448,-0.450,-0.451,-0.453,-0.454,-0.455,-0.456,-0.457,-0.458, & - -0.459,-0.460,-0.460,-0.461,-0.461,-0.462,-0.462,-0.463,-0.463, & - -0.463,-0.463,-0.463,-0.464,-0.464,-0.464,-0.464,-0.464,-0.464, & - -0.464,-0.463,-0.463,-0.463,-0.463,-0.463,-0.462,-0.462,-0.462, & - -0.462,-0.461,-0.461,-0.460,-0.460,-0.460,-0.459,-0.459,-0.458, & - -0.458,-0.457,-0.457,-0.456,-0.455,-0.455,-0.454,-0.454,-0.453, & - -0.452,-0.451,-0.451,-0.450,-0.449,-0.448,-0.448,-0.447,-0.446, & - -0.445,-0.444,-0.443,-0.442,-0.441,-0.440,-0.439,-0.439,-0.438, & - -0.437,-0.435,-0.434,-0.433,-0.432,-0.431,-0.430,-0.429,-0.428, & - -0.427,-0.426,-0.425,-0.423,-0.422,-0.421,-0.420,-0.419,-0.417, & - -0.416,-0.415,-0.414,-0.413,-0.411,-0.410,-0.409,-0.408,-0.406, & - -0.405,-0.404,-0.403,-0.401,-0.400,-0.399,-0.398,-0.396,-0.395, & - -0.394,-0.392,-0.391,-0.390,-0.388,-0.387,-0.386,-0.385,-0.383, & - -0.382,-0.381,-0.379,-0.378,-0.377,-0.375,-0.374,-0.373,-0.371, & - -0.370,-0.369,-0.367,-0.366,-0.365,-0.363,-0.362,-0.361,-0.359, & - -0.358,-0.357,-0.355,-0.354,-0.353,-0.351,-0.350,-0.349,-0.347, & - -0.346,-0.345,-0.343,-0.342,-0.341,-0.339,-0.338,-0.337,-0.335, & - -0.334,-0.333,-0.331,-0.330,-0.328,-0.327,-0.326,-0.324,-0.323, & - -0.322,-0.320,-0.319,-0.318,-0.316,-0.315,-0.314,-0.312,-0.311, & - -0.310,-0.308,-0.307,-0.306,-0.304,-0.303,-0.301,-0.300,-0.299, & - -0.297,-0.296,-0.295,-0.293,-0.292,-0.291,-0.289,-0.288,-0.287, & - -0.285,-0.284,-0.283,-0.281,-0.280,-0.279,-0.277,-0.276,-0.275, & - -0.273,-0.272,-0.271,-0.269,-0.268,-0.267,-0.265,-0.264,-0.263, & - -0.261,-0.260,-0.259,-0.257,-0.256,-0.255,-0.253,-0.252,-0.251, & - -0.249,-0.248,-0.247,-0.245,-0.244,-0.243,-0.241,-0.240,-0.239, & - -0.237,-0.236,-0.235,-0.233,-0.232,-0.231,-0.230,-0.228,-0.227, & - -0.226,-0.224,-0.223,-0.222,-0.220,-0.219,-0.218,-0.216,-0.215, & - -0.214,-0.213,-0.211,-0.210,-0.209,-0.207,-0.206,-0.205,-0.203, & - -0.202,-0.201,-0.200,-0.198,-0.197,-0.196,-0.194,-0.193,-0.192, & - -0.191,-0.189,-0.188,-0.187,-0.185,-0.184,-0.183,-0.182,-0.180, & - -0.179,-0.178,-0.176,-0.175,-0.174,-0.173,-0.171,-0.170,-0.169, & - -0.167,-0.166,-0.165,-0.164,-0.162,-0.161,-0.160,-0.159,-0.157, & - -0.156,-0.155,-0.154,-0.152,-0.151,-0.150,-0.149,-0.147,-0.146, & - -0.145,-0.144,-0.142,-0.141,-0.140,-0.139,-0.137,-0.136,-0.135, & - -0.134,-0.132,-0.131,-0.130,-0.129,-0.127,-0.126,-0.125,-0.124, & - -0.122,-0.121,-0.120,-0.119,-0.117,-0.116,-0.115,-0.114,-0.113, & - -0.111,-0.110,-0.109,-0.108,-0.106,-0.105,-0.104,-0.103,-0.102, & - -0.100,-0.099,-0.098,-0.097,-0.095,-0.094,-0.093,-0.092,-0.091, & - -0.089,-0.088,-0.087,-0.086,-0.085,-0.083,-0.082,-0.081,-0.080, & - -0.079,-0.077,-0.076,-0.075,-0.074,-0.073,-0.071,-0.070,-0.069, & - -0.068,-0.067,-0.065,-0.064,-0.063,-0.062,-0.061,-0.059,-0.058, & - -0.057,-0.056,-0.055,-0.054,-0.041,-0.029,-0.018,-0.006, 0.005, & - & 0.017, 0.028, 0.039, 0.050, 0.061, 0.072, 0.083, 0.094, 0.104, & - & 0.115, 0.125, 0.136, 0.146, 0.156, 0.167, 0.177, 0.187, 0.197, & - & 0.207, 0.217, 0.227, 0.236, 0.246, 0.256, 0.265, 0.275, 0.284, & - & 0.294, 0.303, 0.312, 0.322, 0.331, 0.340, 0.349, 0.358, 0.367, & - & 0.376, 0.385, 0.394, 0.403, 0.411, 0.420, 0.429, 0.437, 0.446, & - & 0.455, 0.463, 0.472, 0.480, 0.488, 0.497, 0.505, 0.513, 0.521, & - & 0.530, 0.538, 0.546, 0.554, 0.562, 0.570, 0.578, 0.586, 0.594, & - & 0.602, 0.610, 0.617, 0.625, 0.633, 0.641, 0.648, 0.656, 0.664, & - & 0.671, 0.679, 0.686, 0.694, 0.701, 0.709, 0.716, 0.723, 0.731, & - & 0.738, 0.745, 0.753, 0.760, 0.767, 0.774, 0.782, 0.789, 0.796, & - & 0.803, 0.810, 0.817, 0.824, 0.831, 0.838, 0.845, 0.852, 0.859, & - & 0.866, 0.873, 0.880, 0.886, 0.893, 0.900, 0.907, 0.914, 0.920, & - & 0.927, 0.934, 0.940, 0.947, 0.954, 0.960, 0.967, 0.973, 0.980, & - & 0.987, 0.993, 1.000, 1.006, 1.013, 1.019, 1.025, 1.032, 1.038, & - & 1.045, 1.051, 1.057, 1.064, 1.070, 1.076, 1.083, 1.089, 1.095, & - & 1.101, 1.108, 1.114, 1.120, 1.126, 1.132, 1.139, 1.145, 1.151, & - & 1.157, 1.163, 1.169, 1.175, 1.181, 1.187, 1.193, 1.199, 1.205, & - & 1.211, 1.217, 1.223 & - / - -! *** CACL2 - - DATA BNC16M/ & - -0.088,-0.184,-0.228,-0.256,-0.277,-0.293,-0.305,-0.315,-0.323, & - -0.330,-0.335,-0.340,-0.343,-0.346,-0.349,-0.350,-0.352,-0.353, & - -0.353,-0.353,-0.353,-0.353,-0.352,-0.352,-0.351,-0.349,-0.348, & - -0.347,-0.345,-0.343,-0.341,-0.339,-0.337,-0.335,-0.333,-0.331, & - -0.328,-0.326,-0.324,-0.321,-0.318,-0.316,-0.313,-0.311,-0.308, & - -0.305,-0.302,-0.299,-0.297,-0.294,-0.291,-0.288,-0.285,-0.282, & - -0.279,-0.276,-0.273,-0.270,-0.267,-0.264,-0.261,-0.258,-0.255, & - -0.252,-0.249,-0.246,-0.243,-0.239,-0.236,-0.233,-0.230,-0.227, & - -0.223,-0.220,-0.217,-0.214,-0.210,-0.207,-0.203,-0.200,-0.197, & - -0.193,-0.190,-0.186,-0.183,-0.179,-0.176,-0.172,-0.168,-0.165, & - -0.161,-0.158,-0.154,-0.150,-0.146,-0.143,-0.139,-0.135,-0.131, & - -0.127,-0.123,-0.119,-0.115,-0.111,-0.107,-0.103,-0.099,-0.095, & - -0.091,-0.087,-0.083,-0.079,-0.075,-0.071,-0.067,-0.063,-0.059, & - -0.055,-0.050,-0.046,-0.042,-0.038,-0.034,-0.030,-0.026,-0.021, & - -0.017,-0.013,-0.009,-0.005, 0.000, 0.004, 0.008, 0.012, 0.016, & - & 0.020, 0.025, 0.029, 0.033, 0.037, 0.041, 0.046, 0.050, 0.054, & - & 0.058, 0.062, 0.066, 0.071, 0.075, 0.079, 0.083, 0.087, 0.091, & - & 0.095, 0.100, 0.104, 0.108, 0.112, 0.116, 0.120, 0.124, 0.128, & - & 0.133, 0.137, 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, 0.165, & - & 0.169, 0.174, 0.178, 0.182, 0.186, 0.190, 0.194, 0.198, 0.202, & - & 0.206, 0.210, 0.214, 0.218, 0.222, 0.226, 0.230, 0.234, 0.238, & - & 0.242, 0.246, 0.250, 0.254, 0.258, 0.262, 0.266, 0.270, 0.274, & - & 0.278, 0.282, 0.286, 0.290, 0.294, 0.298, 0.302, 0.306, 0.310, & - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.333, 0.337, 0.341, 0.345, & - & 0.349, 0.353, 0.356, 0.360, 0.364, 0.368, 0.372, 0.376, 0.380, & - & 0.383, 0.387, 0.391, 0.395, 0.399, 0.403, 0.406, 0.410, 0.414, & - & 0.418, 0.422, 0.425, 0.429, 0.433, 0.437, 0.440, 0.444, 0.448, & - & 0.452, 0.455, 0.459, 0.463, 0.467, 0.470, 0.474, 0.478, 0.482, & - & 0.485, 0.489, 0.493, 0.496, 0.500, 0.504, 0.507, 0.511, 0.515, & - & 0.518, 0.522, 0.526, 0.529, 0.533, 0.537, 0.540, 0.544, 0.548, & - & 0.551, 0.555, 0.558, 0.562, 0.566, 0.569, 0.573, 0.576, 0.580, & - & 0.584, 0.587, 0.591, 0.594, 0.598, 0.601, 0.605, 0.609, 0.612, & - & 0.616, 0.619, 0.623, 0.626, 0.630, 0.633, 0.637, 0.640, 0.644, & - & 0.647, 0.651, 0.654, 0.658, 0.661, 0.665, 0.668, 0.672, 0.675, & - & 0.678, 0.682, 0.685, 0.689, 0.692, 0.696, 0.699, 0.703, 0.706, & - & 0.709, 0.713, 0.716, 0.720, 0.723, 0.726, 0.730, 0.733, 0.737, & - & 0.740, 0.743, 0.747, 0.750, 0.753, 0.757, 0.760, 0.763, 0.767, & - & 0.770, 0.773, 0.777, 0.780, 0.783, 0.787, 0.790, 0.793, 0.797, & - & 0.800, 0.803, 0.807, 0.810, 0.813, 0.816, 0.820, 0.823, 0.826, & - & 0.829, 0.833, 0.836, 0.839, 0.842, 0.846, 0.849, 0.852, 0.855, & - & 0.859, 0.862, 0.865, 0.868, 0.871, 0.875, 0.878, 0.881, 0.884, & - & 0.887, 0.891, 0.894, 0.897, 0.900, 0.903, 0.906, 0.910, 0.913, & - & 0.916, 0.919, 0.922, 0.925, 0.928, 0.932, 0.935, 0.938, 0.941, & - & 0.944, 0.947, 0.950, 0.953, 0.957, 0.960, 0.963, 0.966, 0.969, & - & 0.972, 0.975, 0.978, 0.981, 1.014, 1.044, 1.074, 1.103, 1.132, & - & 1.161, 1.189, 1.218, 1.245, 1.273, 1.300, 1.327, 1.353, 1.380, & - & 1.406, 1.431, 1.457, 1.482, 1.507, 1.532, 1.556, 1.580, 1.604, & - & 1.628, 1.652, 1.675, 1.698, 1.721, 1.744, 1.766, 1.788, 1.811, & - & 1.832, 1.854, 1.876, 1.897, 1.918, 1.939, 1.960, 1.981, 2.001, & - & 2.022, 2.042, 2.062, 2.082, 2.101, 2.121, 2.140, 2.160, 2.179, & - & 2.198, 2.217, 2.235, 2.254, 2.273, 2.291, 2.309, 2.327, 2.345, & - & 2.363, 2.381, 2.398, 2.416, 2.433, 2.451, 2.468, 2.485, 2.502, & - & 2.519, 2.535, 2.552, 2.569, 2.585, 2.601, 2.618, 2.634, 2.650, & - & 2.666, 2.682, 2.698, 2.713, 2.729, 2.745, 2.760, 2.775, 2.791, & - & 2.806, 2.821, 2.836, 2.851, 2.866, 2.881, 2.895, 2.910, 2.925, & - & 2.939, 2.954, 2.968, 2.982, 2.997, 3.011, 3.025, 3.039, 3.053, & - & 3.067, 3.081, 3.094, 3.108, 3.122, 3.135, 3.149, 3.162, 3.176, & - & 3.189, 3.202, 3.216, 3.229, 3.242, 3.255, 3.268, 3.281, 3.294, & - & 3.307, 3.319, 3.332, 3.345, 3.357, 3.370, 3.383, 3.395, 3.407, & - & 3.420, 3.432, 3.444, 3.457, 3.469, 3.481, 3.493, 3.505, 3.517, & - & 3.529, 3.541, 3.553, 3.565, 3.577, 3.588, 3.600, 3.612, 3.623, & - & 3.635, 3.646, 3.658, 3.669, 3.681, 3.692, 3.704, 3.715, 3.726, & - & 3.737, 3.748, 3.760 & - / - -! *** K2SO4 - - DATA BNC17M/ & - -0.091,-0.197,-0.249,-0.286,-0.315,-0.339,-0.359,-0.377,-0.392, & - -0.406,-0.419,-0.431,-0.442,-0.452,-0.461,-0.470,-0.478,-0.486, & - -0.493,-0.500,-0.507,-0.513,-0.519,-0.525,-0.530,-0.535,-0.540, & - -0.545,-0.550,-0.554,-0.559,-0.563,-0.567,-0.571,-0.575,-0.579, & - -0.582,-0.586,-0.589,-0.592,-0.596,-0.599,-0.602,-0.605,-0.608, & - -0.611,-0.613,-0.616,-0.619,-0.621,-0.624,-0.626,-0.628,-0.631, & - -0.633,-0.635,-0.637,-0.640,-0.642,-0.644,-0.646,-0.648,-0.650, & - -0.652,-0.653,-0.655,-0.657,-0.659,-0.661,-0.662,-0.664,-0.666, & - -0.667,-0.669,-0.670,-0.672,-0.673,-0.675,-0.676,-0.678,-0.679, & - -0.681,-0.682,-0.683,-0.685,-0.686,-0.687,-0.689,-0.690,-0.691, & - -0.693,-0.694,-0.695,-0.696,-0.697,-0.699,-0.700,-0.701,-0.702, & - -0.703,-0.704,-0.705,-0.707,-0.708,-0.709,-0.710,-0.711,-0.712, & - -0.713,-0.714,-0.715,-0.716,-0.717,-0.718,-0.719,-0.720,-0.721, & - -0.722,-0.723,-0.724,-0.724,-0.725,-0.726,-0.727,-0.728,-0.729, & - -0.730,-0.731,-0.731,-0.732,-0.733,-0.734,-0.735,-0.735,-0.736, & - -0.737,-0.738,-0.738,-0.739,-0.740,-0.741,-0.741,-0.742,-0.743, & - -0.744,-0.744,-0.745,-0.746,-0.746,-0.747,-0.748,-0.748,-0.749, & - -0.750,-0.750,-0.751,-0.752,-0.752,-0.753,-0.754,-0.754,-0.755, & - -0.755,-0.756,-0.757,-0.757,-0.758,-0.758,-0.759,-0.759,-0.760, & - -0.761,-0.761,-0.762,-0.762,-0.763,-0.763,-0.764,-0.764,-0.765, & - -0.765,-0.766,-0.766,-0.767,-0.767,-0.768,-0.768,-0.769,-0.769, & - -0.770,-0.770,-0.771,-0.771,-0.772,-0.772,-0.772,-0.773,-0.773, & - -0.774,-0.774,-0.775,-0.775,-0.776,-0.776,-0.776,-0.777,-0.777, & - -0.778,-0.778,-0.778,-0.779,-0.779,-0.780,-0.780,-0.780,-0.781, & - -0.781,-0.781,-0.782,-0.782,-0.783,-0.783,-0.783,-0.784,-0.784, & - -0.784,-0.785,-0.785,-0.785,-0.786,-0.786,-0.786,-0.787,-0.787, & - -0.787,-0.788,-0.788,-0.788,-0.789,-0.789,-0.789,-0.790,-0.790, & - -0.790,-0.790,-0.791,-0.791,-0.791,-0.792,-0.792,-0.792,-0.793, & - -0.793,-0.793,-0.793,-0.794,-0.794,-0.794,-0.794,-0.795,-0.795, & - -0.795,-0.795,-0.796,-0.796,-0.796,-0.796,-0.797,-0.797,-0.797, & - -0.797,-0.798,-0.798,-0.798,-0.798,-0.799,-0.799,-0.799,-0.799, & - -0.800,-0.800,-0.800,-0.800,-0.800,-0.801,-0.801,-0.801,-0.801, & - -0.801,-0.802,-0.802,-0.802,-0.802,-0.802,-0.803,-0.803,-0.803, & - -0.803,-0.803,-0.804,-0.804,-0.804,-0.804,-0.804,-0.804,-0.805, & - -0.805,-0.805,-0.805,-0.805,-0.806,-0.806,-0.806,-0.806,-0.806, & - -0.806,-0.806,-0.807,-0.807,-0.807,-0.807,-0.807,-0.807,-0.808, & - -0.808,-0.808,-0.808,-0.808,-0.808,-0.808,-0.809,-0.809,-0.809, & - -0.809,-0.809,-0.809,-0.809,-0.810,-0.810,-0.810,-0.810,-0.810, & - -0.810,-0.810,-0.810,-0.810,-0.811,-0.811,-0.811,-0.811,-0.811, & - -0.811,-0.811,-0.811,-0.812,-0.812,-0.812,-0.812,-0.812,-0.812, & - -0.812,-0.812,-0.812,-0.812,-0.813,-0.813,-0.813,-0.813,-0.813, & - -0.813,-0.813,-0.813,-0.813,-0.813,-0.813,-0.814,-0.814,-0.814, & - -0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814,-0.814, & - -0.814,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815,-0.815, & - -0.815,-0.815,-0.815,-0.815,-0.816,-0.816,-0.817,-0.817,-0.817, & - -0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.817,-0.816,-0.816, & - -0.816,-0.815,-0.815,-0.814,-0.813,-0.813,-0.812,-0.811,-0.811, & - -0.810,-0.809,-0.808,-0.807,-0.806,-0.805,-0.804,-0.803,-0.802, & - -0.801,-0.800,-0.799,-0.797,-0.796,-0.795,-0.794,-0.792,-0.791, & - -0.790,-0.788,-0.787,-0.786,-0.784,-0.783,-0.781,-0.780,-0.778, & - -0.777,-0.775,-0.774,-0.772,-0.771,-0.769,-0.767,-0.766,-0.764, & - -0.762,-0.761,-0.759,-0.757,-0.756,-0.754,-0.752,-0.750,-0.749, & - -0.747,-0.745,-0.743,-0.741,-0.740,-0.738,-0.736,-0.734,-0.732, & - -0.730,-0.728,-0.727,-0.725,-0.723,-0.721,-0.719,-0.717,-0.715, & - -0.713,-0.711,-0.709,-0.707,-0.705,-0.703,-0.701,-0.699,-0.697, & - -0.695,-0.693,-0.691,-0.689,-0.687,-0.685,-0.683,-0.681,-0.678, & - -0.676,-0.674,-0.672,-0.670,-0.668,-0.666,-0.664,-0.661,-0.659, & - -0.657,-0.655,-0.653,-0.651,-0.648,-0.646,-0.644,-0.642,-0.640, & - -0.638,-0.635,-0.633,-0.631,-0.629,-0.626,-0.624,-0.622,-0.620, & - -0.618,-0.615,-0.613,-0.611,-0.609,-0.606,-0.604,-0.602,-0.599, & - -0.597,-0.595,-0.593,-0.590,-0.588,-0.586,-0.583,-0.581,-0.579, & - -0.577,-0.574,-0.572,-0.570,-0.567,-0.565,-0.563,-0.560,-0.558, & - -0.556,-0.553,-0.551 & - / - -! *** KHSO4 - - DATA BNC18M/ & - -0.045,-0.094,-0.118,-0.134,-0.147,-0.156,-0.165,-0.171,-0.177, & - -0.182,-0.187,-0.191,-0.195,-0.198,-0.200,-0.203,-0.205,-0.207, & - -0.209,-0.210,-0.212,-0.213,-0.214,-0.215,-0.215,-0.216,-0.216, & - -0.216,-0.217,-0.217,-0.217,-0.217,-0.216,-0.216,-0.216,-0.215, & - -0.214,-0.214,-0.213,-0.212,-0.211,-0.210,-0.209,-0.208,-0.207, & - -0.206,-0.205,-0.204,-0.202,-0.201,-0.199,-0.198,-0.196,-0.195, & - -0.193,-0.191,-0.190,-0.188,-0.186,-0.184,-0.183,-0.181,-0.179, & - -0.177,-0.175,-0.173,-0.171,-0.169,-0.167,-0.165,-0.163,-0.160, & - -0.158,-0.156,-0.154,-0.152,-0.149,-0.147,-0.145,-0.142,-0.140, & - -0.137,-0.135,-0.133,-0.130,-0.128,-0.125,-0.123,-0.120,-0.117, & - -0.115,-0.112,-0.109,-0.107,-0.104,-0.101,-0.099,-0.096,-0.093, & - -0.090,-0.088,-0.085,-0.082,-0.079,-0.076,-0.074,-0.071,-0.068, & - -0.065,-0.062,-0.059,-0.056,-0.053,-0.050,-0.047,-0.044,-0.042, & - -0.039,-0.036,-0.033,-0.030,-0.027,-0.024,-0.021,-0.018,-0.015, & - -0.012,-0.009,-0.006,-0.003, 0.000, 0.003, 0.006, 0.009, 0.012, & - & 0.015, 0.018, 0.020, 0.023, 0.026, 0.029, 0.032, 0.035, 0.038, & - & 0.041, 0.044, 0.047, 0.050, 0.053, 0.055, 0.058, 0.061, 0.064, & - & 0.067, 0.070, 0.073, 0.076, 0.078, 0.081, 0.084, 0.087, 0.090, & - & 0.093, 0.095, 0.098, 0.101, 0.104, 0.107, 0.109, 0.112, 0.115, & - & 0.118, 0.121, 0.123, 0.126, 0.129, 0.132, 0.134, 0.137, 0.140, & - & 0.143, 0.145, 0.148, 0.151, 0.153, 0.156, 0.159, 0.162, 0.164, & - & 0.167, 0.170, 0.172, 0.175, 0.178, 0.180, 0.183, 0.186, 0.188, & - & 0.191, 0.193, 0.196, 0.199, 0.201, 0.204, 0.206, 0.209, 0.212, & - & 0.214, 0.217, 0.219, 0.222, 0.225, 0.227, 0.230, 0.232, 0.235, & - & 0.237, 0.240, 0.242, 0.245, 0.247, 0.250, 0.252, 0.255, 0.257, & - & 0.260, 0.262, 0.265, 0.267, 0.270, 0.272, 0.275, 0.277, 0.280, & - & 0.282, 0.285, 0.287, 0.289, 0.292, 0.294, 0.297, 0.299, 0.302, & - & 0.304, 0.306, 0.309, 0.311, 0.314, 0.316, 0.318, 0.321, 0.323, & - & 0.325, 0.328, 0.330, 0.333, 0.335, 0.337, 0.340, 0.342, 0.344, & - & 0.347, 0.349, 0.351, 0.354, 0.356, 0.358, 0.360, 0.363, 0.365, & - & 0.367, 0.370, 0.372, 0.374, 0.376, 0.379, 0.381, 0.383, 0.386, & - & 0.388, 0.390, 0.392, 0.395, 0.397, 0.399, 0.401, 0.403, 0.406, & - & 0.408, 0.410, 0.412, 0.415, 0.417, 0.419, 0.421, 0.423, 0.425, & - & 0.428, 0.430, 0.432, 0.434, 0.436, 0.439, 0.441, 0.443, 0.445, & - & 0.447, 0.449, 0.451, 0.454, 0.456, 0.458, 0.460, 0.462, 0.464, & - & 0.466, 0.468, 0.471, 0.473, 0.475, 0.477, 0.479, 0.481, 0.483, & - & 0.485, 0.487, 0.489, 0.491, 0.494, 0.496, 0.498, 0.500, 0.502, & - & 0.504, 0.506, 0.508, 0.510, 0.512, 0.514, 0.516, 0.518, 0.520, & - & 0.522, 0.524, 0.526, 0.528, 0.530, 0.532, 0.534, 0.536, 0.538, & - & 0.540, 0.542, 0.544, 0.546, 0.548, 0.550, 0.552, 0.554, 0.556, & - & 0.558, 0.560, 0.562, 0.564, 0.566, 0.568, 0.570, 0.572, 0.574, & - & 0.576, 0.578, 0.580, 0.582, 0.584, 0.585, 0.587, 0.589, 0.591, & - & 0.593, 0.595, 0.597, 0.599, 0.601, 0.603, 0.605, 0.607, 0.608, & - & 0.610, 0.612, 0.614, 0.616, 0.618, 0.620, 0.622, 0.623, 0.625, & - & 0.627, 0.629, 0.631, 0.633, 0.653, 0.671, 0.689, 0.707, 0.724, & - & 0.741, 0.758, 0.775, 0.792, 0.808, 0.824, 0.840, 0.856, 0.872, & - & 0.887, 0.903, 0.918, 0.933, 0.947, 0.962, 0.977, 0.991, 1.005, & - & 1.019, 1.033, 1.047, 1.060, 1.074, 1.087, 1.101, 1.114, 1.127, & - & 1.140, 1.152, 1.165, 1.178, 1.190, 1.202, 1.215, 1.227, 1.239, & - & 1.251, 1.262, 1.274, 1.286, 1.297, 1.309, 1.320, 1.332, 1.343, & - & 1.354, 1.365, 1.376, 1.387, 1.397, 1.408, 1.419, 1.429, 1.440, & - & 1.450, 1.461, 1.471, 1.481, 1.491, 1.501, 1.511, 1.521, 1.531, & - & 1.541, 1.551, 1.561, 1.570, 1.580, 1.589, 1.599, 1.608, 1.617, & - & 1.627, 1.636, 1.645, 1.654, 1.663, 1.672, 1.681, 1.690, 1.699, & - & 1.708, 1.717, 1.726, 1.734, 1.743, 1.751, 1.760, 1.768, 1.777, & - & 1.785, 1.794, 1.802, 1.810, 1.819, 1.827, 1.835, 1.843, 1.851, & - & 1.859, 1.867, 1.875, 1.883, 1.891, 1.899, 1.907, 1.915, 1.922, & - & 1.930, 1.938, 1.945, 1.953, 1.960, 1.968, 1.976, 1.983, 1.990, & - & 1.998, 2.005, 2.013, 2.020, 2.027, 2.034, 2.042, 2.049, 2.056, & - & 2.063, 2.070, 2.077, 2.084, 2.091, 2.098, 2.105, 2.112, 2.119, & - & 2.126, 2.133, 2.140, 2.147, 2.154, 2.160, 2.167, 2.174, 2.180, & - & 2.187, 2.194, 2.200, 2.207, 2.213, 2.220, 2.227, 2.233, 2.240, & - & 2.246, 2.252, 2.259 & - / - -! *** KNO3 - - DATA BNC19M/ & - -0.046,-0.105,-0.136,-0.159,-0.178,-0.194,-0.208,-0.221,-0.233, & - -0.244,-0.255,-0.265,-0.274,-0.283,-0.291,-0.299,-0.307,-0.315, & - -0.322,-0.329,-0.336,-0.342,-0.349,-0.355,-0.361,-0.367,-0.373, & - -0.379,-0.384,-0.390,-0.395,-0.400,-0.405,-0.410,-0.415,-0.420, & - -0.425,-0.430,-0.434,-0.439,-0.443,-0.447,-0.452,-0.456,-0.460, & - -0.464,-0.468,-0.472,-0.476,-0.480,-0.483,-0.487,-0.491,-0.494, & - -0.498,-0.501,-0.505,-0.508,-0.511,-0.515,-0.518,-0.521,-0.524, & - -0.528,-0.531,-0.534,-0.537,-0.540,-0.543,-0.546,-0.549,-0.552, & - -0.555,-0.557,-0.560,-0.563,-0.566,-0.569,-0.571,-0.574,-0.577, & - -0.580,-0.582,-0.585,-0.588,-0.590,-0.593,-0.596,-0.598,-0.601, & - -0.604,-0.606,-0.609,-0.611,-0.614,-0.616,-0.619,-0.622,-0.624, & - -0.627,-0.629,-0.632,-0.634,-0.637,-0.639,-0.641,-0.644,-0.646, & - -0.649,-0.651,-0.654,-0.656,-0.658,-0.661,-0.663,-0.666,-0.668, & - -0.670,-0.673,-0.675,-0.677,-0.679,-0.682,-0.684,-0.686,-0.688, & - -0.691,-0.693,-0.695,-0.697,-0.699,-0.702,-0.704,-0.706,-0.708, & - -0.710,-0.712,-0.714,-0.716,-0.718,-0.721,-0.723,-0.725,-0.727, & - -0.729,-0.731,-0.733,-0.735,-0.737,-0.739,-0.740,-0.742,-0.744, & - -0.746,-0.748,-0.750,-0.752,-0.754,-0.756,-0.757,-0.759,-0.761, & - -0.763,-0.765,-0.767,-0.768,-0.770,-0.772,-0.774,-0.775,-0.777, & - -0.779,-0.780,-0.782,-0.784,-0.786,-0.787,-0.789,-0.791,-0.792, & - -0.794,-0.796,-0.797,-0.799,-0.800,-0.802,-0.804,-0.805,-0.807, & - -0.808,-0.810,-0.811,-0.813,-0.814,-0.816,-0.817,-0.819,-0.820, & - -0.822,-0.823,-0.825,-0.826,-0.828,-0.829,-0.831,-0.832,-0.834, & - -0.835,-0.836,-0.838,-0.839,-0.841,-0.842,-0.843,-0.845,-0.846, & - -0.847,-0.849,-0.850,-0.851,-0.853,-0.854,-0.855,-0.857,-0.858, & - -0.859,-0.861,-0.862,-0.863,-0.864,-0.866,-0.867,-0.868,-0.869, & - -0.871,-0.872,-0.873,-0.874,-0.875,-0.877,-0.878,-0.879,-0.880, & - -0.881,-0.882,-0.884,-0.885,-0.886,-0.887,-0.888,-0.889,-0.890, & - -0.892,-0.893,-0.894,-0.895,-0.896,-0.897,-0.898,-0.899,-0.900, & - -0.901,-0.902,-0.904,-0.905,-0.906,-0.907,-0.908,-0.909,-0.910, & - -0.911,-0.912,-0.913,-0.914,-0.915,-0.916,-0.917,-0.918,-0.919, & - -0.920,-0.921,-0.922,-0.923,-0.924,-0.925,-0.926,-0.926,-0.927, & - -0.928,-0.929,-0.930,-0.931,-0.932,-0.933,-0.934,-0.935,-0.936, & - -0.936,-0.937,-0.938,-0.939,-0.940,-0.941,-0.942,-0.943,-0.943, & - -0.944,-0.945,-0.946,-0.947,-0.948,-0.948,-0.949,-0.950,-0.951, & - -0.952,-0.953,-0.953,-0.954,-0.955,-0.956,-0.957,-0.957,-0.958, & - -0.959,-0.960,-0.960,-0.961,-0.962,-0.963,-0.963,-0.964,-0.965, & - -0.966,-0.966,-0.967,-0.968,-0.969,-0.969,-0.970,-0.971,-0.971, & - -0.972,-0.973,-0.974,-0.974,-0.975,-0.976,-0.976,-0.977,-0.978, & - -0.978,-0.979,-0.980,-0.980,-0.981,-0.982,-0.982,-0.983,-0.984, & - -0.984,-0.985,-0.986,-0.986,-0.987,-0.988,-0.988,-0.989,-0.989, & - -0.990,-0.991,-0.991,-0.992,-0.992,-0.993,-0.994,-0.994,-0.995, & - -0.995,-0.996,-0.997,-0.997,-0.998,-0.998,-0.999,-1.000,-1.000, & - -1.001,-1.001,-1.002,-1.002,-1.003,-1.003,-1.004,-1.005,-1.005, & - -1.006,-1.006,-1.007,-1.007,-1.013,-1.018,-1.022,-1.027,-1.031, & - -1.035,-1.039,-1.042,-1.046,-1.049,-1.052,-1.055,-1.058,-1.060, & - -1.063,-1.065,-1.067,-1.069,-1.071,-1.073,-1.075,-1.076,-1.078, & - -1.079,-1.081,-1.082,-1.083,-1.084,-1.085,-1.086,-1.087,-1.088, & - -1.088,-1.089,-1.089,-1.090,-1.090,-1.091,-1.091,-1.091,-1.092, & - -1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092,-1.092, & - -1.092,-1.091,-1.091,-1.091,-1.091,-1.090,-1.090,-1.090,-1.089, & - -1.089,-1.088,-1.088,-1.087,-1.087,-1.086,-1.085,-1.085,-1.084, & - -1.084,-1.083,-1.082,-1.082,-1.081,-1.080,-1.079,-1.079,-1.078, & - -1.077,-1.076,-1.075,-1.074,-1.074,-1.073,-1.072,-1.071,-1.070, & - -1.069,-1.068,-1.067,-1.066,-1.065,-1.064,-1.063,-1.062,-1.061, & - -1.060,-1.059,-1.058,-1.057,-1.056,-1.055,-1.054,-1.053,-1.052, & - -1.051,-1.050,-1.049,-1.047,-1.046,-1.045,-1.044,-1.043,-1.042, & - -1.041,-1.040,-1.038,-1.037,-1.036,-1.035,-1.034,-1.032,-1.031, & - -1.030,-1.029,-1.028,-1.026,-1.025,-1.024,-1.023,-1.022,-1.020, & - -1.019,-1.018,-1.017,-1.015,-1.014,-1.013,-1.012,-1.010,-1.009, & - -1.008,-1.007,-1.005,-1.004,-1.003,-1.001,-1.000,-0.999,-0.998, & - -0.996,-0.995,-0.994,-0.992,-0.991,-0.990,-0.989,-0.987,-0.986, & - -0.985,-0.983,-0.982 & - / - -! *** KCL - - DATA BNC20M/ & - -0.045,-0.095,-0.119,-0.136,-0.148,-0.158,-0.166,-0.173,-0.179, & - -0.184,-0.189,-0.193,-0.197,-0.200,-0.203,-0.206,-0.208,-0.210, & - -0.212,-0.214,-0.216,-0.217,-0.219,-0.220,-0.221,-0.222,-0.223, & - -0.224,-0.225,-0.226,-0.227,-0.227,-0.228,-0.229,-0.229,-0.229, & - -0.230,-0.230,-0.231,-0.231,-0.231,-0.231,-0.232,-0.232,-0.232, & - -0.232,-0.232,-0.232,-0.232,-0.232,-0.233,-0.233,-0.233,-0.232, & - -0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232,-0.232, & - -0.232,-0.231,-0.231,-0.231,-0.231,-0.231,-0.230,-0.230,-0.230, & - -0.230,-0.229,-0.229,-0.229,-0.229,-0.228,-0.228,-0.228,-0.227, & - -0.227,-0.227,-0.226,-0.226,-0.226,-0.225,-0.225,-0.224,-0.224, & - -0.224,-0.223,-0.223,-0.222,-0.222,-0.221,-0.221,-0.220,-0.220, & - -0.219,-0.219,-0.218,-0.218,-0.217,-0.217,-0.216,-0.216,-0.215, & - -0.215,-0.214,-0.213,-0.213,-0.212,-0.212,-0.211,-0.211,-0.210, & - -0.209,-0.209,-0.208,-0.208,-0.207,-0.206,-0.206,-0.205,-0.205, & - -0.204,-0.203,-0.203,-0.202,-0.201,-0.201,-0.200,-0.200,-0.199, & - -0.198,-0.198,-0.197,-0.196,-0.196,-0.195,-0.194,-0.194,-0.193, & - -0.192,-0.192,-0.191,-0.191,-0.190,-0.189,-0.189,-0.188,-0.187, & - -0.187,-0.186,-0.185,-0.185,-0.184,-0.183,-0.183,-0.182,-0.181, & - -0.181,-0.180,-0.179,-0.179,-0.178,-0.177,-0.177,-0.176,-0.175, & - -0.175,-0.174,-0.173,-0.173,-0.172,-0.171,-0.171,-0.170,-0.169, & - -0.169,-0.168,-0.167,-0.167,-0.166,-0.165,-0.165,-0.164,-0.163, & - -0.163,-0.162,-0.161,-0.161,-0.160,-0.159,-0.159,-0.158,-0.157, & - -0.157,-0.156,-0.155,-0.155,-0.154,-0.153,-0.153,-0.152,-0.151, & - -0.151,-0.150,-0.149,-0.149,-0.148,-0.147,-0.147,-0.146,-0.145, & - -0.145,-0.144,-0.143,-0.143,-0.142,-0.141,-0.141,-0.140,-0.140, & - -0.139,-0.138,-0.138,-0.137,-0.136,-0.136,-0.135,-0.134,-0.134, & - -0.133,-0.132,-0.132,-0.131,-0.130,-0.130,-0.129,-0.128,-0.128, & - -0.127,-0.126,-0.126,-0.125,-0.124,-0.124,-0.123,-0.122,-0.122, & - -0.121,-0.120,-0.120,-0.119,-0.119,-0.118,-0.117,-0.117,-0.116, & - -0.115,-0.115,-0.114,-0.113,-0.113,-0.112,-0.111,-0.111,-0.110, & - -0.109,-0.109,-0.108,-0.108,-0.107,-0.106,-0.106,-0.105,-0.104, & - -0.104,-0.103,-0.102,-0.102,-0.101,-0.100,-0.100,-0.099,-0.099, & - -0.098,-0.097,-0.097,-0.096,-0.095,-0.095,-0.094,-0.093,-0.093, & - -0.092,-0.092,-0.091,-0.090,-0.090,-0.089,-0.088,-0.088,-0.087, & - -0.087,-0.086,-0.085,-0.085,-0.084,-0.083,-0.083,-0.082,-0.082, & - -0.081,-0.080,-0.080,-0.079,-0.078,-0.078,-0.077,-0.077,-0.076, & - -0.075,-0.075,-0.074,-0.073,-0.073,-0.072,-0.072,-0.071,-0.070, & - -0.070,-0.069,-0.069,-0.068,-0.067,-0.067,-0.066,-0.065,-0.065, & - -0.064,-0.064,-0.063,-0.062,-0.062,-0.061,-0.061,-0.060,-0.059, & - -0.059,-0.058,-0.058,-0.057,-0.056,-0.056,-0.055,-0.055,-0.054, & - -0.053,-0.053,-0.052,-0.051,-0.051,-0.050,-0.050,-0.049,-0.048, & - -0.048,-0.047,-0.047,-0.046,-0.046,-0.045,-0.044,-0.044,-0.043, & - -0.043,-0.042,-0.041,-0.041,-0.040,-0.040,-0.039,-0.038,-0.038, & - -0.037,-0.037,-0.036,-0.035,-0.035,-0.034,-0.034,-0.033,-0.032, & - -0.032,-0.031,-0.031,-0.030,-0.024,-0.018,-0.012,-0.007,-0.001, & - & 0.005, 0.010, 0.016, 0.021, 0.027, 0.032, 0.037, 0.043, 0.048, & - & 0.053, 0.058, 0.064, 0.069, 0.074, 0.079, 0.084, 0.089, 0.094, & - & 0.099, 0.104, 0.109, 0.113, 0.118, 0.123, 0.128, 0.132, 0.137, & - & 0.142, 0.146, 0.151, 0.156, 0.160, 0.165, 0.169, 0.174, 0.178, & - & 0.183, 0.187, 0.191, 0.196, 0.200, 0.205, 0.209, 0.213, 0.217, & - & 0.222, 0.226, 0.230, 0.234, 0.238, 0.242, 0.247, 0.251, 0.255, & - & 0.259, 0.263, 0.267, 0.271, 0.275, 0.279, 0.283, 0.287, 0.291, & - & 0.295, 0.298, 0.302, 0.306, 0.310, 0.314, 0.318, 0.321, 0.325, & - & 0.329, 0.333, 0.337, 0.340, 0.344, 0.348, 0.351, 0.355, 0.359, & - & 0.362, 0.366, 0.370, 0.373, 0.377, 0.380, 0.384, 0.387, 0.391, & - & 0.394, 0.398, 0.401, 0.405, 0.408, 0.412, 0.415, 0.419, 0.422, & - & 0.426, 0.429, 0.433, 0.436, 0.439, 0.443, 0.446, 0.449, 0.453, & - & 0.456, 0.459, 0.463, 0.466, 0.469, 0.473, 0.476, 0.479, 0.482, & - & 0.486, 0.489, 0.492, 0.495, 0.499, 0.502, 0.505, 0.508, 0.511, & - & 0.514, 0.518, 0.521, 0.524, 0.527, 0.530, 0.533, 0.536, 0.540, & - & 0.543, 0.546, 0.549, 0.552, 0.555, 0.558, 0.561, 0.564, 0.567, & - & 0.570, 0.573, 0.576, 0.579, 0.582, 0.585, 0.588, 0.591, 0.594, & - & 0.597, 0.600, 0.603 & - / - -! *** MGSO4 - - DATA BNC21M/ & - -0.181,-0.389,-0.491,-0.562,-0.617,-0.661,-0.699,-0.732,-0.760, & - -0.786,-0.809,-0.829,-0.849,-0.866,-0.882,-0.897,-0.911,-0.924, & - -0.937,-0.948,-0.959,-0.969,-0.979,-0.988,-0.997,-1.006,-1.014, & - -1.021,-1.028,-1.035,-1.042,-1.048,-1.055,-1.061,-1.066,-1.072, & - -1.077,-1.082,-1.087,-1.092,-1.096,-1.100,-1.105,-1.109,-1.113, & - -1.117,-1.120,-1.124,-1.128,-1.131,-1.134,-1.137,-1.141,-1.144, & - -1.146,-1.149,-1.152,-1.155,-1.157,-1.160,-1.162,-1.165,-1.167, & - -1.169,-1.172,-1.174,-1.176,-1.178,-1.180,-1.182,-1.184,-1.186, & - -1.187,-1.189,-1.191,-1.192,-1.194,-1.196,-1.197,-1.199,-1.200, & - -1.202,-1.203,-1.204,-1.206,-1.207,-1.208,-1.209,-1.210,-1.211, & - -1.213,-1.214,-1.215,-1.216,-1.217,-1.218,-1.218,-1.219,-1.220, & - -1.221,-1.222,-1.223,-1.223,-1.224,-1.225,-1.225,-1.226,-1.227, & - -1.227,-1.228,-1.229,-1.229,-1.230,-1.230,-1.231,-1.231,-1.232, & - -1.232,-1.233,-1.233,-1.233,-1.234,-1.234,-1.235,-1.235,-1.235, & - -1.236,-1.236,-1.236,-1.236,-1.237,-1.237,-1.237,-1.237,-1.238, & - -1.238,-1.238,-1.238,-1.238,-1.239,-1.239,-1.239,-1.239,-1.239, & - -1.239,-1.239,-1.239,-1.239,-1.239,-1.240,-1.240,-1.240,-1.240, & - -1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240,-1.240, & - -1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239,-1.239, & - -1.239,-1.239,-1.238,-1.238,-1.238,-1.238,-1.238,-1.238,-1.238, & - -1.237,-1.237,-1.237,-1.237,-1.237,-1.237,-1.236,-1.236,-1.236, & - -1.236,-1.235,-1.235,-1.235,-1.235,-1.235,-1.234,-1.234,-1.234, & - -1.233,-1.233,-1.233,-1.233,-1.232,-1.232,-1.232,-1.232,-1.231, & - -1.231,-1.231,-1.230,-1.230,-1.230,-1.229,-1.229,-1.229,-1.228, & - -1.228,-1.228,-1.227,-1.227,-1.227,-1.226,-1.226,-1.226,-1.225, & - -1.225,-1.225,-1.224,-1.224,-1.223,-1.223,-1.223,-1.222,-1.222, & - -1.222,-1.221,-1.221,-1.220,-1.220,-1.220,-1.219,-1.219,-1.218, & - -1.218,-1.217,-1.217,-1.217,-1.216,-1.216,-1.215,-1.215,-1.214, & - -1.214,-1.214,-1.213,-1.213,-1.212,-1.212,-1.211,-1.211,-1.210, & - -1.210,-1.210,-1.209,-1.209,-1.208,-1.208,-1.207,-1.207,-1.206, & - -1.206,-1.205,-1.205,-1.204,-1.204,-1.203,-1.203,-1.202,-1.202, & - -1.201,-1.201,-1.200,-1.200,-1.199,-1.199,-1.198,-1.198,-1.197, & - -1.197,-1.196,-1.196,-1.195,-1.195,-1.194,-1.194,-1.193,-1.193, & - -1.192,-1.192,-1.191,-1.191,-1.190,-1.190,-1.189,-1.188,-1.188, & - -1.187,-1.187,-1.186,-1.186,-1.185,-1.185,-1.184,-1.184,-1.183, & - -1.182,-1.182,-1.181,-1.181,-1.180,-1.180,-1.179,-1.179,-1.178, & - -1.177,-1.177,-1.176,-1.176,-1.175,-1.175,-1.174,-1.174,-1.173, & - -1.172,-1.172,-1.171,-1.171,-1.170,-1.169,-1.169,-1.168,-1.168, & - -1.167,-1.167,-1.166,-1.165,-1.165,-1.164,-1.164,-1.163,-1.163, & - -1.162,-1.161,-1.161,-1.160,-1.160,-1.159,-1.158,-1.158,-1.157, & - -1.157,-1.156,-1.155,-1.155,-1.154,-1.154,-1.153,-1.152,-1.152, & - -1.151,-1.151,-1.150,-1.149,-1.149,-1.148,-1.148,-1.147,-1.146, & - -1.146,-1.145,-1.144,-1.144,-1.143,-1.143,-1.142,-1.141,-1.141, & - -1.140,-1.140,-1.139,-1.138,-1.138,-1.137,-1.136,-1.136,-1.135, & - -1.135,-1.134,-1.133,-1.133,-1.126,-1.120,-1.113,-1.107,-1.100, & - -1.094,-1.087,-1.080,-1.074,-1.067,-1.060,-1.054,-1.047,-1.040, & - -1.033,-1.027,-1.020,-1.013,-1.006,-0.999,-0.992,-0.985,-0.978, & - -0.971,-0.965,-0.958,-0.951,-0.944,-0.937,-0.930,-0.923,-0.916, & - -0.909,-0.902,-0.895,-0.888,-0.881,-0.874,-0.867,-0.860,-0.853, & - -0.846,-0.839,-0.832,-0.825,-0.818,-0.811,-0.804,-0.797,-0.790, & - -0.783,-0.776,-0.769,-0.762,-0.755,-0.748,-0.741,-0.734,-0.727, & - -0.720,-0.713,-0.706,-0.699,-0.692,-0.685,-0.678,-0.671,-0.664, & - -0.657,-0.650,-0.644,-0.637,-0.630,-0.623,-0.616,-0.609,-0.602, & - -0.595,-0.588,-0.581,-0.574,-0.567,-0.560,-0.554,-0.547,-0.540, & - -0.533,-0.526,-0.519,-0.512,-0.505,-0.498,-0.492,-0.485,-0.478, & - -0.471,-0.464,-0.457,-0.450,-0.444,-0.437,-0.430,-0.423,-0.416, & - -0.409,-0.403,-0.396,-0.389,-0.382,-0.375,-0.369,-0.362,-0.355, & - -0.348,-0.341,-0.335,-0.328,-0.321,-0.314,-0.308,-0.301,-0.294, & - -0.287,-0.280,-0.274,-0.267,-0.260,-0.254,-0.247,-0.240,-0.233, & - -0.227,-0.220,-0.213,-0.206,-0.200,-0.193,-0.186,-0.180,-0.173, & - -0.166,-0.160,-0.153,-0.146,-0.140,-0.133,-0.126,-0.119,-0.113, & - -0.106,-0.100,-0.093,-0.086,-0.080,-0.073,-0.066,-0.060,-0.053, & - -0.046,-0.040,-0.033 & - / - -! *** MGNO32 - - DATA BNC22M/ & - -0.088,-0.185,-0.228,-0.257,-0.278,-0.294,-0.306,-0.317,-0.325, & - -0.332,-0.337,-0.342,-0.346,-0.349,-0.351,-0.353,-0.355,-0.356, & - -0.357,-0.357,-0.357,-0.357,-0.356,-0.356,-0.355,-0.354,-0.353, & - -0.352,-0.350,-0.349,-0.347,-0.345,-0.343,-0.341,-0.339,-0.337, & - -0.335,-0.333,-0.330,-0.328,-0.326,-0.323,-0.321,-0.318,-0.316, & - -0.313,-0.310,-0.308,-0.305,-0.302,-0.300,-0.297,-0.294,-0.291, & - -0.288,-0.286,-0.283,-0.280,-0.277,-0.274,-0.271,-0.268,-0.266, & - -0.263,-0.260,-0.257,-0.254,-0.251,-0.248,-0.245,-0.242,-0.239, & - -0.235,-0.232,-0.229,-0.226,-0.223,-0.220,-0.216,-0.213,-0.210, & - -0.207,-0.203,-0.200,-0.197,-0.193,-0.190,-0.186,-0.183,-0.180, & - -0.176,-0.173,-0.169,-0.165,-0.162,-0.158,-0.155,-0.151,-0.147, & - -0.143,-0.140,-0.136,-0.132,-0.128,-0.125,-0.121,-0.117,-0.113, & - -0.109,-0.105,-0.101,-0.098,-0.094,-0.090,-0.086,-0.082,-0.078, & - -0.074,-0.070,-0.066,-0.062,-0.058,-0.054,-0.050,-0.046,-0.042, & - -0.038,-0.034,-0.030,-0.026,-0.022,-0.018,-0.014,-0.010,-0.006, & - -0.002, 0.002, 0.006, 0.010, 0.014, 0.018, 0.022, 0.026, 0.030, & - & 0.034, 0.038, 0.042, 0.046, 0.050, 0.054, 0.058, 0.062, 0.066, & - & 0.070, 0.074, 0.078, 0.082, 0.086, 0.090, 0.094, 0.098, 0.102, & - & 0.106, 0.110, 0.114, 0.118, 0.122, 0.126, 0.130, 0.134, 0.137, & - & 0.141, 0.145, 0.149, 0.153, 0.157, 0.161, 0.165, 0.169, 0.173, & - & 0.177, 0.180, 0.184, 0.188, 0.192, 0.196, 0.200, 0.204, 0.207, & - & 0.211, 0.215, 0.219, 0.223, 0.227, 0.231, 0.234, 0.238, 0.242, & - & 0.246, 0.250, 0.253, 0.257, 0.261, 0.265, 0.269, 0.272, 0.276, & - & 0.280, 0.284, 0.288, 0.291, 0.295, 0.299, 0.303, 0.306, 0.310, & - & 0.314, 0.318, 0.321, 0.325, 0.329, 0.332, 0.336, 0.340, 0.343, & - & 0.347, 0.351, 0.355, 0.358, 0.362, 0.366, 0.369, 0.373, 0.377, & - & 0.380, 0.384, 0.388, 0.391, 0.395, 0.398, 0.402, 0.406, 0.409, & - & 0.413, 0.417, 0.420, 0.424, 0.427, 0.431, 0.435, 0.438, 0.442, & - & 0.445, 0.449, 0.452, 0.456, 0.459, 0.463, 0.467, 0.470, 0.474, & - & 0.477, 0.481, 0.484, 0.488, 0.491, 0.495, 0.498, 0.502, 0.505, & - & 0.509, 0.512, 0.516, 0.519, 0.523, 0.526, 0.530, 0.533, 0.537, & - & 0.540, 0.543, 0.547, 0.550, 0.554, 0.557, 0.561, 0.564, 0.567, & - & 0.571, 0.574, 0.578, 0.581, 0.584, 0.588, 0.591, 0.595, 0.598, & - & 0.601, 0.605, 0.608, 0.611, 0.615, 0.618, 0.621, 0.625, 0.628, & - & 0.631, 0.635, 0.638, 0.641, 0.645, 0.648, 0.651, 0.655, 0.658, & - & 0.661, 0.665, 0.668, 0.671, 0.674, 0.678, 0.681, 0.684, 0.687, & - & 0.691, 0.694, 0.697, 0.700, 0.704, 0.707, 0.710, 0.713, 0.717, & - & 0.720, 0.723, 0.726, 0.729, 0.733, 0.736, 0.739, 0.742, 0.745, & - & 0.749, 0.752, 0.755, 0.758, 0.761, 0.764, 0.768, 0.771, 0.774, & - & 0.777, 0.780, 0.783, 0.786, 0.790, 0.793, 0.796, 0.799, 0.802, & - & 0.805, 0.808, 0.811, 0.814, 0.818, 0.821, 0.824, 0.827, 0.830, & - & 0.833, 0.836, 0.839, 0.842, 0.845, 0.848, 0.851, 0.854, 0.857, & - & 0.860, 0.864, 0.867, 0.870, 0.873, 0.876, 0.879, 0.882, 0.885, & - & 0.888, 0.891, 0.894, 0.897, 0.900, 0.903, 0.906, 0.909, 0.912, & - & 0.915, 0.918, 0.921, 0.924, 0.955, 0.984, 1.013, 1.041, 1.070, & - & 1.097, 1.125, 1.152, 1.179, 1.205, 1.231, 1.257, 1.283, 1.308, & - & 1.334, 1.359, 1.383, 1.408, 1.432, 1.456, 1.479, 1.503, 1.526, & - & 1.549, 1.572, 1.594, 1.617, 1.639, 1.661, 1.683, 1.704, 1.726, & - & 1.747, 1.768, 1.789, 1.810, 1.830, 1.851, 1.871, 1.891, 1.911, & - & 1.930, 1.950, 1.969, 1.989, 2.008, 2.027, 2.046, 2.064, 2.083, & - & 2.101, 2.120, 2.138, 2.156, 2.174, 2.192, 2.209, 2.227, 2.244, & - & 2.262, 2.279, 2.296, 2.313, 2.330, 2.347, 2.363, 2.380, 2.396, & - & 2.413, 2.429, 2.445, 2.461, 2.477, 2.493, 2.509, 2.525, 2.540, & - & 2.556, 2.571, 2.587, 2.602, 2.617, 2.632, 2.647, 2.662, 2.677, & - & 2.692, 2.707, 2.721, 2.736, 2.750, 2.765, 2.779, 2.793, 2.807, & - & 2.822, 2.836, 2.850, 2.863, 2.877, 2.891, 2.905, 2.918, 2.932, & - & 2.946, 2.959, 2.972, 2.986, 2.999, 3.012, 3.025, 3.039, 3.052, & - & 3.065, 3.078, 3.090, 3.103, 3.116, 3.129, 3.141, 3.154, 3.167, & - & 3.179, 3.191, 3.204, 3.216, 3.229, 3.241, 3.253, 3.265, 3.277, & - & 3.289, 3.301, 3.313, 3.325, 3.337, 3.349, 3.361, 3.372, 3.384, & - & 3.396, 3.407, 3.419, 3.431, 3.442, 3.453, 3.465, 3.476, 3.488, & - & 3.499, 3.510, 3.521, 3.532, 3.544, 3.555, 3.566, 3.577, 3.588, & - & 3.599, 3.610, 3.621 & - / - -! *** MGCL2 - - DATA BNC23M/ & - -0.088,-0.182,-0.225,-0.252,-0.271,-0.286,-0.297,-0.306,-0.313, & - -0.319,-0.323,-0.327,-0.329,-0.331,-0.332,-0.333,-0.333,-0.333, & - -0.333,-0.332,-0.331,-0.329,-0.328,-0.326,-0.324,-0.322,-0.319, & - -0.317,-0.314,-0.312,-0.309,-0.306,-0.303,-0.300,-0.296,-0.293, & - -0.290,-0.286,-0.283,-0.279,-0.276,-0.272,-0.268,-0.265,-0.261, & - -0.257,-0.253,-0.250,-0.246,-0.242,-0.238,-0.234,-0.230,-0.226, & - -0.223,-0.219,-0.215,-0.211,-0.207,-0.203,-0.199,-0.195,-0.191, & - -0.187,-0.183,-0.179,-0.174,-0.170,-0.166,-0.162,-0.158,-0.154, & - -0.150,-0.145,-0.141,-0.137,-0.133,-0.128,-0.124,-0.120,-0.115, & - -0.111,-0.106,-0.102,-0.097,-0.093,-0.088,-0.084,-0.079,-0.074, & - -0.070,-0.065,-0.060,-0.056,-0.051,-0.046,-0.041,-0.036,-0.031, & - -0.027,-0.022,-0.017,-0.012,-0.007,-0.002, 0.003, 0.008, 0.013, & - & 0.019, 0.024, 0.029, 0.034, 0.039, 0.044, 0.049, 0.055, 0.060, & - & 0.065, 0.070, 0.075, 0.081, 0.086, 0.091, 0.096, 0.101, 0.107, & - & 0.112, 0.117, 0.122, 0.128, 0.133, 0.138, 0.143, 0.149, 0.154, & - & 0.159, 0.164, 0.170, 0.175, 0.180, 0.185, 0.190, 0.196, 0.201, & - & 0.206, 0.211, 0.216, 0.222, 0.227, 0.232, 0.237, 0.242, 0.248, & - & 0.253, 0.258, 0.263, 0.268, 0.273, 0.279, 0.284, 0.289, 0.294, & - & 0.299, 0.304, 0.309, 0.314, 0.320, 0.325, 0.330, 0.335, 0.340, & - & 0.345, 0.350, 0.355, 0.360, 0.365, 0.370, 0.375, 0.380, 0.386, & - & 0.391, 0.396, 0.401, 0.406, 0.411, 0.416, 0.421, 0.426, 0.431, & - & 0.436, 0.441, 0.446, 0.450, 0.455, 0.460, 0.465, 0.470, 0.475, & - & 0.480, 0.485, 0.490, 0.495, 0.500, 0.505, 0.509, 0.514, 0.519, & - & 0.524, 0.529, 0.534, 0.539, 0.543, 0.548, 0.553, 0.558, 0.563, & - & 0.568, 0.572, 0.577, 0.582, 0.587, 0.592, 0.596, 0.601, 0.606, & - & 0.611, 0.615, 0.620, 0.625, 0.629, 0.634, 0.639, 0.644, 0.648, & - & 0.653, 0.658, 0.662, 0.667, 0.672, 0.676, 0.681, 0.686, 0.690, & - & 0.695, 0.700, 0.704, 0.709, 0.713, 0.718, 0.723, 0.727, 0.732, & - & 0.736, 0.741, 0.745, 0.750, 0.754, 0.759, 0.764, 0.768, 0.773, & - & 0.777, 0.782, 0.786, 0.791, 0.795, 0.800, 0.804, 0.809, 0.813, & - & 0.817, 0.822, 0.826, 0.831, 0.835, 0.840, 0.844, 0.848, 0.853, & - & 0.857, 0.862, 0.866, 0.870, 0.875, 0.879, 0.884, 0.888, 0.892, & - & 0.897, 0.901, 0.905, 0.910, 0.914, 0.918, 0.923, 0.927, 0.931, & - & 0.935, 0.940, 0.944, 0.948, 0.953, 0.957, 0.961, 0.965, 0.970, & - & 0.974, 0.978, 0.982, 0.986, 0.991, 0.995, 0.999, 1.003, 1.007, & - & 1.012, 1.016, 1.020, 1.024, 1.028, 1.032, 1.037, 1.041, 1.045, & - & 1.049, 1.053, 1.057, 1.061, 1.065, 1.070, 1.074, 1.078, 1.082, & - & 1.086, 1.090, 1.094, 1.098, 1.102, 1.106, 1.110, 1.114, 1.118, & - & 1.122, 1.126, 1.130, 1.134, 1.138, 1.142, 1.146, 1.150, 1.154, & - & 1.158, 1.162, 1.166, 1.170, 1.174, 1.178, 1.182, 1.186, 1.190, & - & 1.194, 1.198, 1.202, 1.206, 1.210, 1.214, 1.217, 1.221, 1.225, & - & 1.229, 1.233, 1.237, 1.241, 1.245, 1.248, 1.252, 1.256, 1.260, & - & 1.264, 1.268, 1.271, 1.275, 1.279, 1.283, 1.287, 1.290, 1.294, & - & 1.298, 1.302, 1.306, 1.309, 1.313, 1.317, 1.321, 1.324, 1.328, & - & 1.332, 1.336, 1.339, 1.343, 1.383, 1.420, 1.456, 1.491, 1.527, & - & 1.561, 1.596, 1.630, 1.663, 1.696, 1.729, 1.761, 1.793, 1.825, & - & 1.856, 1.887, 1.918, 1.948, 1.978, 2.008, 2.037, 2.066, 2.095, & - & 2.123, 2.152, 2.180, 2.207, 2.235, 2.262, 2.289, 2.315, 2.342, & - & 2.368, 2.394, 2.419, 2.445, 2.470, 2.495, 2.520, 2.544, 2.569, & - & 2.593, 2.617, 2.641, 2.664, 2.688, 2.711, 2.734, 2.757, 2.780, & - & 2.802, 2.824, 2.847, 2.869, 2.890, 2.912, 2.934, 2.955, 2.976, & - & 2.997, 3.018, 3.039, 3.060, 3.080, 3.101, 3.121, 3.141, 3.161, & - & 3.181, 3.201, 3.220, 3.240, 3.259, 3.279, 3.298, 3.317, 3.336, & - & 3.354, 3.373, 3.392, 3.410, 3.428, 3.447, 3.465, 3.483, 3.501, & - & 3.519, 3.536, 3.554, 3.572, 3.589, 3.606, 3.624, 3.641, 3.658, & - & 3.675, 3.692, 3.709, 3.725, 3.742, 3.759, 3.775, 3.791, 3.808, & - & 3.824, 3.840, 3.856, 3.872, 3.888, 3.904, 3.920, 3.935, 3.951, & - & 3.967, 3.982, 3.997, 4.013, 4.028, 4.043, 4.058, 4.074, 4.089, & - & 4.103, 4.118, 4.133, 4.148, 4.163, 4.177, 4.192, 4.206, 4.221, & - & 4.235, 4.249, 4.264, 4.278, 4.292, 4.306, 4.320, 4.334, 4.348, & - & 4.362, 4.376, 4.390, 4.403, 4.417, 4.431, 4.444, 4.458, 4.471, & - & 4.484, 4.498, 4.511, 4.524, 4.538, 4.551, 4.564, 4.577, 4.590, & - & 4.603, 4.616, 4.629 & - / - -! *** END OF BLOCK DATA EXPON ****************************************** - - END - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE CHRBLN -!C Purpose : Position of last non-blank character in a string -!C Author : Athanasios Nenes -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C STR is the CHARACTER variable containing the string examined -!C IBLK is a INTEGER variable containing the position of last non -!C blank character. If string is all spaces (ie ' '), then -!C the value returned is 1. -!C -!C EXAMPLE: -!C STR = 'TEST1.DAT ' -!C CALL CHRBLN (STR, IBLK) -!C -!C after execution of this code segment, "IBLK" has the value "9", which -!C is the position of the last non-blank character of "STR". -!C -!C*********************************************************************** -!C - SUBROUTINE CHRBLN (STR, IBLK) -!C -!C*********************************************************************** - IMPLICIT INTEGER (I-N) - CHARACTER*(*) STR - - IBLK = 1 ! Substring pointer (default=1) - ILEN = LEN(STR) ! Length of string - DO 10 i=ILEN,1,-1 - IF (STR(i:i) /= ' ' .AND. STR(i:i) /= CHAR(0)) THEN - IBLK = i - RETURN - ENDIF - 10 END DO - RETURN - - END SUBROUTINE CHRBLN - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE SHFTRGHT -!C Purpose : RIGHT-JUSTIFICATION FUNCTION ON A STRING -!C Author : Athanasios Nenes -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C STRING is the CHARACTER variable with the string to be justified -!C -!C EXAMPLE: -!C STRING = 'AAAA ' -!C CALL SHFTRGHT (STRING) -!C -!C after execution of this code segment, STRING contains the value -!C ' AAAA'. -!C -!C************************************************************************* -!C - SUBROUTINE SHFTRGHT (CHR) -!C -!C*********************************************************************** - IMPLICIT INTEGER (I-N) - CHARACTER CHR*(*) - - I1 = LEN(CHR) ! Total length of string - CALL CHRBLN(CHR,I2) ! Position of last non-blank character - IF (I2 == I1) RETURN - - DO 10 I=I2,1,-1 ! Shift characters - CHR(I1+I-I2:I1+I-I2) = CHR(I:I) - CHR(I:I) = ' ' - 10 END DO - RETURN - - END SUBROUTINE SHFTRGHT - - - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE RPLSTR -!C Purpose : REPLACE CHARACTERS OCCURING IN A STRING -!C Author : Athanasios Nenes -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C STRING is the CHARACTER variable with the string to be edited -!C OLD is the old character which is to be replaced -!C NEW is the new character which OLD is to be replaced with -!C IERR is 0 if everything went well, is 1 if 'NEW' contains 'OLD'. -!C In this case, this is invalid, and no change is done. -!C -!C EXAMPLE: -!C STRING = 'AAAA' -!C OLD = 'A' -!C NEW = 'B' -!C CALL RPLSTR (STRING, OLD, NEW) -!C -!C after execution of this code segment, STRING contains the value -!C 'BBBB'. -!C -!C************************************************************************* -!C - SUBROUTINE RPLSTR (STRING, OLD, NEW, IERR) -!C -!C*********************************************************************** - IMPLICIT INTEGER (I-N) - CHARACTER STRING*(*), OLD*(*), NEW*(*) - -! *** INITIALIZE ******************************************************** - - ILO = LEN(OLD) - -! *** CHECK AND SEE IF 'NEW' CONTAINS 'OLD', WHICH CANNOT *************** - - IP = INDEX(NEW,OLD) - IF (IP /= 0) THEN - IERR = 1 - RETURN - ELSE - IERR = 0 - ENDIF - -! *** PROCEED WITH REPLACING ******************************************* - - 10 IP = INDEX(STRING,OLD) ! SEE IF 'OLD' EXISTS IN 'STRING' - IF (IP == 0) RETURN ! 'OLD' DOES NOT EXIST ; RETURN - STRING(IP:IP+ILO-1) = NEW ! REPLACE SUBSTRING 'OLD' WITH 'NEW' - GOTO 10 ! GO FOR NEW OCCURANCE OF 'OLD' - - END SUBROUTINE RPLSTR - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE INPTD -!C Purpose : Prompts user for a value (DOUBLE). A default value -!C is provided, so if user presses , the default -!C is used. -!C Author : Athanasios Nenes -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C VAR is the real variable which value is to be saved -!C DEF is a real variable, with the default value of VAR. -!C PROMPT is a CHARACTER varible containing the prompt string. -!C PRFMT is a CHARACTER variable containing the FORMAT specifier -!C for the default value DEF. -!C IERR is an INTEGER error flag, and has the values: -!C 0 - No error detected. -!C 1 - Invalid FORMAT and/or Invalid default value. -!C 2 - Bad value specified by user -!C -!C EXAMPLE: -!C CALL INPTD (VAR, 1.0D0, 'Give value for A ', '*', Ierr) -!C -!C after execution of this code segment, the user is prompted for the -!C value of variable VAR. If is pressed (ie no value is specified) -!C then 1.0 is assigned to VAR. The default value is displayed in free- -!C format. The error status is specified by variable Ierr -!C -!C*********************************************************************** -!C - SUBROUTINE INPTD (VAR, DEF, PROMPT, PRFMT, IERR) -!C -!C*********************************************************************** - IMPLICIT INTEGER (I-N) - CHARACTER PROMPT*(*), PRFMT*(*), BUFFER*128 - real :: DEF, VAR - INTEGER :: IERR - - IERR = 0 - -! *** WRITE DEFAULT VALUE TO WORK BUFFER ******************************* - - WRITE (BUFFER, FMT=PRFMT, ERR=10) DEF - CALL CHRBLN (BUFFER, IEND) - -! *** PROMPT USER FOR INPUT AND READ IT ******************************** - - WRITE (*,*) PROMPT,' [',BUFFER(1:IEND),']: ' - READ (*, '(A)', ERR=20, END=20) BUFFER - CALL CHRBLN (BUFFER,IEND) - -! *** READ DATA OR SET DEFAULT ? **************************************** - - IF (IEND == 1 .AND. BUFFER(1:1) == ' ') THEN - VAR = DEF - ELSE - READ (BUFFER, *, ERR=20, END=20) VAR - ENDIF - -! *** RETURN POINT ****************************************************** - - 30 RETURN - -! *** ERROR HANDLER ***************************************************** - - 10 IERR = 1 ! Bad FORMAT and/or bad default value - GOTO 30 - - 20 IERR = 2 ! Bad number given by user - GOTO 30 - - END SUBROUTINE INPTD - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE Pushend -!C Purpose : Positions the pointer of a sequential file at its end -!C Simulates the ACCESS='APPEND' clause of a F77L OPEN -!C statement with Standard Fortran commands. -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C Iunit is a INTEGER variable, the file unit which the file is -!C connected to. -!C -!C EXAMPLE: -!C CALL PUSHEND (10) -!C -!C after execution of this code segment, the pointer of unit 10 is -!C pushed to its end. -!C -!C*********************************************************************** -!C - SUBROUTINE Pushend (Iunit) -!C -!C*********************************************************************** - - IMPLICIT INTEGER (I-N) - LOGICAL :: OPNED - -! *** INQUIRE IF Iunit CONNECTED TO FILE ******************************** - - INQUIRE (UNIT=Iunit, OPENED=OPNED) - IF ( .NOT. OPNED) GOTO 25 - -! *** Iunit CONNECTED, PUSH POINTER TO END ****************************** - - 10 READ (Iunit,'()', ERR=20, END=20) - GOTO 10 - -! *** RETURN POINT ****************************************************** - - 20 BACKSPACE (Iunit) - 25 RETURN - end SUBROUTINE Pushend - - - -!C************************************************************************* -!C -!C TOOLBOX LIBRARY v.1.0 (May 1995) -!C -!C Program unit : SUBROUTINE APPENDEXT -!C Purpose : Fix extension in file name string -!C -!C ======================= ARGUMENTS / USAGE ============================= -!C -!C Filename is the CHARACTER variable with the file name -!C Defext is the CHARACTER variable with extension (including '.', -!C ex. '.DAT') -!C Overwrite is a LOGICAL value, .TRUE. overwrites any existing extension -!C in "Filename" with "Defext", .FALSE. puts "Defext" only if -!C there is no extension in "Filename". -!C -!C EXAMPLE: -!C FILENAME1 = 'TEST.DAT' -!C FILENAME2 = 'TEST.DAT' -!C CALL APPENDEXT (FILENAME1, '.TXT', .FALSE.) -!C CALL APPENDEXT (FILENAME2, '.TXT', .TRUE. ) -!C -!C after execution of this code segment, "FILENAME1" has the value -!C 'TEST.DAT', while "FILENAME2" has the value 'TEST.TXT' -!C -!C*********************************************************************** -!C - SUBROUTINE Appendext (Filename, Defext, Overwrite) -!C -!C*********************************************************************** - IMPLICIT INTEGER (I-N) - CHARACTER*(*) Filename, Defext - LOGICAL :: Overwrite - - CALL CHRBLN (Filename, Iend) - IF (Filename(1:1) == ' ' .AND. Iend == 1) RETURN ! Filename empty - Idot = INDEX (Filename, '.') ! Append extension ? - IF (Idot == 0) Filename = Filename(1:Iend)//Defext - IF (Overwrite .AND. Idot /= 0) & - Filename = Filename(:Idot-1)//Defext - RETURN - end SUBROUTINE Appendext - - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE POLY3 -! *** FINDS THE REAL ROOTS OF THE THIRD ORDER ALGEBRAIC EQUATION: -! X**3 + A1*X**2 + A2*X + A3 = 0.0 -! THE EQUATION IS SOLVED ANALYTICALLY. - -! PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM -! NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS -! FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30. -! AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO. - -! SOLUTION FORMULA IS FOUND IN PAGE 32 OF: -! MATHEMATICAL HANDBOOK OF FORMULAS AND TABLES -! SCHAUM'S OUTLINE SERIES -! MURRAY SPIEGER, McGRAW-HILL, NEW YORK, 1968 -! (GREEK TRANSLATION: BY SOTIRIOS PERSIDES, ESPI, ATHENS, 1976) - -! A SPECIAL CASE IS CONSIDERED SEPERATELY ; WHEN A3 = 0, THEN -! ONE ROOT IS X=0.0, AND THE OTHER TWO FROM THE SOLUTION OF THE -! QUADRATIC EQUATION X**2 + A1*X + A2 = 0.0 -! THIS SPECIAL CASE IS CONSIDERED BECAUSE THE ANALYTICAL FORMULA -! DOES NOT YIELD ACCURATE RESULTS (DUE TO NUMERICAL ROUNDOFF ERRORS) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE POLY3 (A1, A2, A3, ROOT, ISLV) - - IMPLICIT real (A-H, O-Z) - IMPLICIT INTEGER (I-N) - PARAMETER (EXPON=1.D0/3.D0, ZERO=0.D0, THET1=120.D0/180.D0, & - THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50) - real :: X(3) - -! *** SPECIAL CASE : QUADRATIC*X EQUATION ***************************** - - IF (ABS(A3) <= EPS) THEN - ISLV = 1 - IX = 1 - X(1) = ZERO - D = A1*A1-4.D0*A2 - IF (D >= ZERO) THEN - IX = 3 - SQD = SQRT(D) - X(2) = 0.5*(-A1+SQD) - X(3) = 0.5*(-A1-SQD) - ENDIF - ELSE - - ! *** NORMAL CASE : CUBIC EQUATION ************************************ - - ! DEFINE PARAMETERS Q, R, S, T, D - - ISLV= 1 - Q = (3.D0*A2 - A1*A1)/9.D0 - R = (9.D0*A1*A2 - 27.D0*A3 - 2.D0*A1*A1*A1)/54.D0 - D = Q*Q*Q + R*R - - ! *** CALCULATE ROOTS ************************************************* - - ! D < 0, THREE REAL ROOTS - - IF (D < -EPS) THEN ! D < -EPS : D < ZERO - IX = 3 - THET = EXPON*ACOS(R/SQRT(-Q*Q*Q)) - COEF = 2.D0*SQRT(-Q) - X(1) = COEF*COS(THET) - EXPON*A1 - X(2) = COEF*COS(THET + THET1*PI) - EXPON*A1 - X(3) = COEF*COS(THET + THET2*PI) - EXPON*A1 - - ! D = 0, THREE REAL (ONE DOUBLE) ROOTS - - ELSE IF (D <= EPS) THEN ! -EPS <= D <= EPS : D = ZERO - IX = 2 - SSIG = SIGN (1.0, R) - S = SSIG*(ABS(R))**EXPON - X(1) = 2.D0*S - EXPON*A1 - X(2) = -S - EXPON*A1 - - ! D > 0, ONE REAL ROOT - - ELSE ! D > EPS : D > ZERO - IX = 1 - SQD = SQRT(D) - SSIG = SIGN (1.0, R+SQD) ! TRANSFER SIGN TO SSIG - TSIG = SIGN (1.0, R-SQD) - S = SSIG*(ABS(R+SQD))**EXPON ! EXPONENTIATE ABS() - T = TSIG*(ABS(R-SQD))**EXPON - X(1) = S + T - EXPON*A1 - ENDIF - ENDIF - -! *** SELECT APPROPRIATE ROOT ***************************************** - - ROOT = 1.D30 - DO 10 I=1,IX - IF (X(I) > ZERO) THEN - ROOT = MIN (ROOT, X(I)) - ISLV = 0 - ENDIF - 10 END DO - -! *** END OF SUBROUTINE POLY3 ***************************************** - - RETURN - END SUBROUTINE POLY3 - - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE POLY3B -! *** FINDS A REAL ROOT OF THE THIRD ORDER ALGEBRAIC EQUATION: -! X**3 + A1*X**2 + A2*X + A3 = 0.0 -! THE EQUATION IS SOLVED NUMERICALLY (BISECTION). - -! PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM -! NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS -! FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30. -! AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO. - -! RTLW, RTHI DEFINE THE INTERVAL WHICH THE ROOT IS LOOKED FOR. - -!======================================================================= - - SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV) - - IMPLICIT INTEGER (I-N) - IMPLICIT real (A-H, O-Z) - PARAMETER (ZERO=0.D0, EPS=1D-15, MAXIT=100, NDIV=5) - - FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3 - -! *** INITIAL VALUES FOR BISECTION ************************************* - - X1 = RTLW - Y1 = FUNC(X1) - IF (ABS(Y1) <= EPS) THEN ! Is low a root? - ROOT = RTLW - GOTO 50 - ENDIF - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** - - DX = (RTHI-RTLW)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = X1+DX - Y2 = FUNC (X2) - IF (SIGN(1.d0,1.d0*Y1)*SIGN(1.d0,1.d0*Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - IF (ABS(Y2) < EPS) THEN ! X2 is a root - ROOT = X2 - ELSE - ROOT = 1.d30 - ISLV = 1 - ENDIF - GOTO 50 - -! *** BISECTION ******************************************************* - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNC (X3) - IF (SIGN(1.d0,1.d0*Y1)*SIGN(1.d0,1.d0*Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - -! *** CONVERGED ; RETURN *********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNC (X3) - ROOT = X3 - ISLV = 0 - - 50 RETURN - -! *** END OF SUBROUTINE POLY3B ***************************************** - - END SUBROUTINE POLY3B - - - -! c PROGRAM DRIVER -! c real ROOT -! cC -! c CALL POLY3 (-1.d0, 1.d0, -1.d0, ROOT, ISLV) -! c IF (ISLV.NE.0) STOP 'Error in POLY3' -! c WRITE (*,*) 'Root=', ROOT -! cC -! c CALL POLY3B (-1.d0, 1.d0, -1.d0, -10.d0, 10.d0, ROOT, ISLV) -! c IF (ISLV.NE.0) STOP 'Error in POLY3B' -! c WRITE (*,*) 'Root=', ROOT -! cC -! c END -!======================================================================= - -! *** ISORROPIA CODE -! *** FUNCTION EX10 -! *** 10^X FUNCTION ; ALTERNATE OF LIBRARY ROUTINE ; USED BECAUSE IT IS -! MUCH FASTER BUT WITHOUT GREAT LOSS IN ACCURACY. , -! MAXIMUM ERROR IS 2%, EXECUTION TIME IS 42% OF THE LIBRARY ROUTINE -! (ON A 80286/80287 MACHINE, using Lahey FORTRAN 77 v.3.0). - -! EXPONENT RANGE IS BETWEEN -K AND K (K IS THE REAL ARGUMENT 'K') -! MAX VALUE FOR K: 9.999 -! IF X < -K, X IS SET TO -K, IF X > K, X IS SET TO K - -! THE EXPONENT IS CALCULATED BY THE PRODUCT ADEC*AINT, WHERE ADEC -! IS THE MANTISSA AND AINT IS THE MAGNITUDE (EXPONENT). BOTH -! MANTISSA AND MAGNITUDE ARE PRE-CALCULATED AND STORED IN LOOKUP -! TABLES ; THIS LEADS TO THE INCREASED SPEED. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - FUNCTION EX10(X,K) - REAL :: X, EX10, Y, AINT10, ADEC10, K - INTEGER :: K1, K2 - COMMON /EXPNC/ AINT10(20), ADEC10(200) - -! *** LIMIT X TO [-K, K] RANGE ***************************************** - - Y = MAX(-K, MIN(X,K)) ! MIN: -9.999, MAX: 9.999 - -! *** GET INTEGER AND DECIMAL PART ************************************* - - K1 = INT(Y) - K2 = INT(100*(Y-K1)) - -! *** CALCULATE EXP FUNCTION ******************************************* - - EX10 = AINT10(K1+10)*ADEC10(K2+100) - -! *** END OF EXP FUNCTION ********************************************** - - RETURN - END FUNCTION EX10 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** BLOCK DATA EXPON -! *** CONTAINS DATA FOR EXPONENT ARRAYS NEEDED IN FUNCTION EXP10 - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - BLOCK DATA EXPON - -! *** Common block definition - - IMPLICIT INTEGER (I-N) - REAL :: AINT10, ADEC10 - COMMON /EXPNC/ AINT10(20), ADEC10(200) - -! *** Integer part - - DATA AINT10/ & - & 0.1000E-08, 0.1000E-07, 0.1000E-06, 0.1000E-05, 0.1000E-04, & - & 0.1000E-03, 0.1000E-02, 0.1000E-01, 0.1000E+00, 0.1000E+01, & - & 0.1000E+02, 0.1000E+03, 0.1000E+04, 0.1000E+05, 0.1000E+06, & - & 0.1000E+07, 0.1000E+08, 0.1000E+09, 0.1000E+10, 0.1000E+11 & - / - -! *** decimal part - - DATA (ADEC10(I),I=1,100)/ & - & 0.1023E+00, 0.1047E+00, 0.1072E+00, 0.1096E+00, 0.1122E+00, & - & 0.1148E+00, 0.1175E+00, 0.1202E+00, 0.1230E+00, 0.1259E+00, & - & 0.1288E+00, 0.1318E+00, 0.1349E+00, 0.1380E+00, 0.1413E+00, & - & 0.1445E+00, 0.1479E+00, 0.1514E+00, 0.1549E+00, 0.1585E+00, & - & 0.1622E+00, 0.1660E+00, 0.1698E+00, 0.1738E+00, 0.1778E+00, & - & 0.1820E+00, 0.1862E+00, 0.1905E+00, 0.1950E+00, 0.1995E+00, & - & 0.2042E+00, 0.2089E+00, 0.2138E+00, 0.2188E+00, 0.2239E+00, & - & 0.2291E+00, 0.2344E+00, 0.2399E+00, 0.2455E+00, 0.2512E+00, & - & 0.2570E+00, 0.2630E+00, 0.2692E+00, 0.2754E+00, 0.2818E+00, & - & 0.2884E+00, 0.2951E+00, 0.3020E+00, 0.3090E+00, 0.3162E+00, & - & 0.3236E+00, 0.3311E+00, 0.3388E+00, 0.3467E+00, 0.3548E+00, & - & 0.3631E+00, 0.3715E+00, 0.3802E+00, 0.3890E+00, 0.3981E+00, & - & 0.4074E+00, 0.4169E+00, 0.4266E+00, 0.4365E+00, 0.4467E+00, & - & 0.4571E+00, 0.4677E+00, 0.4786E+00, 0.4898E+00, 0.5012E+00, & - & 0.5129E+00, 0.5248E+00, 0.5370E+00, 0.5495E+00, 0.5623E+00, & - & 0.5754E+00, 0.5888E+00, 0.6026E+00, 0.6166E+00, 0.6310E+00, & - & 0.6457E+00, 0.6607E+00, 0.6761E+00, 0.6918E+00, 0.7079E+00, & - & 0.7244E+00, 0.7413E+00, 0.7586E+00, 0.7762E+00, 0.7943E+00, & - & 0.8128E+00, 0.8318E+00, 0.8511E+00, 0.8710E+00, 0.8913E+00, & - & 0.9120E+00, 0.9333E+00, 0.9550E+00, 0.9772E+00, 0.1000E+01/ - - DATA (ADEC10(I),I=101,200)/ & - & 0.1023E+01, 0.1047E+01, 0.1072E+01, 0.1096E+01, 0.1122E+01, & - & 0.1148E+01, 0.1175E+01, 0.1202E+01, 0.1230E+01, 0.1259E+01, & - & 0.1288E+01, 0.1318E+01, 0.1349E+01, 0.1380E+01, 0.1413E+01, & - & 0.1445E+01, 0.1479E+01, 0.1514E+01, 0.1549E+01, 0.1585E+01, & - & 0.1622E+01, 0.1660E+01, 0.1698E+01, 0.1738E+01, 0.1778E+01, & - & 0.1820E+01, 0.1862E+01, 0.1905E+01, 0.1950E+01, 0.1995E+01, & - & 0.2042E+01, 0.2089E+01, 0.2138E+01, 0.2188E+01, 0.2239E+01, & - & 0.2291E+01, 0.2344E+01, 0.2399E+01, 0.2455E+01, 0.2512E+01, & - & 0.2570E+01, 0.2630E+01, 0.2692E+01, 0.2754E+01, 0.2818E+01, & - & 0.2884E+01, 0.2951E+01, 0.3020E+01, 0.3090E+01, 0.3162E+01, & - & 0.3236E+01, 0.3311E+01, 0.3388E+01, 0.3467E+01, 0.3548E+01, & - & 0.3631E+01, 0.3715E+01, 0.3802E+01, 0.3890E+01, 0.3981E+01, & - & 0.4074E+01, 0.4169E+01, 0.4266E+01, 0.4365E+01, 0.4467E+01, & - & 0.4571E+01, 0.4677E+01, 0.4786E+01, 0.4898E+01, 0.5012E+01, & - & 0.5129E+01, 0.5248E+01, 0.5370E+01, 0.5495E+01, 0.5623E+01, & - & 0.5754E+01, 0.5888E+01, 0.6026E+01, 0.6166E+01, 0.6310E+01, & - & 0.6457E+01, 0.6607E+01, 0.6761E+01, 0.6918E+01, 0.7079E+01, & - & 0.7244E+01, 0.7413E+01, 0.7586E+01, 0.7762E+01, 0.7943E+01, & - & 0.8128E+01, 0.8318E+01, 0.8511E+01, 0.8710E+01, 0.8913E+01, & - & 0.9120E+01, 0.9333E+01, 0.9550E+01, 0.9772E+01, 0.1000E+02 & - / - -! *** END OF BLOCK DATA EXPON ****************************************** - - END - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE PUSHERR -! *** THIS SUBROUTINE SAVES AN ERROR MESSAGE IN THE ERROR STACK - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE PUSHERR (IERR,ERRINF) - INCLUDE 'isrpia.inc' - CHARACTER ERRINF*(*) - -! *** SAVE ERROR CODE IF THERE IS ANY SPACE *************************** - - IF (NOFER < NERRMX) THEN - NOFER = NOFER + 1 - ERRSTK(NOFER) = IERR - ERRMSG(NOFER) = ERRINF - STKOFL = .FALSE. - ELSE - STKOFL = .TRUE. ! STACK OVERFLOW - ENDIF - -! *** END OF SUBROUTINE PUSHERR **************************************** - - END SUBROUTINE PUSHERR - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISERRINF -! *** THIS SUBROUTINE OBTAINS A COPY OF THE ERROR STACK (& MESSAGES) - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISERRINF (ERRSTKI, ERRMSGI, NOFERI, STKOFLI) - INCLUDE 'isrpia.inc' - CHARACTER ERRMSGI*40 - INTEGER :: ERRSTKI - LOGICAL :: STKOFLI - DIMENSION ERRMSGI(NERRMX), ERRSTKI(NERRMX) - -! *** OBTAIN WHOLE ERROR STACK **************************************** - - DO 10 I=1,NOFER ! Error messages & codes - ERRSTKI(I) = ERRSTK(I) - ERRMSGI(I) = ERRMSG(I) - 10 END DO - - STKOFLI = STKOFL - NOFERI = NOFER - - RETURN - -! *** END OF SUBROUTINE ISERRINF *************************************** - - END SUBROUTINE ISERRINF -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ERRSTAT -! *** THIS SUBROUTINE REPORTS ERROR MESSAGES TO UNIT 'IO' - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ERRSTAT (IO,IERR,ERRINF) - INCLUDE 'isrpia.inc' - CHARACTER CER*4, NCIS*29, NCIF*27, NSIS*26, NSIF*24, ERRINF*(*) - DATA NCIS /'NO CONVERGENCE IN SUBROUTINE '/, & - NCIF /'NO CONVERGENCE IN FUNCTION ' /, & - NSIS /'NO SOLUTION IN SUBROUTINE ' /, & - NSIF /'NO SOLUTION IN FUNCTION ' / - -! *** WRITE ERROR IN CHARACTER ***************************************** - - WRITE (CER,'(I4)') IERR - CALL RPLSTR (CER, ' ', '0',IOK) ! REPLACE BLANKS WITH ZEROS - CALL CHRBLN (ERRINF, IEND) ! LAST POSITION OF ERRINF CHAR - -! *** WRITE ERROR TYPE (FATAL, WARNING ) ******************************* - - IF (IERR == 0) THEN - WRITE (IO,1000) 'NO ERRORS DETECTED ' - GOTO 10 - - ELSE IF (IERR < 0) THEN - WRITE (IO,1000) 'ERROR STACK EXHAUSTED ' - GOTO 10 - - ELSE IF (IERR > 1000) THEN - WRITE (IO,1100) 'FATAL',CER - - ELSE - WRITE (IO,1100) 'WARNING',CER - ENDIF - -! *** WRITE ERROR MESSAGE ********************************************** - -! FATAL MESSAGES - - IF (IERR == 1001) THEN - CALL CHRBLN (SCASE, IEND) - WRITE (IO,1000) 'CASE NOT SUPPORTED IN CALCMR ['//SCASE(1:IEND) & - //']' - - ELSEIF (IERR == 1002) THEN - CALL CHRBLN (SCASE, IEND) - WRITE (IO,1000) 'CASE NOT SUPPORTED ['//SCASE(1:IEND)//']' - - ! WARNING MESSAGES - - ELSEIF (IERR == 0001) THEN - WRITE (IO,1000) NSIS,ERRINF - - ELSEIF (IERR == 0002) THEN - WRITE (IO,1000) NCIS,ERRINF - - ELSEIF (IERR == 0003) THEN - WRITE (IO,1000) NSIF,ERRINF - - ELSEIF (IERR == 0004) THEN - WRITE (IO,1000) NCIF,ERRINF - - ELSE IF (IERR == 0019) THEN - WRITE (IO,1000) 'HNO3(aq) AFFECTS H+, WHICH '// & - 'MIGHT AFFECT SO4/HSO4 RATIO' - WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' - - ELSE IF (IERR == 0020) THEN - IF (W(4) > TINY .AND. W(5) > TINY) THEN - WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT HNO3,' & - //'HCL DISSOLUTION' - ELSE - WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT NH3 ' & - //'DISSOLUTION' - ENDIF - WRITE (IO,1000) 'DIRECT DECREASE IN H+ [',ERRINF(1:IEND),'] %' - - ELSE IF (IERR == 0021) THEN - WRITE (IO,1000) 'HNO3(aq),HCL(aq) AFFECT H+, WHICH '// & - 'MIGHT AFFECT SO4/HSO4 RATIO' - WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' - - ELSE IF (IERR == 0022) THEN - WRITE (IO,1000) 'HCL(g) EQUILIBRIUM YIELDS NONPHYSICAL '// & - 'DISSOLUTION' - WRITE (IO,1000) 'A TINY AMOUNT [',ERRINF(1:IEND),'] IS '// & - 'ASSUMED TO BE DISSOLVED' - - ELSEIF (IERR == 0033) THEN - WRITE (IO,1000) 'HCL(aq) AFFECTS H+, WHICH '// & - 'MIGHT AFFECT SO4/HSO4 RATIO' - WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' - - ELSEIF (IERR == 0050) THEN - WRITE (IO,1000) 'TOO MUCH SODIUM GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS SODIUM IS IGNORED.' - - ELSEIF (IERR == 0051) THEN - WRITE (IO,1000) 'TOO MUCH CALCIUM GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS CALCIUM IS IGNORED.' - - ELSEIF (IERR == 0052) THEN - WRITE (IO,1000) 'TOO MUCH SODIUM (+Ca) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS SODIUM IS IGNORED.' - - ELSEIF (IERR == 0053) THEN - WRITE (IO,1000) 'TOO MUCH MAGNESIUM (+Ca,Na) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS MAGNESIUM IS IGNORED.' - - ELSEIF (IERR == 0054) THEN - WRITE (IO,1000) 'TOO MUCH POTASSIUM(+Ca,Na,Mg) GIVEN AS INPUT.' - WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' - WRITE (IO,1000) 'EXCESS POTASSIUM IS IGNORED.' - - ELSE - WRITE (IO,1000) 'NO DIAGNOSTIC MESSAGE AVAILABLE' - ENDIF - - 10 RETURN - -! *** FORMAT STATEMENTS ************************************* - - 1000 FORMAT (1X,A:A:A:A:A) - 1100 FORMAT (1X,A,' ERROR [',A4,']:') - -! *** END OF SUBROUTINE ERRSTAT ***************************** - - END SUBROUTINE ERRSTAT -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISORINF -! *** THIS SUBROUTINE PROVIDES INFORMATION ABOUT ISORROPIA - -! ======================== ARGUMENTS / USAGE =========================== - -! OUTPUT: -! 1. [VERSI] -! CHARACTER*15 variable. -! Contains version-date information of ISORROPIA - -! 2. [NCMP] -! INTEGER variable. -! The number of components needed in input array WI -! (or, the number of major species accounted for by ISORROPIA) - -! 3. [NION] -! INTEGER variable -! The number of ions considered in the aqueous phase - -! 4. [NAQGAS] -! INTEGER variable -! The number of undissociated species found in aqueous aerosol -! phase - -! 5. [NSOL] -! INTEGER variable -! The number of solids considered in the solid aerosol phase - -! 6. [NERR] -! INTEGER variable -! The size of the error stack (maximum number of errors that can -! be stored before the stack exhausts). - -! 7. [TIN] -! real variable -! The value used for a very small number. - -! 8. [GRT] -! real variable -! The value used for a very large number. - -! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES -! *** UPDATED BY CHRISTOS FOUNTOUKIS - -!======================================================================= - - SUBROUTINE ISORINF (VERSI, NCMP, NION, NAQGAS, NSOL, NERR, TIN, & - GRT) - INCLUDE 'isrpia.inc' - CHARACTER VERSI*(*) - -! *** ASSIGN INFO ******************************************************* - - VERSI = VERSION - NCMP = NCOMP - NION = NIONS - NAQGAS = NGASAQ - NSOL = NSLDS - NERR = NERRMX - TIN = TINY - GRT = GREAT - - RETURN - -! *** END OF SUBROUTINE ISORINF ******************************************* - - END SUBROUTINE ISORINF diff --git a/isorev.f90 b/isorev.f90 deleted file mode 100644 index b5daebd..0000000 --- a/isorev.f90 +++ /dev/null @@ -1,11897 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2016 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program is distributed in the hope that it will be useful, -!* but WITHOUT ANY WARRANTY; without even the implied warranty of -!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP1R -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF -! AN AMMONIUM-SULFATE AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY -! THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE ISRP1R (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - -! *** INITIALIZE COMMON BLOCK VARIABLES ********************************* - - CALL INIT1 (WI, RHI, TEMPI) - -! *** CALCULATE SULFATE RATIO ******************************************* - - IF (RH >= DRNH42S4) THEN ! WET AEROSOL, NEED NH4 AT SRATIO=2.0 - SULRATW = GETASR(WAER(2), RHI) ! AEROSOL SULFATE RATIO - ELSE - SULRATW = 2.0D0 ! DRY AEROSOL SULFATE RATIO - ENDIF - SULRAT = WAER(3)/WAER(2) ! SULFATE RATIO - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR - - IF (SULRATW <= SULRAT) THEN - - IF(METSTBL == 1) THEN - SCASE = 'S2' - CALL CALCS2 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH42S4) THEN - SCASE = 'S1' - CALL CALCS1 ! NH42SO4 ; case K1 - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'S2' - CALL CALCS2 ! Only liquid ; case K2 - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < SULRATW) THEN - W(2) = WAER(2) - W(3) = WAER(3) - - IF(METSTBL == 1) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid (metastable) - SCASE = 'B4' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case B1 - SCASE = 'B1' - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case B2 - SCASE = 'B2' - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case B3 - SCASE = 'B3' - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case B4 - SCASE = 'B4' - ENDIF - ENDIF - - CALL CALCNH3P ! Compute NH3(g) - - ! *** SULFATE RICH (FREE ACID) - - ELSEIF (SULRAT < 1.0) THEN - W(2) = WAER(2) - W(3) = WAER(3) - - IF(METSTBL == 1) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid (metastable) - SCASE = 'C2' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case C1 - SCASE = 'C1' - - ELSEIF (DRNH4HS4 <= RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case C2 - SCASE = 'C2' - ENDIF - ENDIF - - CALL CALCNH3P - - ENDIF - RETURN - -! *** END OF SUBROUTINE ISRP1R ***************************************** - - END SUBROUTINE ISRP1R - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP2R -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY -! THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE ISRP2R (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - LOGICAL :: TRYLIQ - -! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** - - TRYLIQ = .TRUE. ! Assume liquid phase, sulfate poor limit - - 10 CALL INIT2 (WI, RHI, TEMPI) - -! *** CALCULATE SULFATE RATIO ******************************************* - - IF (TRYLIQ .AND. RH >= DRNH4NO3) THEN ! *** WET AEROSOL - SULRATW = GETASR(WAER(2), RHI) ! LIMITING SULFATE RATIO - ELSE - SULRATW = 2.0D0 ! *** DRY AEROSOL - ENDIF - SULRAT = WAER(3)/WAER(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR - - IF (SULRATW <= SULRAT) THEN - - IF(METSTBL == 1) THEN - SCASE = 'N3' - CALL CALCN3 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'N1' - CALL CALCN1 ! NH42SO4,NH4NO3 ; case N1 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'N2' - CALL CALCN2 ! NH42S4 ; case N2 - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'N3' - CALL CALCN3 ! Only liquid ; case N3 - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - - ! FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE - ! ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE - ! AEROSOL EQUILIBRIUM. - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < SULRATW) THEN - W(2) = WAER(2) - W(3) = WAER(3) - W(4) = WAER(4) - - IF(METSTBL == 1) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid (metastable) - SCASE = 'B4' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'B1' - CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case O1 - SCASE = 'B1' - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRLC) THEN - SCASE = 'B2' - CALL CALCB2 ! LC,NH42S4 ; case O2 - SCASE = 'B2' - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'B3' - CALL CALCB3 ! NH42S4 ; case O3 - SCASE = 'B3' - - ELSEIF (DRNH42S4 <= RH) THEN - SCASE = 'B4' - CALL CALCB4 ! Only liquid ; case O4 - SCASE = 'B4' - ENDIF - ENDIF - - ! *** Add the NO3 to the solution now and calculate partitioning. - - MOLAL(7) = WAER(4) ! There is always water, so NO3(aer) is NO3- - MOLAL(1) = MOLAL(1) + WAER(4) ! Add H+ to balance out - CALL CALCNAP ! HNO3, NH3 dissolved - CALL CALCNH3P - - ! *** SULFATE RICH (FREE ACID) - - ! FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE - ! ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE - ! AEROSOL EQUILIBRIUM. - - ELSEIF (SULRAT < 1.0) THEN - W(2) = WAER(2) - W(3) = WAER(3) - W(4) = WAER(4) - - IF(METSTBL == 1) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid (metastable) - SCASE = 'C2' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'C1' - CALL CALCC1 ! NH4HSO4 ; case P1 - SCASE = 'C1' - - ELSEIF (DRNH4HS4 <= RH) THEN - SCASE = 'C2' - CALL CALCC2 ! Only liquid ; case P2 - SCASE = 'C2' - ENDIF - ENDIF - - ! *** Add the NO3 to the solution now and calculate partitioning. - - MOLAL(7) = WAER(4) ! There is always water, so NO3(aer) is NO3- - MOLAL(1) = MOLAL(1) + WAER(4) ! Add H+ to balance out - - CALL CALCNAP ! HNO3, NH3 dissolved - CALL CALCNH3P - ENDIF - -! *** IF SULRATW < SULRAT < 2.0 and WATER = 0 => SULFATE RICH CASE. - - IF (SULRATW <= SULRAT .AND. SULRAT < 2.0 & - .AND. WATER <= TINY) THEN - TRYLIQ = .FALSE. - GOTO 10 - ENDIF - - RETURN - -! *** END OF SUBROUTINE ISRP2R ***************************************** - - END SUBROUTINE ISRP2R -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE ISRP3R -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM -! RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE ISRP3R (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - LOGICAL :: TRYLIQ -! C -! C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** -! C -!c WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 -!c WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 - -! *** INITIALIZE ALL VARIABLES ****************************************** - - TRYLIQ = .TRUE. ! Use liquid phase sulfate poor limit - - 10 CALL ISOINIT3 (WI, RHI, TEMPI) ! COMMON block variables -! C -! C *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE ********* -! C -!c REST = 2.D0*WAER(2) + WAER(4) + WAER(5) -!c IF (WAER(1).GT.REST) THEN ! NA > 2*SO4+CL+NO3 ? -!c WAER(1) = (ONE-1D-6)*REST ! Adjust Na amount -!c CALL PUSHERR (0050, 'ISRP3R') ! Warning error: Na adjusted -!c ENDIF - -! *** CALCULATE SULFATE & SODIUM RATIOS ********************************* - - IF (TRYLIQ .AND. RH >= DRNH4NO3) THEN ! ** WET AEROSOL - FRSO4 = WAER(2) - WAER(1)/2.0D0 ! SULFATE UNBOUND BY SODIUM - FRSO4 = MAX(FRSO4, TINY) - SRI = GETASR(FRSO4, RHI) ! SULFATE RATIO FOR NH4+ - SULRATW = (WAER(1)+FRSO4*SRI)/WAER(2) ! LIMITING SULFATE RATIO - SULRATW = MIN (SULRATW, 2.0D0) - ELSE - SULRATW = 2.0D0 ! ** DRY AEROSOL - ENDIF - SULRAT = (WAER(1)+WAER(3))/WAER(2) - SODRAT = WAER(1)/WAER(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR ; SODIUM POOR - - IF (SULRATW <= SULRAT .AND. SODRAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'Q5' - CALL CALCQ5 ! Only liquid (metastable) - SCASE = 'Q5' - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'Q1' - CALL CALCQ1 ! NH42SO4,NH4NO3,NH4CL,NA2SO4 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'Q2' - CALL CALCQ2 ! NH42SO4,NH4CL,NA2SO4 - - ELSEIF (DRNH4CL <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'Q3' - CALL CALCQ3 ! NH42SO4,NA2SO4 - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'Q4' - CALL CALCQ4 ! NA2SO4 - SCASE = 'Q4' - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'Q5' - CALL CALCQ5 ! Only liquid - SCASE = 'Q5' - ENDIF - ENDIF - - ! *** SULFATE POOR ; SODIUM RICH - - ELSE IF (SULRAT >= SULRATW .AND. SODRAT >= 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'R6' - CALL CALCR6 ! Only liquid (metastable) - SCASE = 'R6' - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'R1' - CALL CALCR1 ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'R2' - CALL CALCR2 ! NH4CL,NA2SO4,NACL,NANO3 - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'R3' - CALL CALCR3 ! NH4CL,NA2SO4,NACL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'R4' - CALL CALCR4 ! NH4CL,NA2SO4 - - ELSEIF (DRNH4CL <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'R5' - CALL CALCR5 ! NA2SO4 - SCASE = 'R5' - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'R6' - CALL CALCR6 ! NO SOLID - SCASE = 'R6' - ENDIF - ENDIF - - ! *** SULFATE RICH (NO ACID) - - ELSEIF (1.0 <= SULRAT .AND. SULRAT < SULRATW) THEN - DO 100 I=1,NCOMP - W(I) = WAER(I) - 100 END DO - - IF(METSTBL == 1) THEN - SCASE = 'I6' - CALL CALCI6 ! Only liquid (metastable) - SCASE = 'I6' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'I1' - CALL CALCI1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC - SCASE = 'I1' - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRNAHSO4) THEN - SCASE = 'I2' - CALL CALCI2 ! NA2SO4,(NH4)2SO4,NAHSO4,LC - SCASE = 'I2' - - ELSEIF (DRNAHSO4 <= RH .AND. RH < DRLC) THEN - SCASE = 'I3' - CALL CALCI3 ! NA2SO4,(NH4)2SO4,LC - SCASE = 'I3' - - ELSEIF (DRLC <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'I4' - CALL CALCI4 ! NA2SO4,(NH4)2SO4 - SCASE = 'I4' - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'I5' - CALL CALCI5 ! NA2SO4 - SCASE = 'I5' - - ELSEIF (DRNA2SO4 <= RH) THEN - SCASE = 'I6' - CALL CALCI6 ! NO SOLIDS - SCASE = 'I6' - ENDIF - ENDIF - - CALL CALCNHP ! HNO3, NH3, HCL in gas phase - CALL CALCNH3P - - ! *** SULFATE RICH (FREE ACID) - - ELSEIF (SULRAT < 1.0) THEN - DO 200 I=1,NCOMP - W(I) = WAER(I) - 200 END DO - - IF(METSTBL == 1) THEN - SCASE = 'J3' - CALL CALCJ3 ! Only liquid (metastable) - SCASE = 'J3' - ELSE - - IF (RH < DRNH4HS4) THEN - SCASE = 'J1' - CALL CALCJ1 ! NH4HSO4,NAHSO4 - SCASE = 'J1' - - ELSEIF (DRNH4HS4 <= RH .AND. RH < DRNAHSO4) THEN - SCASE = 'J2' - CALL CALCJ2 ! NAHSO4 - SCASE = 'J2' - - ELSEIF (DRNAHSO4 <= RH) THEN - SCASE = 'J3' - CALL CALCJ3 - SCASE = 'J3' - ENDIF - ENDIF - - CALL CALCNHP ! HNO3, NH3, HCL in gas phase - CALL CALCNH3P - - ENDIF - -! *** IF AFTER CALCULATIONS, SULRATW < SULRAT < 2.0 -! and WATER = 0 => SULFATE RICH CASE. - - IF (SULRATW <= SULRAT .AND. SULRAT < 2.0 & - .AND. WATER <= TINY) THEN - TRYLIQ = .FALSE. - GOTO 10 - ENDIF - - RETURN - -! *** END OF SUBROUTINE ISRP3R ***************************************** - - END SUBROUTINE ISRP3R - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE ISRP4R -! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF -! AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTTASIUM-MAGNESIUM AEROSOL SYSTEM. -! THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM -! RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE ISRP4R (WI, RHI, TEMPI) - INCLUDE 'isrpia.inc' - DIMENSION WI(NCOMP) - LOGICAL :: TRYLIQ -! C -! C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** -! C -!c WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 -!c WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 - -! *** INITIALIZE ALL VARIABLES ****************************************** - - TRYLIQ = .TRUE. ! Use liquid phase sulfate poor limit - IPROB = 1 ! SOLVE REVERSE PROBLEM -! METSTBL = 1 - - 10 CALL INIT4 (WI, RHI, TEMPI) ! COMMON block variables -! C -! C *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE ********* -! C -!c REST = 2.D0*WAER(2) + WAER(4) + WAER(5) -!c IF (WAER(1).GT.REST) THEN ! NA > 2*SO4+CL+NO3 ? -!c WAER(1) = (ONE-1D-6)*REST ! Adjust Na amount -!c CALL PUSHERR (0050, 'ISRP3R') ! Warning error: Na adjusted -!c ENDIF - -! *** CALCULATE SULFATE, CRUSTAL & SODIUM RATIOS *********************** - - IF (TRYLIQ) THEN ! ** WET AEROSOL - FRSO4 = WAER(2) - WAER(1)/2.0D0 & - - WAER(6) - WAER(7)/2.0D0 - WAER(8) ! SULFATE UNBOUND BY SODIUM,CALCIUM,POTTASIUM,MAGNESIUM - FRSO4 = MAX(FRSO4, TINY) - SRI = GETASR(FRSO4, RHI) ! SULFATE RATIO FOR NH4+ - SULRATW = (WAER(1)+FRSO4*SRI+WAER(6) & - +WAER(7)+WAER(8))/WAER(2) ! LIMITING SULFATE RATIO - SULRATW = MIN (SULRATW, 2.0D0) - ELSE - SULRATW = 2.0D0 ! ** DRY AEROSOL - ENDIF - SO4RAT = (WAER(1)+WAER(3)+WAER(6)+WAER(7)+WAER(8))/WAER(2) - CRNARAT = (WAER(1)+WAER(6)+WAER(7)+WAER(8))/WAER(2) - CRRAT = (WAER(6)+WAER(7)+WAER(8))/WAER(2) - -! *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** - -! *** SULFATE POOR ; SODIUM+CRUSTALS POOR - - IF (SULRATW <= SO4RAT .AND. CRNARAT < 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'V7' - CALL CALCV7 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'V1' - CALL CALCV1 ! CaSO4, NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'V2' - CALL CALCV2 ! CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4CL <= RH .AND. RH < DRNH42S4) THEN - SCASE = 'V3' - CALL CALCV3 ! CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH42S4 <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'V4' - CALL CALCV4 ! CaSO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'V5' - CALL CALCV5 ! CaSO4, NA2SO4, K2SO4 - - ELSEIF (DRNA2SO4 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'V6' - CALL CALCV6 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'V7' - CALL CALCV7 ! CaSO4 - ENDIF - ENDIF - - ! *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. - - ELSEIF (SO4RAT >= SULRATW .AND. CRNARAT >= 2.0) THEN - - IF (CRRAT <= 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'U8' - CALL CALCU8 ! Only liquid (metastable) - ELSE - - IF (RH < DRNH4NO3) THEN - SCASE = 'U1' - CALL CALCU1 ! CaSO4, NH4NO3, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'U2' - CALL CALCU2 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3 - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'U3' - CALL CALCU3 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4Cl) THEN - SCASE = 'U4' - CALL CALCU4 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRNH4Cl <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'U5' - CALL CALCU5 ! CaSO4, MGSO4, NA2SO4, K2SO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRNA2SO4) THEN - SCASE = 'U6' - CALL CALCU6 ! CaSO4, NA2SO4, K2SO4 - - ELSEIF (DRNA2SO4 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'U7' - CALL CALCU7 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'U8' - CALL CALCU8 ! CaSO4 - ENDIF - ENDIF - - ! *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. - - ELSEIF (CRRAT > 2.0) THEN - - IF(METSTBL == 1) THEN - SCASE = 'W13' - CALL CALCW13 ! Only liquid (metastable) - ELSE - - IF (RH < DRCACL2) THEN - SCASE = 'W1' - CALL CALCW1 ! CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRCACL2 <= RH .AND. RH < DRMGCL2) THEN - SCASE = 'W2' - CALL CALCW2 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRMGCL2 <= RH .AND. RH < DRCANO32) THEN - SCASE = 'W3' - CALL CALCW3 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRCANO32 <= RH .AND. RH < DRMGNO32) THEN - SCASE = 'W4' - CALL CALCW4 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRMGNO32 <= RH .AND. RH < DRNH4NO3) THEN - SCASE = 'W5' - CALL CALCW5 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! ! NANO3, NACL, NH4NO3, NH4CL - - ELSEIF (DRNH4NO3 <= RH .AND. RH < DRNANO3) THEN - SCASE = 'W6' - CALL CALCW6 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4CL - - ELSEIF (DRNANO3 <= RH .AND. RH < DRNACL) THEN - SCASE = 'W7' - CALL CALCW7 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NACL, NH4CL - - ELSEIF (DRNACL <= RH .AND. RH < DRNH4CL) THEN - SCASE = 'W8' - CALL CALCW8 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NH4CL - - ELSEIF (DRNH4CL <= RH .AND. RH < DRKCL) THEN - SCASE = 'W9' - CALL CALCW9 ! CaSO4, K2SO4, KNO3, KCL, MGSO4 - - ELSEIF (DRKCL <= RH .AND. RH < DRMGSO4) THEN - SCASE = 'W10' - CALL CALCW10 ! CaSO4, K2SO4, KNO3, MGSO4 - - ELSEIF (DRMGSO4 <= RH .AND. RH < DRKNO3) THEN - SCASE = 'W11' - CALL CALCW11 ! CaSO4, K2SO4, KNO3 - - ELSEIF (DRKNO3 <= RH .AND. RH < DRK2SO4) THEN - SCASE = 'W12' - CALL CALCW12 ! CaSO4, K2SO4 - - ELSEIF (DRK2SO4 <= RH) THEN - SCASE = 'W13' - CALL CALCW13 ! CaSO4 - ENDIF - ENDIF - ! CALL CALCNH3 - ENDIF - - ! *** SULFATE RICH (NO ACID): 1 SULFATE RICH CASE. - - IF (SULRATW <= SO4RAT .AND. SO4RAT < 2.0 & - .AND. WATER <= TINY) THEN - TRYLIQ = .FALSE. - GOTO 10 - ENDIF - - RETURN - -! *** END OF SUBROUTINE ISRP4R ***************************************** - - END SUBROUTINE ISRP4R -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCS2 -! *** CASE S2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. LIQUID AEROSOL PHASE ONLY POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCS2 - INCLUDE 'isrpia.inc' - REAL :: NH4I, NH3GI, NH3AQ - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - -! *** CALCULATE WATER CONTENT ***************************************** - - MOLALR(4)= MIN(WAER(2), 0.5d0*WAER(3)) - WATER = MOLALR(4)/M0(4) ! ZSR correlation - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - !C A21 = XK21*WATER*R*TEMP - A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. - AKW = XKW *RH*WATER*WATER - - NH4I = WAER(3) - SO4I = WAER(2) - HSO4I= ZERO - - CALL CALCPH (2.D0*SO4I - NH4I, HI, OHI) ! Get pH - - NH3AQ = ZERO ! AMMONIA EQUILIBRIUM - IF (HI < OHI) THEN - CALL CALCAMAQ (NH4I, OHI, DEL) - NH4I = MAX (NH4I-DEL, ZERO) - OHI = MAX (OHI -DEL, TINY) - NH3AQ = DEL - HI = AKW/OHI - ENDIF - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) ! SULFATE EQUILIBRIUM - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - - NH3GI = NH4I/HI/A2 ! NH3AQ/A21 - - ! *** SPECIATION & WATER CONTENT *************************************** - - MOLAL(1) = HI - MOLAL(3) = NH4I - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - COH = OHI - GASAQ(1) = NH3AQ - GNH3 = NH3GI - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - - 20 RETURN - -! *** END OF SUBROUTINE CALCS2 **************************************** - - END SUBROUTINE CALCS2 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCS1 -! *** CASE S1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4 - -! A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4 -! IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN -! THE GAS PHASE. - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCS1 - INCLUDE 'isrpia.inc' - - CNH42S4 = MIN(WAER(2),0.5d0*WAER(3)) ! For bad input problems - GNH3 = ZERO - - W(2) = CNH42S4 - W(3) = 2.D0*CNH42S4 + GNH3 - - RETURN - -! *** END OF SUBROUTINE CALCS1 ****************************************** - - END SUBROUTINE CALCS1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCN3 -! *** CASE N3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. THERE IS ONLY A LIQUID PHASE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCN3 - INCLUDE 'isrpia.inc' - REAL :: NH4I, NO3I, NH3AQ, NO3AQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALAOU = .TRUE. ! Outer loop activity calculation flag - FRST = .TRUE. - CALAIN = .TRUE. - -! *** AEROSOL WATER CONTENT - - MOLALR(4) = MIN(WAER(2),0.5d0*WAER(3)) ! (NH4)2SO4 - AML5 = MAX(WAER(3)-2.D0*MOLALR(4),ZERO) ! "free" NH4 - MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO) ! NH4NO3=MIN("free",NO3) - WATER = MOLALR(4)/M0(4) + MOLALR(5)/M0(5) - WATER = MAX(WATER, TINY) - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. - !C A21 = XK21*WATER*R*TEMP - A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - A4 = XK7*(WATER/GAMA(4))**3.0 - AKW = XKW *RH*WATER*WATER - - ! ION CONCENTRATIONS - - NH4I = WAER(3) - NO3I = WAER(4) - SO4I = WAER(2) - HSO4I = ZERO - - CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI) - - ! AMMONIA ASSOCIATION EQUILIBRIUM - - NH3AQ = ZERO - NO3AQ = ZERO - GG = 2.D0*SO4I + NO3I - NH4I - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - HI = ZERO - CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3 - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = HI - MOLAL (3) = NH4I - MOLAL (5) = SO4I - MOLAL (6) = HSO4I - MOLAL (7) = NO3I - COH = OHI - - CNH42S4 = ZERO - CNH4NO3 = ZERO - - GASAQ(1) = NH3AQ - GASAQ(3) = NO3AQ - - GHNO3 = HI*NO3I/A3 - GNH3 = NH4I/HI/A2 ! NH3AQ/A21 - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ****************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** RETURN *********************************************************** - - 20 RETURN - -! *** END OF SUBROUTINE CALCN3 ***************************************** - - END SUBROUTINE CALCN3 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCN2 -! *** CASE N2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : (NH4)2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCN2 - INCLUDE 'isrpia.inc' - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CHI1 = MIN(WAER(2),0.5d0*WAER(3)) ! (NH4)2SO4 - CHI2 = MAX(WAER(3) - 2.D0*CHI1, ZERO) ! "Free" NH4+ - CHI3 = MAX(WAER(4) - CHI2, ZERO) ! "Free" NO3 - - PSI2 = CHI2 - PSI3 = CHI3 - - CALAOU = .TRUE. ! Outer loop activity calculation flag - PSI1LO = TINY ! Low limit - PSI1HI = CHI1 ! High limit - -! *** INITIAL VALUES FOR BISECTION ************************************ - - X1 = PSI1HI - Y1 = FUNCN2 (X1) - IF (Y1 <= EPS) RETURN ! IF (ABS(Y1) <= EPS .OR. Y1 <= ZERO) RETURN - YHI= Y1 ! Save Y-value at HI position - -! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** - - DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) - DO 10 I=1,NDIV - X2 = MAX(X1-DX, ZERO) - Y2 = FUNCN2 (X2) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y2) < ZERO) GOTO 20 ! (Y1*Y2 < ZERO) - X1 = X2 - Y1 = Y2 - 10 END DO - -! *** NO SUBDIVISION WITH SOLUTION FOUND - - YLO= Y1 ! Save Y-value at Hi position - IF (ABS(Y2) < EPS) THEN ! X2 IS A SOLUTION - RETURN - - ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 - - ELSE IF (YLO < ZERO .AND. YHI < ZERO) THEN - P4 = CHI4 - YY = FUNCN2(P4) - GOTO 50 - - ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 - - ELSE IF (YLO > ZERO .AND. YHI > ZERO) THEN - P4 = TINY - YY = FUNCN2(P4) - GOTO 50 - ELSE - CALL PUSHERR (0001, 'CALCN2') ! WARNING ERROR: NO SOLUTION - RETURN - ENDIF - -! *** PERFORM BISECTION *********************************************** - - 20 DO 30 I=1,MAXIT - X3 = 0.5*(X1+X2) - Y3 = FUNCN2 (X3) - IF (SIGN(1.0,Y1)*SIGN(1.0,Y3) <= ZERO) THEN ! (Y1*Y3 <= ZERO) - Y2 = Y3 - X2 = X3 - ELSE - Y1 = Y3 - X1 = X3 - ENDIF - IF (ABS(X2-X1) <= EPS*X1) GOTO 40 - 30 END DO - CALL PUSHERR (0002, 'CALCN2') ! WARNING ERROR: NO CONVERGENCE - -! *** CONVERGED ; RETURN ********************************************** - - 40 X3 = 0.5*(X1+X2) - Y3 = FUNCN2 (X3) - 50 CONTINUE - RETURN - -! *** END OF SUBROUTINE CALCN2 ****************************************** - - END SUBROUTINE CALCN2 - - - -!====================================================================== - -! *** ISORROPIA CODE -! *** FUNCTION FUNCN2 -! *** CASE D2 -! FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ; -! AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCN2. - -!======================================================================= - - REAL FUNCTION FUNCN2 (P1) - INCLUDE 'isrpia.inc' - REAL :: NH4I, NO3I, NH3AQ, NO3AQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - PSI1 = P1 - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. - !C A21 = XK21*WATER*R*TEMP - A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 - A4 = XK7*(WATER/GAMA(4))**3.0 - AKW = XKW *RH*WATER*WATER - - ! ION CONCENTRATIONS - - NH4I = 2.D0*PSI1 + PSI2 - NO3I = PSI2 + PSI3 - SO4I = PSI1 - HSO4I = ZERO - - CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI) - - ! AMMONIA ASSOCIATION EQUILIBRIUM - - NH3AQ = ZERO - NO3AQ = ZERO - GG = 2.D0*SO4I + NO3I - NH4I - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - HI = ZERO - CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3 - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL (1) = HI - MOLAL (3) = NH4I - MOLAL (5) = SO4I - MOLAL (6) = HSO4I - MOLAL (7) = NO3I - COH = OHI - - CNH42S4 = CHI1 - PSI1 - CNH4NO3 = ZERO - - GASAQ(1) = NH3AQ - GASAQ(3) = NO3AQ - - GHNO3 = HI*NO3I/A3 - GNH3 = NH4I/HI/A2 ! NH3AQ/A21 - - ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO - -! *** CALCULATE OBJECTIVE FUNCTION ************************************ - - 20 FUNCN2= NH4I*NH4I*SO4I/A4 - ONE - RETURN - -! *** END OF FUNCTION FUNCN2 ******************************************** - - END FUNCTION FUNCN2 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCN1 -! *** CASE N1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 - -! THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY: -! 1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCN1A) -! 2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCN1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCN1A, CALCN2 - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMASAN) THEN - SCASE = 'N1 ; SUBCASE 1' - CALL CALCN1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'N1 ; SUBCASE 1' - ELSE - SCASE = 'N1 ; SUBCASE 2' - CALL CALCMDRP (RH, DRMASAN, DRNH4NO3, CALCN1A, CALCN2) - SCASE = 'N1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCN1 ****************************************** - - END SUBROUTINE CALCN1 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCN1A -! *** CASE N1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCN1A - INCLUDE 'isrpia.inc' - -! *** SETUP PARAMETERS ************************************************* - -! C A1 = XK10/R/TEMP/R/TEMP - -! *** CALCULATE AEROSOL COMPOSITION ************************************ - -! C CHI1 = 2.D0*WAER(4) ! Free parameter ; arbitrary value. - PSI1 = WAER(4) - -! *** The following statment is here to avoid negative NH4+ values in -! CALCN? routines that call CALCN1A - - PSI2 = MAX(MIN(WAER(2),0.5d0*(WAER(3)-PSI1)),TINY) - - CNH4NO3 = PSI1 - CNH42S4 = PSI2 - -! C GNH3 = CHI1 + PSI1 + 2.0*PSI2 -! C GHNO3 = A1/(CHI1-PSI1) + PSI1 - GNH3 = ZERO - GHNO3 = ZERO - - W(2) = PSI2 - W(3) = GNH3 + PSI1 + 2.0*PSI2 - W(4) = GHNO3 + PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCN1A ***************************************** - - END SUBROUTINE CALCN1A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ5 -! *** CASE Q5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ5 - INCLUDE 'isrpia.inc' - - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCQ1A - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - - CALL CALCMR ! WATER - - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! ION CONCENTRATIONS - - NAI = WAER(1) - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - HSO4I = ZERO - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCQ5') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCQ5 ****************************************** - - END SUBROUTINE CALCQ5 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ4 -! *** CASE Q4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ4 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV1 = .TRUE. - PSI1O =-GREAT - ROOT3 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCQ1A - - CHI1 = CNA2SO4 ! SALTS - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A5) THEN - BB =-(WAER(2) + WAER(1)) - CC = WAER(1)*WAER(2) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*WAER(2) - A5) - CALL POLY3(BB, CC, DD, ROOT3, ISLV) - IF (ISLV /= 0) ROOT3 = TINY - ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2), CHI1) - ROOT3 = MAX (ROOT3, ZERO) - PSI1 = CHI1-ROOT3 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS ; CORRECTIONS - - NAI = WAER(1) - 2.D0*ROOT3 - SO4I= WAER(2) - ROOT3 - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - HSO4I = ZERO - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCQ4') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCQ4 ****************************************** - - END SUBROUTINE CALCQ4 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ3 -! *** CASE Q3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ3 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCQ1A, CALCQ4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO .OR. EXCL) THEN ! *** NITRATE OR CHLORIDE EXISTS - SCASE = 'Q3 ; SUBCASE 1' - CALL CALCQ3A - SCASE = 'Q3 ; SUBCASE 1' - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMG3) THEN - SCASE = 'Q3 ; SUBCASE 2' - CALL CALCQ1A ! SOLID - SCASE = 'Q3 ; SUBCASE 2' - ELSE - SCASE = 'Q3 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4 - CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) - SCASE = 'Q3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCQ3 ****************************************** - - END SUBROUTINE CALCQ3 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ3A -! *** CASE Q3 ; SUBCASE A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ3A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1, PSCONV6 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV1 = .TRUE. - PSCONV6 = .TRUE. - - PSI1O =-GREAT - PSI6O =-GREAT - - ROOT1 = ZERO - ROOT3 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCQ1A - - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - CHI6 = CNH42S4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - A7 = XK7 *(WATER/GAMA(4))**3. ! (NH4)2SO4 <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A5) THEN - BB =-(WAER(2) + WAER(1) - ROOT1) - CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5) - CALL POLY3(BB, CC, DD, ROOT3, ISLV) - IF (ISLV /= 0) ROOT3 = TINY - ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1) - ROOT3 = MAX (ROOT3, ZERO) - PSI1 = CHI1-ROOT3 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM SULFATE - - IF (NH4I*NH4I*SO4I > A7) THEN - BB =-(WAER(2)+WAER(3)-ROOT3) - CC = WAER(3)*(WAER(2)-ROOT3+0.5D0*WAER(3)) - DD =-((WAER(2)-ROOT3)*WAER(3)**2.D0 + A7)/4.D0 - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN(ROOT1, WAER(3), WAER(2)-ROOT3, CHI6) - ROOT1 = MAX(ROOT1, ZERO) - PSI6 = CHI6-ROOT1 - ENDIF - PSCONV6 = ABS(PSI6-PSI6O) <= EPS*PSI6O - PSI6O = PSI6 - - ! ION CONCENTRATIONS - - NAI = WAER(1) - 2.D0*ROOT3 - SO4I= WAER(2) - ROOT1 - ROOT3 - NH4I= WAER(3) - 2.D0*ROOT1 - NO3I= WAER(4) - CLI = WAER(5) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - HSO4I = ZERO - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1 .AND. PSCONV6) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCQ3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = CHI6 - PSI6 - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCQ3A ***************************************** - - END SUBROUTINE CALCQ3A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ2 -! *** CASE Q2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID & LIQUID AEROSOL POSSIBLE -! 3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ2 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCQ1A, CALCQ3A, CALCQ4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO) THEN ! *** NITRATE EXISTS - SCASE = 'Q2 ; SUBCASE 1' - CALL CALCQ2A - SCASE = 'Q2 ; SUBCASE 1' - - ELSEIF ( .NOT. EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH < DRMG2) THEN - SCASE = 'Q2 ; SUBCASE 2' - CALL CALCQ1A ! SOLID - SCASE = 'Q2 ; SUBCASE 2' - ELSE - SCASE = 'Q2 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4CL - CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A) - SCASE = 'Q2 ; SUBCASE 3' - ENDIF - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMG3) THEN - SCASE = 'Q2 ; SUBCASE 2' - CALL CALCQ1A ! SOLID - SCASE = 'Q2 ; SUBCASE 2' - ELSE - SCASE = 'Q2 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4 - CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) - SCASE = 'Q2 ; SUBCASE 4' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCQ2 ****************************************** - - END SUBROUTINE CALCQ2 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ2A -! *** CASE Q2 ; SUBCASE A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ2A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1, PSCONV4, PSCONV6 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV1 = .TRUE. - PSCONV4 = .TRUE. - PSCONV6 = .TRUE. - - PSI1O =-GREAT - PSI4O =-GREAT - PSI6O =-GREAT - - ROOT1 = ZERO - ROOT2 = ZERO - ROOT3 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCQ1A - - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - CHI6 = CNH42S4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ - A7 = XK7 *(WATER/GAMA(4))**3. ! (NH4)2SO4 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - 2.D0*ROOT1) - CC = WAER(5)*(WAER(3) - 2.D0*ROOT1) - A14 - DD = BB*BB - 4.D0*CC - IF (DD < ZERO) THEN - ROOT2 = ZERO - ELSE - DD = SQRT(DD) - ROOT2A= 0.5D0*(-BB+DD) - ROOT2B= 0.5D0*(-BB-DD) - IF (ZERO <= ROOT2A) THEN - ROOT2 = ROOT2A - ELSE - ROOT2 = ROOT2B - ENDIF - ROOT2 = MIN(ROOT2, WAER(5), WAER(3) - 2.D0*ROOT1, CHI4) - ROOT2 = MAX(ROOT2, ZERO) - PSI4 = CHI4 - ROOT2 - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSI4O) <= EPS*PSI4O - PSI4O = PSI4 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A5) THEN - BB =-(WAER(2) + WAER(1) - ROOT1) - CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5) - CALL POLY3(BB, CC, DD, ROOT3, ISLV) - IF (ISLV /= 0) ROOT3 = TINY - ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1) - ROOT3 = MAX (ROOT3, ZERO) - PSI1 = CHI1-ROOT3 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM SULFATE - - IF (NH4I*NH4I*SO4I > A7) THEN - BB =-(WAER(2)+WAER(3)-ROOT2-ROOT3) - CC = (WAER(3)-ROOT2)*(WAER(2)-ROOT3+0.5D0*(WAER(3)-ROOT2)) - DD =-((WAER(2)-ROOT3)*(WAER(3)-ROOT2)**2.D0 + A7)/4.D0 - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN(ROOT1, WAER(3)-ROOT2, WAER(2)-ROOT3, CHI6) - ROOT1 = MAX(ROOT1, ZERO) - PSI6 = CHI6-ROOT1 - ENDIF - PSCONV6 = ABS(PSI6-PSI6O) <= EPS*PSI6O - PSI6O = PSI6 - - ! ION CONCENTRATIONS - - NAI = WAER(1) - 2.D0*ROOT3 - SO4I= WAER(2) - ROOT1 - ROOT3 - NH4I= WAER(3) - ROOT2 - 2.D0*ROOT1 - NO3I= WAER(4) - CLI = WAER(5) - ROOT2 - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - HSO4I = ZERO - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1 .AND. PSCONV4 .AND. PSCONV6) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCQ2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = CHI6 - PSI6 - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCQ2A ***************************************** - - END SUBROUTINE CALCQ2A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ1 -! *** CASE Q1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ1 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCQ1A, CALCQ2A, CALCQ3A, CALCQ4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO .AND. EXCL) THEN ! *** NITRATE & CHLORIDE EXIST - IF (RH < DRMG1) THEN - SCASE = 'Q1 ; SUBCASE 1' - CALL CALCQ1A ! SOLID - SCASE = 'Q1 ; SUBCASE 1' - ELSE - SCASE = 'Q1 ; SUBCASE 2' ! MDRH (NH4)2SO4, NA2SO4, NH4CL, NH4NO3 - CALL CALCMDRP (RH, DRMG1, DRNH4NO3, CALCQ1A, CALCQ2A) - SCASE = 'Q1 ; SUBCASE 2' - ENDIF - - ELSE IF (EXNO .AND. .NOT. EXCL) THEN ! *** ONLY NITRATE EXISTS - IF (RH < DRMQ1) THEN - SCASE = 'Q1 ; SUBCASE 1' - CALL CALCQ1A ! SOLID - SCASE = 'Q1 ; SUBCASE 1' - ELSE - SCASE = 'Q1 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4NO3 - CALL CALCMDRP (RH, DRMQ1, DRNH4NO3, CALCQ1A, CALCQ2A) - SCASE = 'Q1 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH < DRMG2) THEN - SCASE = 'Q1 ; SUBCASE 1' - CALL CALCQ1A ! SOLID - SCASE = 'Q1 ; SUBCASE 1' - ELSE - SCASE = 'Q1 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4, NH4CL - CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A) - SCASE = 'Q1 ; SUBCASE 4' - ENDIF - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMG3) THEN - SCASE = 'Q1 ; SUBCASE 1' - CALL CALCQ1A ! SOLID - SCASE = 'Q1 ; SUBCASE 1' - ELSE - SCASE = 'Q1 ; SUBCASE 5' ! MDRH (NH4)2SO4, NA2SO4 - CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) - SCASE = 'Q1 ; SUBCASE 5' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCQ1 ****************************************** - - END SUBROUTINE CALCQ1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCQ1A -! *** CASE Q1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCQ1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE SOLIDS ************************************************** - - CNA2SO4 = 0.5d0*WAER(1) - FRSO4 = MAX (WAER(2)-CNA2SO4, ZERO) - - CNH42S4 = MAX (MIN(FRSO4,0.5d0*WAER(3)), TINY) - FRNH3 = MAX (WAER(3)-2.D0*CNH42S4, ZERO) - - CNH4NO3 = MIN (FRNH3, WAER(4)) -! C FRNO3 = MAX (WAER(4)-CNH4NO3, ZERO) - FRNH3 = MAX (FRNH3-CNH4NO3, ZERO) - - CNH4CL = MIN (FRNH3, WAER(5)) -! C FRCL = MAX (WAER(5)-CNH4CL, ZERO) - FRNH3 = MAX (FRNH3-CNH4CL, ZERO) - -! *** OTHER PHASES ****************************************************** - - WATER = ZERO - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCQ1A ***************************************** - - END SUBROUTINE CALCQ1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR6 -! *** CASE R6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) -! 2. THERE IS ONLY A LIQUID PHASE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR6 - INCLUDE 'isrpia.inc' - - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALL CALCR1A - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE WATER ************************************************** - - CALL CALCMR - -! *** SETUP LIQUID CONCENTRATIONS ************************************** - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - NAI = WAER(1) - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*WAER(2) + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCR6') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1) = NH3AQ - GASAQ(2) = CLAQ - GASAQ(3) = NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCR6 ****************************************** - - END SUBROUTINE CALCR6 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR5 -! *** CASE R5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR5 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - - LOGICAL :: NEAN, NEAC, NESN, NESC - -! *** SETUP PARAMETERS ************************************************ - - CALL CALCR1A ! DRY SOLUTION - - NEAN = CNH4NO3 <= TINY ! NH4NO3 ! Water exists? - NEAC = CNH4CL <= TINY ! NH4CL - NESN = CNANO3 <= TINY ! NANO3 - NESC = CNACL <= TINY ! NACL - IF (NEAN .AND. NEAC .AND. NESN .AND. NESC) RETURN - - CHI1 = CNA2SO4 - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - - PSIO =-GREAT - -! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - PSCONV = .FALSE. - -! *** SETUP LIQUID CONCENTRATIONS ************************************** - - NAI = WAER(1) - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5*(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! SODIUM SULFATE - - ROOT = ZERO - IF (NAI*NAI*SO4I > A5) THEN - BB =-3.D0*CHI1 - CC = 3.D0*CHI1**2.0 - DD =-CHI1**3.0 + 0.25D0*A5 - CALL POLY3(BB, CC, DD, ROOT, ISLV) - IF (ISLV /= 0) ROOT = TINY - ROOT = MIN (MAX(ROOT,ZERO), CHI1) - PSI1 = CHI1-ROOT - ENDIF - PSCONV = ABS(PSI1-PSIO) <= EPS*PSIO - PSIO = PSI1 - - ! ION CONCENTRATIONS - - NAI = WAER(1) - 2.D0*ROOT - SO4I = WAER(2) - ROOT - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCR5') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ -!C A21 = XK21*WATER*R*TEMP - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 ! NH4I*OHI/A2/AKW - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1) = NH3AQ - GASAQ(2) = CLAQ - GASAQ(3) = NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCR5 ****************************************** - - END SUBROUTINE CALCR5 -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR4 -! *** CASE R4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR4 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCR1A, CALCR5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'R4 ; SUBCASE 2' - CALL CALCR1A ! SOLID - SCASE = 'R4 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .OR. EXSN .OR. EXSC) THEN ! *** NH4NO3,NANO3 EXIST - IF (RH >= DRMH1) THEN - SCASE = 'R4 ; SUBCASE 1' - CALL CALCR4A - SCASE = 'R4 ; SUBCASE 1' - ENDIF - - ELSE IF (EXAC) THEN ! *** NH4CL EXISTS ONLY - IF (RH >= DRMR5) THEN - SCASE = 'R4 ; SUBCASE 3' - CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5) - SCASE = 'R4 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR4 ****************************************** - - END SUBROUTINE CALCR4 - - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR4A -! *** CASE R4A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR4A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1, PSCONV4 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - PSCONV1 = .FALSE. - PSCONV4 = .FALSE. - PSIO1 =-GREAT - PSIO4 =-GREAT - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCR1A - - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! SODIUM SULFATE - - ROOT = ZERO - IF (NAI*NAI*SO4I > A5) THEN - BB =-3.D0*CHI1 - CC = 3.D0*CHI1**2.0 - DD =-CHI1**3.0 + 0.25D0*A5 - CALL POLY3(BB, CC, DD, ROOT, ISLV) - IF (ISLV /= 0) ROOT = TINY - ROOT = MIN (MAX(ROOT,ZERO), CHI1) - PSI1 = CHI1-ROOT - NAI = WAER(1) - 2.D0*ROOT - SO4I = WAER(2) - ROOT - ENDIF - PSCONV1 = ABS(PSI1-PSIO1) <= EPS*PSIO1 - PSIO1 = PSI1 - - ! AMMONIUM CHLORIDE - - ROOT = ZERO - IF (NH4I*CLI > A14) THEN - BB =-(NH4I + CLI) - CC =-A14 + NH4I*CLI - DD = BB*BB - 4.D0*CC - ROOT = 0.5D0*(-BB-SQRT(DD)) - IF (ROOT > TINY) THEN - ROOT = MIN(ROOT, CHI4) - PSI4 = CHI4 - ROOT - NH4I = WAER(3) - ROOT - CLI = WAER(5) - ROOT - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSIO4) <= EPS*PSIO4 - PSIO4 = PSI4 - - NO3I = WAER(4) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1 .AND. PSCONV4) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCR4A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - - RETURN - -! *** END OF SUBROUTINE CALCR4A ***************************************** - - END SUBROUTINE CALCR4A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR3 -! *** CASE R3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR3 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCR1A, CALCR4A, CALCR5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'R3 ; SUBCASE 2' - CALL CALCR1A ! SOLID - SCASE = 'R3 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .OR. EXSN) THEN ! *** NH4NO3,NANO3 EXIST - IF (RH >= DRMH1) THEN - SCASE = 'R3 ; SUBCASE 1' - CALL CALCR3A - SCASE = 'R3 ; SUBCASE 1' - ENDIF - - ELSE IF ( .NOT. EXAN .AND. .NOT. EXSN) THEN ! *** NH4NO3,NANO3 = 0 - IF ( EXAC .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'R3 ; SUBCASE 3' - CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A) - SCASE = 'R3 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'R3 ; SUBCASE 4' - CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A) - SCASE = 'R3 ; SUBCASE 4' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'R3 ; SUBCASE 5' - CALL CALCMDRP (RH, DRMR5, DRNACL, CALCR1A, CALCR5) - SCASE = 'R3 ; SUBCASE 5' - ENDIF - ENDIF - - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR3 ****************************************** - - END SUBROUTINE CALCR3 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR3A -! *** CASE R3A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR3A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1, PSCONV3, PSCONV4 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - PSCONV1 = .TRUE. - PSCONV3 = .TRUE. - PSCONV4 = .TRUE. - PSI1O =-GREAT - PSI3O =-GREAT - PSI4O =-GREAT - ROOT1 = ZERO - ROOT2 = ZERO - ROOT3 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCR1A - - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - CHI3 = CNACL - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - A8 = XK8 *(WATER/GAMA(1))**2. ! NaCl <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT3) - CC =-A14 + NH4I*(WAER(5) - ROOT3) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - ROOT2A= 0.5D0*(-BB+SQRT(DD)) - ROOT2B= 0.5D0*(-BB-SQRT(DD)) - IF (ZERO <= ROOT2A) THEN - ROOT2 = ROOT2A - ELSE - ROOT2 = ROOT2B - ENDIF - ROOT2 = MIN(MAX(ZERO, ROOT2), MAX(WAER(5)-ROOT3,ZERO), & - CHI4, WAER(3)) - PSI4 = CHI4 - ROOT2 - ENDIF - PSCONV4 = ABS(PSI4-PSI4O) <= EPS*PSI4O - PSI4O = PSI4 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A5) THEN - BB =-(CHI1 + WAER(1) - ROOT3) - CC = 0.25D0*(WAER(1) - ROOT3)*(4.D0*CHI1+WAER(1)-ROOT3) - DD =-0.25D0*(CHI1*(WAER(1)-ROOT3)**2.D0 - A5) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1,ZERO), MAX(WAER(1)-ROOT3,ZERO), & - CHI1, WAER(2)) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS - - NAI = WAER(1) - (2.D0*ROOT1 + ROOT3) - SO4I= WAER(2) - ROOT1 - NH4I= WAER(3) - ROOT2 - CLI = WAER(5) - (ROOT3 + ROOT2) - NO3I= WAER(4) - - ! SODIUM CHLORIDE ; To obtain new value for ROOT3 - - IF (NAI*CLI > A8) THEN - BB =-((CHI1-2.D0*ROOT1) + (WAER(5) - ROOT2)) - CC = (CHI1-2.D0*ROOT1)*(WAER(5) - ROOT2) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT3A= 0.5D0*(-BB-SQRT(DD)) - ROOT3B= 0.5D0*(-BB+SQRT(DD)) - IF (ZERO <= ROOT3A) THEN - ROOT3 = ROOT3A - ELSE - ROOT3 = ROOT3B - ENDIF - ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) - PSI3 = CHI3-ROOT3 - ENDIF - PSCONV3 = ABS(PSI3-PSI3O) <= EPS*PSI3O - PSI3O = PSI3 - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1 .AND. PSCONV3 .AND. PSCONV4) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCR3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 IF (CLI <= TINY .AND. WAER(5) > TINY) THEN !No disslv Cl-;solid only - DO 30 I=1,NIONS - MOLAL(I) = ZERO - 30 END DO - DO 40 I=1,NGASAQ - GASAQ(I) = ZERO - 40 END DO - CALL CALCR1A - ELSE - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = CHI3 - PSI3 - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR3A ***************************************** - - END SUBROUTINE CALCR3A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR2 -! *** CASE R2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR2 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCR1A, CALCR3A, CALCR4A, CALCR5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'R2 ; SUBCASE 2' - CALL CALCR1A ! SOLID - SCASE = 'R2 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN) THEN ! *** NH4NO3 EXISTS - IF (RH >= DRMH1) THEN - SCASE = 'R2 ; SUBCASE 1' - CALL CALCR2A - SCASE = 'R2 ; SUBCASE 1' - ENDIF - - ELSE IF ( .NOT. EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMH2) THEN - SCASE = 'R2 ; SUBCASE 3' - CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R2 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR1) THEN - SCASE = 'R2 ; SUBCASE 4' - CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R2 ; SUBCASE 4' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'R2 ; SUBCASE 5' - CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A) - SCASE = 'R2 ; SUBCASE 5' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR3) THEN - SCASE = 'R2 ; SUBCASE 6' - CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R2 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'R2 ; SUBCASE 7' - CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A) - SCASE = 'R2 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'R2 ; SUBCASE 8' - CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5) - SCASE = 'R2 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR6) THEN - SCASE = 'R2 ; SUBCASE 9' - CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R2 ; SUBCASE 9' - ENDIF - ENDIF - - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR2 ****************************************** - - END SUBROUTINE CALCR2 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR2A -! *** CASE R2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) -! 2. LIQUID AND SOLID PHASES ARE POSSIBLE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR2A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV1, PSCONV2, PSCONV3, PSCONV4 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV1 = .TRUE. - PSCONV2 = .TRUE. - PSCONV3 = .TRUE. - PSCONV4 = .TRUE. - - PSI1O =-GREAT - PSI2O =-GREAT - PSI3O =-GREAT - PSI4O =-GREAT - - ROOT1 = ZERO - ROOT2 = ZERO - ROOT3 = ZERO - ROOT4 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCR1A - - CHI1 = CNA2SO4 ! SALTS - CHI2 = CNANO3 - CHI3 = CNACL - CHI4 = CNH4CL - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ - A8 = XK8 *(WATER/GAMA(1))**2. ! NaCl <==> Na+ - A9 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT3) - CC = NH4I*(WAER(5) - ROOT3) - A14 - DD = MAX(BB*BB - 4.D0*CC, ZERO) - DD = SQRT(DD) - ROOT2A= 0.5D0*(-BB+DD) - ROOT2B= 0.5D0*(-BB-DD) - IF (ZERO <= ROOT2A) THEN - ROOT2 = ROOT2A - ELSE - ROOT2 = ROOT2B - ENDIF - ROOT2 = MIN(MAX(ROOT2, ZERO), CHI4) - PSI4 = CHI4 - ROOT2 - ENDIF - PSCONV4 = ABS(PSI4-PSI4O) <= EPS*PSI4O - PSI4O = PSI4 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A5) THEN - BB =-(WAER(2) + WAER(1) - ROOT3 - ROOT4) - CC = WAER(1)*(2.D0*ROOT3 + 2.D0*ROOT4 - 4.D0*WAER(2) - ONE) & - -(ROOT3 + ROOT4)**2.0 + 4.D0*WAER(2)*(ROOT3 + ROOT4) - CC =-0.25*CC - DD = WAER(1)*WAER(2)*(ONE - 2.D0*ROOT3 - 2.D0*ROOT4) + & - WAER(2)*(ROOT3 + ROOT4)**2.0 - A5 - DD =-0.25*DD - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1,ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A9) THEN - BB =-(WAER(4) + WAER(1) - 2.D0*ROOT1 - ROOT3) - CC = WAER(4)*(WAER(1) - 2.D0*ROOT1 - ROOT3) - A9 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT4A= 0.5D0*(-BB-DD) - ROOT4B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MIN(MAX(ROOT4, ZERO), CHI2) - PSI2 = CHI2-ROOT4 - ENDIF - PSCONV2 = ABS(PSI2-PSI2O) <= EPS*PSI2O - PSI2O = PSI2 - - ! ION CONCENTRATIONS - - NAI = WAER(1) - (2.D0*ROOT1 + ROOT3 + ROOT4) - SO4I= WAER(2) - ROOT1 - NH4I= WAER(3) - ROOT2 - NO3I= WAER(4) - ROOT4 - CLI = WAER(5) - (ROOT3 + ROOT2) - - ! SODIUM CHLORIDE ; To obtain new value for ROOT3 - - IF (NAI*CLI > A8) THEN - BB =-(WAER(1) - 2.D0*ROOT1 + WAER(5) - ROOT2 - ROOT4) - CC = (WAER(5) + ROOT2)*(WAER(1) - 2.D0*ROOT1 - ROOT4) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT3A= 0.5D0*(-BB-DD) - ROOT3B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT3A) THEN - ROOT3 = ROOT3A - ELSE - ROOT3 = ROOT3B - ENDIF - ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) - PSI3 = CHI3-ROOT3 - ENDIF - PSCONV3 = ABS(PSI3-PSI3O) <= EPS*PSI3O - PSI3O = PSI3 - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI < OHI) THEN - CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - HI = AKW/OHI - ELSE - GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) - GGCL = MAX(GG-GGNO3, ZERO) - IF (GGCL > TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - IF (GGNO3 > TINY) THEN - IF (GGCL <= TINY) HI = ZERO - CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV1 .AND. PSCONV2 .AND. PSCONV3 .AND. PSCONV4) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCR2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 IF (CLI <= TINY .AND. WAER(5) > TINY) THEN !No disslv Cl-;solid only - DO 30 I=1,NIONS - MOLAL(I) = ZERO - 30 END DO - DO 40 I=1,NGASAQ - GASAQ(I) = ZERO - 40 END DO - CALL CALCR1A - ELSE ! OK, aqueous phase present - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = CHI3 - PSI3 - CNANO3 = CHI2 - PSI2 - CNA2SO4 = CHI1 - PSI1 - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR2A ***************************************** - - END SUBROUTINE CALCR2A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR1 -! *** CASE R1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR1 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCR1A, CALCR2A, CALCR3A, CALCR4A, CALCR5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'R1 ; SUBCASE 1' - CALL CALCR1A ! SOLID - SCASE = 'R1 ; SUBCASE 1' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .AND. EXAC .AND. EXSC .AND. EXSN) THEN ! *** ALL EXIST - IF (RH >= DRMH1) THEN - SCASE = 'R1 ; SUBCASE 2' ! MDRH - CALL CALCMDRP (RH, DRMH1, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 2' - ENDIF - - ELSE IF ( .NOT. EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMH2) THEN - SCASE = 'R1 ; SUBCASE 3' - CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R1 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR1) THEN - SCASE = 'R1 ; SUBCASE 4' - CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R1 ; SUBCASE 4' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'R1 ; SUBCASE 5' - CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR3A) !, CALCR4A) - SCASE = 'R1 ; SUBCASE 5' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR3) THEN - SCASE = 'R1 ; SUBCASE 6' - CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R1 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'R1 ; SUBCASE 7' - CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR3A) !, CALCR4A) - SCASE = 'R1 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'R1 ; SUBCASE 8' - CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR3A) !, CALCR5) - SCASE = 'R1 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR6) THEN - SCASE = 'R1 ; SUBCASE 9' - CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A) - SCASE = 'R1 ; SUBCASE 9' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXAC) THEN ! *** NH4CL = 0 - IF ( EXAN .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR7) THEN - SCASE = 'R1 ; SUBCASE 10' - CALL CALCMDRP (RH, DRMR7, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 10' - ENDIF - - ELSE IF ( EXAN .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR8) THEN - SCASE = 'R1 ; SUBCASE 11' - CALL CALCMDRP (RH, DRMR8, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 11' - ENDIF - - ELSE IF ( EXAN .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR9) THEN - SCASE = 'R1 ; SUBCASE 12' - CALL CALCMDRP (RH, DRMR9, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 12' - ENDIF - - ELSE IF ( EXAN .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR10) THEN - SCASE = 'R1 ; SUBCASE 13' - CALL CALCMDRP (RH, DRMR10, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 13' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXSN) THEN ! *** NANO3 = 0 - IF ( EXAN .AND. EXAC .AND. EXSC) THEN - IF (RH >= DRMR11) THEN - SCASE = 'R1 ; SUBCASE 14' - CALL CALCMDRP (RH, DRMR11, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 14' - ENDIF - - ELSE IF ( EXAN .AND. EXAC .AND. .NOT. EXSC) THEN - IF (RH >= DRMR12) THEN - SCASE = 'R1 ; SUBCASE 15' - CALL CALCMDRP (RH, DRMR12, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 15' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXSC) THEN ! *** NACL = 0 - IF ( EXAN .AND. EXAC .AND. EXSN) THEN - IF (RH >= DRMR13) THEN - SCASE = 'R1 ; SUBCASE 16' - CALL CALCMDRP (RH, DRMR13, DRNH4NO3, CALCR1A, CALCR2A) - SCASE = 'R1 ; SUBCASE 16' - ENDIF - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCR1 ****************************************** - - END SUBROUTINE CALCR1 - - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCR1A -! *** CASE R1 ; SUBCASE 1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCR1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE SOLIDS ************************************************** - - CNA2SO4 = WAER(2) - FRNA = MAX (WAER(1)-2*CNA2SO4, ZERO) - - CNH42S4 = ZERO - - CNANO3 = MIN (FRNA, WAER(4)) - FRNO3 = MAX (WAER(4)-CNANO3, ZERO) - FRNA = MAX (FRNA-CNANO3, ZERO) - - CNACL = MIN (FRNA, WAER(5)) - FRCL = MAX (WAER(5)-CNACL, ZERO) - FRNA = MAX (FRNA-CNACL, ZERO) - - CNH4NO3 = MIN (FRNO3, WAER(3)) - FRNO3 = MAX (FRNO3-CNH4NO3, ZERO) - FRNH3 = MAX (WAER(3)-CNH4NO3, ZERO) - - CNH4CL = MIN (FRCL, FRNH3) - FRCL = MAX (FRCL-CNH4CL, ZERO) - FRNH3 = MAX (FRNH3-CNH4CL, ZERO) - -! *** OTHER PHASES ****************************************************** - - WATER = ZERO - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCR1A ***************************************** - - END SUBROUTINE CALCR1A -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV7 -! *** CASE V7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV7 - INCLUDE 'isrpia.inc' - - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! ION CONCENTRATIONS - - NAI = WAER(1) - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV7') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV7 ****************************************** - - END SUBROUTINE CALCV7 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV6 -! *** CASE V6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV6 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSI70 =-GREAT ! GREAT = 1.D10 - ROOT7 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*WAER(2) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MIN (ROOT7,WAER(7)/2.0,MAX(WAER(2)-WAER(6),ZERO),CHI7) - ROOT7 = MAX (ROOT7, ZERO) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV6') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV6 ****************************************** - - END SUBROUTINE CALCV6 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV5 -! *** CASE V5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV5 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX(WAER(2)-WAER(6) - ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX ((WAER(2)-WAER(6)) - ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX ((WAER(2)-WAER(6)) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV5') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV5****************************************** - - END SUBROUTINE CALCV5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV4 -! *** CASE V4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV4 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX((WAER(2)-WAER(6)) - ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX ((WAER(2)-WAER(6)) - ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX ((WAER(2)-WAER(6)) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV4') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV4****************************************** - - END SUBROUTINE CALCV4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV3 -! *** CASE V3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV3 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCV1A, CALCV4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO .OR. EXCL) THEN ! *** NITRATE OR CHLORIDE EXISTS - SCASE = 'V3 ; SUBCASE 1' - CALL CALCV3A - SCASE = 'V3 ; SUBCASE 1' - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMO3) THEN - SCASE = 'V3 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V3 ; SUBCASE 2' - ELSE - SCASE = 'V3 ; SUBCASE 3' ! MDRH (CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4) - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V3 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCV3 ****************************************** - - END SUBROUTINE CALCV3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV3A -! *** CASE V3A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV3A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1, PSCONV6 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - PSCONV6 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI60 =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - ROOT6 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 - CHI6 = CNH42S4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = WAER(2) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A6 = XK7 *(WATER/GAMA(4))**3.0 !(NH4)2SO4 <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1 - ROOT6) - CC = WAER(7)*((WAER(2) - WAER(6)) - ROOT1 - ROOT6) + & - & 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6))-ROOT1-ROOT6)-A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT1-ROOT6, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7 - ROOT6) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7 - ROOT6) + & - & 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6))-ROOT7-ROOT6)-A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT7-ROOT6, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM SULFATE - - IF (NH4I*NH4I*SO4I > A6) THEN - BB =-((WAER(2)-WAER(6)) + WAER(3) - ROOT7 - ROOT1) - CC = WAER(3)*((WAER(2)-WAER(6)) - ROOT7 - ROOT1) + & - & 0.25*WAER(3)*WAER(3) - DD =-0.25*(WAER(3)*WAER(3)*((WAER(2)-WAER(6))-ROOT7-ROOT1)-A6) - CALL POLY3(BB, CC, DD, ROOT6, ISLV) - IF (ISLV /= 0) ROOT6 = TINY - ROOT6 = MAX (ROOT6, ZERO) - ROOT6 = MIN (ROOT6, WAER(3)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT7-ROOT1, ZERO), CHI6) - PSI6 = CHI6-ROOT6 - ENDIF - PSCONV6 = ABS(PSI6-PSI60) <= EPS*PSI60 - PSI60 = PSI6 - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1 - ROOT6, ZERO) - NH4I = MAX (WAER(3) - 2.D0*ROOT6, ZERO) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1 .AND. PSCONV6) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV3') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = CHI6 - PSI6 - CNH4NO3 = ZERO - CNH4CL = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV3A****************************************** - - END SUBROUTINE CALCV3A - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCV2 -! *** CASE V2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV2 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCV1A, CALCV3A, CALCV4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO) THEN ! *** NITRATE EXISTS - SCASE = 'V2 ; SUBCASE 1' - CALL CALCV2A - SCASE = 'V2 ; SUBCASE 1' - - ELSEIF ( .NOT. EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH < DRMO2) THEN - SCASE = 'V2 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V2 ; SUBCASE 2' - ELSE - SCASE = 'V2 ; SUBCASE 3' ! MDRH CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - CALL CALCMDRPII (RH, DRMO2, DRNH4CL, CALCV1A, CALCV3A) - SCASE = 'V2 ; SUBCASE 3' - ENDIF - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMO3) THEN - SCASE = 'V2 ; SUBCASE 2' - CALL CALCV1A ! SOLID - SCASE = 'V2 ; SUBCASE 2' - ELSE - SCASE = 'V2 ; SUBCASE 4' ! MDRH CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4 - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V2 ; SUBCASE 4' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCV2 ****************************************** - - END SUBROUTINE CALCV2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV2A -! *** CASE V2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, (NH4)2SO4, NH4CL -! 4. Completely dissolved: NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV2A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1, PSCONV6, PSCONV4 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - PSCONV6 = .TRUE. - PSCONV4 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI60 =-GREAT - PSI40 =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - ROOT6 = ZERO - ROOT4 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCV1A - - CHI9 = CCASO4 - CHI7 = CK2SO4 ! SALTS - CHI1 = CNA2SO4 - CHI8 = CMGSO4 - CHI6 = CNH42S4 - CHI4 = CNH4CL - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI6 = CNH42S4 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A6 = XK7 *(WATER/GAMA(4))**3.0 ! (NH4)2SO4 <==> NH4+ - A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - 2.D0*ROOT6) - CC = WAER(5)*(WAER(3) - 2.D0*ROOT6) - A14 - DD = BB*BB - 4.D0*CC - IF (DD < ZERO) THEN - ROOT4 = ZERO - ELSE - DD = SQRT(DD) - ROOT4A= 0.5D0*(-BB+DD) - ROOT4B= 0.5D0*(-BB-DD) - IF (ZERO <= ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MAX(ROOT4, ZERO) - ROOT4 = MIN(ROOT4, WAER(5), & - MAX (WAER(3) - 2.D0*ROOT6, ZERO), CHI4) - PSI4 = CHI4 - ROOT4 - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSI40) <= EPS*PSI40 - PSI40 = PSI4 - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2) - WAER(6)) + WAER(7) - ROOT1 - ROOT6) - CC = WAER(7)*((WAER(2) - WAER(6)) - ROOT1 - ROOT6) & - + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6))-ROOT1-ROOT6)-A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT1-ROOT6, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2) - WAER(6)) + WAER(1) - ROOT7 - ROOT6) - CC = WAER(1)*((WAER(2) - WAER(6)) - ROOT7 - ROOT6) + & - & 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6))-ROOT7-ROOT6)-A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT7-ROOT6, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM SULFATE - - IF (NH4I*NH4I*SO4I > A6) THEN - BB =-((WAER(2)-WAER(6)) + WAER(3) - ROOT7 - ROOT1 - ROOT4) - CC = WAER(3)*((WAER(2)-WAER(6)) - ROOT7 - ROOT1) + 0.25* & - (WAER(3)-ROOT4)**2.0 + ROOT4*(ROOT1+ROOT7-(WAER(2)-WAER(6))) - DD =-0.25*((WAER(3)-ROOT4)**2.0 * & - ((WAER(2)-WAER(6))-ROOT7-ROOT1) - A6) - CALL POLY3(BB, CC, DD, ROOT6, ISLV) - IF (ISLV /= 0) ROOT6 = TINY - ROOT6 = MAX (ROOT6, ZERO) - ROOT6 = MIN (ROOT6, WAER(3)/2.0, & - MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO), CHI6) - PSI6 = CHI6-ROOT6 - ENDIF - PSCONV6 = ABS(PSI6-PSI60) <= EPS*PSI60 - PSI60 = PSI6 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1 - ROOT6, ZERO) - NH4I = MAX (WAER(3) - 2.D0*ROOT6, ZERO) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1 .AND. PSCONV6 .AND. PSCONV4) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCV2') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = CHI6 - PSI6 - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCV2A****************************************** - - END SUBROUTINE CALCV2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV1 -! *** CASE V1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV1 - INCLUDE 'isrpia.inc' - LOGICAL :: EXNO, EXCL - EXTERNAL CALCV1A, CALCV2A, CALCV3A, CALCV4 - -! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** - - EXNO = WAER(4) > TINY - EXCL = WAER(5) > TINY - - IF (EXNO .AND. EXCL) THEN ! *** NITRATE & CHLORIDE EXIST - IF (RH < DRMO1) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 2' ! MDRH (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO1, DRNH4NO3, CALCV1A, CALCV2A) - SCASE = 'V1 ; SUBCASE 2' - ENDIF - - ELSE IF (EXNO .AND. .NOT. EXCL) THEN ! *** ONLY NITRATE EXISTS - IF (RH < DRMV1) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 3' ! MDRH (NH4)2SO4, NH4NO3, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMV1, DRNH4NO3, CALCV1A, CALCV2A) - SCASE = 'V1 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS - IF (RH < DRMO2) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 4' ! MDRH (NH4)2SO4, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO2, DRNH4CL, CALCV1A, CALCV3A) - SCASE = 'V1 ; SUBCASE 4' - ENDIF - - ELSE ! *** NO CHLORIDE AND NITRATE - IF (RH < DRMO3) THEN - SCASE = 'V1 ; SUBCASE 1' - CALL CALCV1A ! SOLID - SCASE = 'V1 ; SUBCASE 1' - ELSE - SCASE = 'V1 ; SUBCASE 5' ! MDRH (NH4)2SO4, NA2SO4, K2SO4, MGSO4, CASO4 - CALL CALCMDRPII (RH, DRMO3, DRNH42S4, CALCV1A, CALCV4) - SCASE = 'V1 ; SUBCASE 5' - ENDIF - ENDIF - - RETURN - -! IF (RH.LT.DRMO1) THEN -! SCASE = 'V1 ; SUBCASE 1' -! CALL CALCV1A ! SOLID PHASE ONLY POSSIBLE -! SCASE = 'V1 ; SUBCASE 1' -! ELSE -! SCASE = 'V1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE -! CALL CALCMDRPII (RH, DRMO1, DRNH4NO3, CALCV1A, CALCV2A) -! SCASE = 'V1 ; SUBCASE 2' -! ENDIF - -! RETURN - -! *** END OF SUBROUTINE CALCV1 ****************************************** - - END SUBROUTINE CALCV1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCV1A -! *** CASE V1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCV1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE SOLIDS ************************************************** - - CCASO4 = MIN (WAER(6), WAER(2)) ! CCASO4 - SO4FR = MAX (WAER(2) - CCASO4, ZERO) - CAFR = MAX (WAER(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*WAER(7), SO4FR) ! CK2SO4 - FRK = MAX (WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CNA2SO4 = MIN (0.5D0*WAER(1), SO4FR) ! CNA2SO4 - NAFR = MAX (WAER(1) - 2.D0*CNA2SO4, ZERO) - SO4FR = MAX (SO4FR - CNA2SO4, ZERO) - CMGSO4 = MIN (WAER(8), SO4FR) ! CMGSO4 - FRMG = MAX(WAER(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNH42S4 = MAX (MIN (SO4FR , 0.5d0*WAER(3)) , TINY) - FRNH3 = MAX (WAER(3) - 2.D0*CNH42S4, ZERO) - - CNH4NO3 = MIN (FRNH3, WAER(4)) -! C FRNO3 = MAX (WAER(4) - CNH4NO3, ZERO) - FRNH3 = MAX (FRNH3 - CNH4NO3, ZERO) - - CNH4CL = MIN (FRNH3, WAER(5)) -! C FRCL = MAX (WAER(5) - CNH4CL, ZERO) - FRNH3 = MAX (FRNH3 - CNH4CL, ZERO) - -! *** OTHER PHASES ****************************************************** - - WATER = ZERO - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCV1A ***************************************** - - END SUBROUTINE CALCV1A -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCU8 -! *** CASE U8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -! 2. THERE IS ONLY A LIQUID PHASE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU8 - INCLUDE 'isrpia.inc' - - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - CALL CALCU1A - - CHI9 = CCASO4 ! SALTS - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE WATER ************************************************** - - CALL CALCMR - -! *** SETUP LIQUID CONCENTRATIONS ************************************** - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - NAI = WAER(1) - SO4I = MAX(WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) - - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - IF (HI <= TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU8') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1) = NH3AQ - GASAQ(2) = CLAQ - GASAQ(3) = NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCU8 ****************************************** - - END SUBROUTINE CALCU8 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU7 -! *** CASE U7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MGSO4, NA2SO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU7 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSI70 =-GREAT ! GREAT = 1.D10 - ROOT7 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI7 = CK2SO4 ! SALTS - CHI9 = CCASO4 - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*(WAER(2)-WAER(6)) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7,WAER(7)/2.0,MAX(WAER(2)-WAER(6),ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU7') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCU7 ****************************************** - - END SUBROUTINE CALCU7 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU6 -! *** CASE U6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MGSO4 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU6 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI1 = CNA2SO4 ! SALTS - CHI7 = CK2SO4 - CHI9 = CCASO4 - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX((WAER(2)-WAER(6)) - ROOT1,ZERO), CHI7) - PSI7 = CHI7-ROOT7 - - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX((WAER(2)-WAER(6)) - ROOT7, ZERO) ,CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU6') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCU6****************************************** - - END SUBROUTINE CALCU6 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU5 -! *** CASE U5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4 -! 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU5 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .TRUE. - PSCONV1 = .TRUE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI1 = CNA2SO4 ! SALTS - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX(WAER(2)-WAER(6)-ROOT7, ZERO),CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU5') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCU5****************************************** - - END SUBROUTINE CALCU5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU4 -! *** CASE U4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU4 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'U4 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U4 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .OR. EXSN .OR. EXSC) THEN ! *** NH4NO3,NANO3 EXIST - IF (RH >= DRMM1) THEN - SCASE = 'U4 ; SUBCASE 1' - CALL CALCU4A - SCASE = 'U4 ; SUBCASE 1' - ENDIF - - ELSE IF (EXAC) THEN ! *** NH4CL EXISTS ONLY - IF (RH >= DRMR5) THEN - SCASE = 'U4 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU5) - SCASE = 'U4 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCU4 ****************************************** - - END SUBROUTINE CALCU4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU4A -! *** CASE U4A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL -! 4. Completely dissolved: NH4NO3, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU4A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1, PSCONV4 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .FALSE. - PSCONV1 = .FALSE. - PSCONV4 = .FALSE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI1 = CNA2SO4 ! SALTS - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 - - PSI1 = CNA2SO4 - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX(WAER(2)-WAER(6)-ROOT1, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-((WAER(2)-WAER(6)) + WAER(1) - ROOT7) - CC = WAER(1)*((WAER(2)-WAER(6)) - ROOT7) + 0.25*WAER(1)*WAER(1) - DD =-0.25*(WAER(1)*WAER(1)*((WAER(2)-WAER(6)) - ROOT7) - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MAX (ROOT1, ZERO) - ROOT1 = MIN (ROOT1, WAER(1)/2.0, & - MAX (WAER(2)-WAER(6)-ROOT7, ZERO), CHI1) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(NH4I + CLI) - CC =-A14 + NH4I*CLI - DD = BB*BB - 4.D0*CC - ROOT4 = 0.5D0*(-BB-SQRT(DD)) - IF (ROOT4 > TINY) THEN - ROOT4 = MIN(MAX (ROOT4, ZERO), CHI4) - PSI4 = CHI4 - ROOT4 - ENDIF - ENDIF - PSCONV4 = ABS(PSI4-PSI40) <= EPS*PSI40 - PSI40 = PSI4 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = WAER(4) - CLI = MAX (WAER(5) - ROOT4, ZERO) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1 .AND. PSCONV4) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU4') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = ZERO - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - - RETURN - -! *** END OF SUBROUTINE CALCU4A **************************************** - - END SUBROUTINE CALCU4A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU3 -! *** CASE U3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU3 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU4A, CALCU5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'U3 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U3 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .OR. EXSN) THEN ! *** NH4NO3,NANO3 EXIST - IF (RH >= DRMM1) THEN - SCASE = 'U3 ; SUBCASE 1' - CALL CALCU3A - SCASE = 'U3 ; SUBCASE 1' - ENDIF - - ELSE IF ( .NOT. EXAN .AND. .NOT. EXSN) THEN ! *** NH4NO3,NANO3 = 0 - IF ( EXAC .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'U3 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U3 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'U3 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U3 ; SUBCASE 4' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'U3 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR5, DRNACL, CALCU1A, CALCU5) - SCASE = 'U3 ; SUBCASE 5' - ENDIF - ENDIF - - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCU3 ****************************************** - - END SUBROUTINE CALCU3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU3A -! *** CASE U3A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NACL -! 4. Completely dissolved: NH4NO3, NANO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU3A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1, PSCONV4, PSCONV3 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .FALSE. - PSCONV1 = .FALSE. - PSCONV4 = .FALSE. - PSCONV3 = .FALSE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT - PSI30 =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO - ROOT3 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI1 = CNA2SO4 ! SALTS - CHI3 = CNACL - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - A8 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-(((WAER(2)-WAER(6))-ROOT7)*(WAER(1) - ROOT3)) - CC = ((WAER(2) - WAER(6)) - ROOT7)*(WAER(1) - ROOT3) + & - & 0.25D0*(WAER(1) - ROOT3)**2. - DD =-0.25D0*(((WAER(2) - WAER(6)) - ROOT7)* & - (WAER(1) - ROOT3)**2.D0 - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1, ZERO), MAX(WAER(1) - ROOT3, ZERO), & - CHI1, MAX(WAER(2)-WAER(6), ZERO)) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT4) - CC =-A14 + NH4I*(WAER(5) - ROOT4) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - ROOT4A= 0.5D0*(-BB+SQRT(DD)) - ROOT4B= 0.5D0*(-BB-SQRT(DD)) - IF (ZERO <= ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MIN(MAX(ZERO, ROOT4), MAX(WAER(5)-ROOT3,ZERO), & - CHI4, WAER(3)) - PSI4 = CHI4 - ROOT4 - ENDIF - PSCONV4 = ABS(PSI4-PSI40) <= EPS*PSI40 - PSI40 = PSI4 - - ! SODIUM CHLORIDE ; To obtain new value for ROOT3 - - IF (NAI*CLI > A8) THEN - BB =-((CHI1-2.D0*ROOT1) + (WAER(5) - ROOT4)) - CC = (CHI1-2.D0*ROOT1)*(WAER(5) - ROOT4) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT3A= 0.5D0*(-BB-SQRT(DD)) - ROOT3B= 0.5D0*(-BB+SQRT(DD)) - IF (ZERO <= ROOT3A) THEN - ROOT3 = ROOT3A - ELSE - ROOT3 = ROOT3B - ENDIF - ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) - PSI3 = CHI3-ROOT3 - ENDIF - PSCONV3 = ABS(PSI3-PSI30) <= EPS*PSI30 - PSI30 = PSI3 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.D0*ROOT1 - ROOT3, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = WAER(4) - CLI = MAX (WAER(5) - ROOT4 - ROOT3, ZERO) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1 .AND. PSCONV4 .AND. PSCONV3) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU3A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 IF (CLI <= TINY .AND. WAER(5) > TINY) THEN !No disslv Cl-;solid only - DO 30 I=1,NIONS - MOLAL(I) = ZERO - 30 END DO - DO 40 I=1,NGASAQ - GASAQ(I) = ZERO - 40 END DO - CALL CALCU1A - ELSE - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = CHI3 - PSI3 - CNANO3 = ZERO - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCU3A***************************************** - - END SUBROUTINE CALCU3A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU2 -! *** CASE U2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3, NACL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU2 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU3A, CALCU4A, CALCU5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'U2 ; SUBCASE 2' - CALL CALCU1A ! SOLID - SCASE = 'U2 ; SUBCASE 2' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN) THEN ! *** NH4NO3 EXISTS - IF (RH >= DRMM1) THEN - SCASE = 'U2 ; SUBCASE 1' - CALL CALCU2A - SCASE = 'U2 ; SUBCASE 1' - ENDIF - - ELSE IF ( .NOT. EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMM2) THEN - SCASE = 'U2 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR1) THEN - SCASE = 'U2 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR1, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 4' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'U2 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U2 ; SUBCASE 5' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR3) THEN - SCASE = 'U2 ; SUBCASE 6' - CALL CALCMDRPII (RH, DRMR3, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'U2 ; SUBCASE 7' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU4A) - SCASE = 'U2 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'U2 ; SUBCASE 8' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU5) - SCASE = 'U2 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR6) THEN - SCASE = 'U2 ; SUBCASE 9' - CALL CALCMDRPII (RH, DRMR6, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U2 ; SUBCASE 9' - ENDIF - ENDIF - - ENDIF - - RETURN - -! IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE -! SCASE = 'U2 ; SUBCASE 1' -! CALL CALCU2A -! SCASE = 'U2 ; SUBCASE 1' -! ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE -! SCASE = 'U2 ; SUBCASE 1' -! CALL CALCU1A -! SCASE = 'U2 ; SUBCASE 1' -! ENDIF -!C -! IF (WATER.LE.TINY .AND. RH.LT.DRMM2) THEN ! DRY AEROSOL -! SCASE = 'U2 ; SUBCASE 2' -! CALL CALCU2A -! SCASE = 'U2 ; SUBCASE 1' -!C -! ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMM2) THEN ! MDRH OF M2 -! SCASE = 'U2 ; SUBCASE 3' -! CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) -! SCASE = 'U2 ; SUBCASE 3' -! ENDIF -!C -! RETURN - -! *** END OF SUBROUTINE CALCU2 ****************************************** - - END SUBROUTINE CALCU2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU2A -! *** CASE U2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3 -! 4. Completely dissolved: NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU2A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV7, PSCONV1, PSCONV4, PSCONV3, PSCONV5 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV7 = .FALSE. - PSCONV1 = .FALSE. - PSCONV4 = .FALSE. - PSCONV3 = .FALSE. - PSCONV5 = .FALSE. - - PSI70 =-GREAT ! GREAT = 1.D10 - PSI1O =-GREAT - PSI40 =-GREAT - PSI30 =-GREAT - PSI50 =-GREAT - - ROOT7 = ZERO - ROOT1 = ZERO - ROOT4 = ZERO - ROOT3 = ZERO - ROOT5 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCU1A - - CHI1 = CNA2SO4 ! SALTS - CHI2 = CNANO3 - CHI3 = CNACL - CHI4 = CNH4CL - CHI7 = CK2SO4 - CHI8 = CMGSO4 - CHI9 = CCASO4 - - PSI1 = CNA2SO4 ! AMOUNT DISSOLVED - PSI2 = CNANO3 - PSI3 = CNACL - PSI4 = CNH4CL - PSI5 = CNH4NO3 - PSI7 = CK2SO4 - PSI8 = CMGSO4 - PSI9 = CCASO4 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - - MOLAL(1) = ZERO - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A7 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A1 = XK5 *(WATER/GAMA(2))**3.0 ! NA2S04 <==> Na+ - A14 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A8 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A9 = XK9 *(WATER/GAMA(3))**2.0 ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A7) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT1) - CC = WAER(7)*((WAER(2)-WAER(6)) - ROOT1) + 0.25*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*((WAER(2)-WAER(6)) - ROOT1) - A7) - CALL POLY3(BB, CC, DD, ROOT7, ISLV) - IF (ISLV /= 0) ROOT7 = TINY - ROOT7 = MAX (ROOT7, ZERO) - ROOT7 = MIN (ROOT7, WAER(7)/2.0, & - MAX(WAER(2)-WAER(6)-ROOT1, ZERO),CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI70) <= EPS*PSI70 - PSI70 = PSI7 - - ! SODIUM SULFATE - - IF (NAI*NAI*SO4I > A1) THEN - BB =-(((WAER(2)-WAER(6))-ROOT7)*(WAER(1) - ROOT3 - ROOT5)) - CC = ((WAER(2)-WAER(6)) - ROOT7)*(WAER(1) - ROOT3 - ROOT5) + & - & 0.25D0*(WAER(1) - ROOT3 - ROOT5)**2.0 - DD =-0.25D0*(((WAER(2) - WAER(6)) - ROOT7)* & - (WAER(1) - ROOT3 - ROOT5)**2.D0 - A1) - CALL POLY3(BB, CC, DD, ROOT1, ISLV) - IF (ISLV /= 0) ROOT1 = TINY - ROOT1 = MIN (MAX(ROOT1,ZERO), MAX(WAER(1)-ROOT3-ROOT5,ZERO), & - CHI1, MAX(WAER(2)-WAER(6),ZERO)) - PSI1 = CHI1-ROOT1 - ENDIF - PSCONV1 = ABS(PSI1-PSI1O) <= EPS*PSI1O - PSI1O = PSI1 - - ! AMMONIUM CHLORIDE - - IF (NH4I*CLI > A14) THEN - BB =-(WAER(3) + WAER(5) - ROOT4) - CC =-A14 + NH4I*(WAER(5) - ROOT4) - DD = MAX(BB*BB - 4.D0*CC, ZERO) - ROOT4A= 0.5D0*(-BB+SQRT(DD)) - ROOT4B= 0.5D0*(-BB-SQRT(DD)) - IF (ZERO <= ROOT4A) THEN - ROOT4 = ROOT4A - ELSE - ROOT4 = ROOT4B - ENDIF - ROOT4 = MIN(MAX(ZERO, ROOT4), MAX(WAER(5)-ROOT3,ZERO), & - CHI4, WAER(3)) - PSI4 = CHI4 - ROOT4 - ENDIF - PSCONV4 = ABS(PSI4-PSI40) <= EPS*PSI40 - PSI40 = PSI4 - - ! SODIUM CHLORIDE ; To obtain new value for ROOT3 - - IF (NAI*CLI > A8) THEN - BB =-((CHI1-2.D0*ROOT1-ROOT5) + (WAER(5) - ROOT4)) - CC = (CHI1-2.D0*ROOT1-ROOT5)*(WAER(5) - ROOT4) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT3A= 0.5D0*(-BB-SQRT(DD)) - ROOT3B= 0.5D0*(-BB+SQRT(DD)) - IF (ZERO <= ROOT3A) THEN - ROOT3 = ROOT3A - ELSE - ROOT3 = ROOT3B - ENDIF - ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) - PSI3 = CHI3-ROOT3 - ENDIF - PSCONV3 = ABS(PSI3-PSI30) <= EPS*PSI30 - PSI30 = PSI3 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A9) THEN - BB =-(WAER(4) + WAER(1) - 2.D0*ROOT1 - ROOT3) - CC = WAER(4)*(WAER(1) - 2.D0*ROOT1 - ROOT3) - A9 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A= 0.5D0*(-BB-DD) - ROOT5B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI2) - PSI2 = CHI2-ROOT5 - ENDIF - - PSCONV5 = ABS(PSI2-PSI20) <= EPS*PSI20 - PSI20 = PSI2 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.0D0*ROOT7, ZERO) - NAI = MAX (WAER(1) - 2.0D0*ROOT1 - ROOT3 - ROOT5, ZERO) - SO4I = MAX (WAER(2) - WAER(6) - ROOT7 - ROOT1, ZERO) - NH4I = MAX (WAER(3) - ROOT4, ZERO) - NO3I = MAX (WAER(4) - ROOT5, ZERO) - CLI = MAX (WAER(5) - ROOT4 - ROOT3, ZERO) - CAI = ZERO - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - ! IF (HI.LE.TINY) HI = SQRT(AKW) - ! OHI = AKW/HI - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV7 .AND. PSCONV1 .AND. PSCONV4 .AND. PSCONV3 & - .AND. PSCONV5) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCU2A') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 IF (CLI <= TINY .AND. WAER(5) > TINY) THEN !No disslv Cl-;solid only - DO 30 I=1,NIONS - MOLAL(I) = ZERO - 30 END DO - DO 40 I=1,NGASAQ - GASAQ(I) = ZERO - 40 END DO - CALL CALCU1A - ELSE ! OK, aqueous phase present - A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI4 - PSI4 - CNACL = CHI3 - PSI3 - CNANO3 = CHI2 - PSI2 - CNA2SO4 = CHI1 - PSI1 - CMGSO4 = ZERO - CK2SO4 = CHI7 - PSI7 - CCASO4 = MIN (WAER(6), WAER(2)) - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCU2A***************************************** - - END SUBROUTINE CALCU2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCU1 -! *** CASE U1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SO4RAT > 2.0), (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2. -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4, MGSO4, NH4CL, NANO3, NACL, NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU1 - INCLUDE 'isrpia.inc' - LOGICAL :: EXAN, EXAC, EXSN, EXSC - EXTERNAL CALCU1A, CALCU2A, CALCU3A, CALCU4A, CALCU5 - -! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** - - SCASE = 'U1 ; SUBCASE 1' - CALL CALCU1A ! SOLID - SCASE = 'U1 ; SUBCASE 1' - - EXAN = CNH4NO3 > TINY ! NH4NO3 - EXAC = CNH4CL > TINY ! NH4CL - EXSN = CNANO3 > TINY ! NANO3 - EXSC = CNACL > TINY ! NACL - -! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** - - IF (EXAN .OR. EXAC .OR. EXSC .OR. EXSN) THEN ! *** WATER POSSIBLE - IF (RH >= DRMM1) THEN - SCASE = 'U1 ; SUBCASE 2' ! MDRH - CALL CALCMDRPII (RH, DRMM1, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 2' - ENDIF - - ELSE IF ( .NOT. EXAN) THEN ! *** NH4NO3 = 0 - IF ( EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMM2) THEN - SCASE = 'U1 ; SUBCASE 3' - CALL CALCMDRPII (RH, DRMM2, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 3' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR1) THEN - SCASE = 'U1 ; SUBCASE 4' - CALL CALCMDRPII (RH, DRMR1, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 4' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR2) THEN - SCASE = 'U1 ; SUBCASE 5' - CALL CALCMDRPII (RH, DRMR2, DRNACL, CALCU1A, CALCU3A) !, CALCR4A) - SCASE = 'U1 ; SUBCASE 5' - ENDIF - - ELSE IF ( .NOT. EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR3) THEN - SCASE = 'U1 ; SUBCASE 6' - CALL CALCMDRPII (RH, DRMR3, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 6' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR4) THEN - SCASE = 'U1 ; SUBCASE 7' - CALL CALCMDRPII (RH, DRMR4, DRNACL, CALCU1A, CALCU3A) !, CALCR4A) - SCASE = 'U1 ; SUBCASE 7' - ENDIF - - ELSE IF ( EXAC .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR5) THEN - SCASE = 'U1 ; SUBCASE 8' - CALL CALCMDRPII (RH, DRMR5, DRNH4CL, CALCU1A, CALCU3A) !, CALCR5) - SCASE = 'U1 ; SUBCASE 8' - ENDIF - - ELSE IF ( EXAC .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR6) THEN - SCASE = 'U1 ; SUBCASE 9' - CALL CALCMDRPII (RH, DRMR6, DRNANO3, CALCU1A, CALCU3A) - SCASE = 'U1 ; SUBCASE 9' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXAC) THEN ! *** NH4CL = 0 - IF ( EXAN .AND. EXSN .AND. EXSC) THEN - IF (RH >= DRMR7) THEN - SCASE = 'U1 ; SUBCASE 10' - CALL CALCMDRPII (RH, DRMR7, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 10' - ENDIF - - ELSE IF ( EXAN .AND. .NOT. EXSN .AND. EXSC) THEN - IF (RH >= DRMR8) THEN - SCASE = 'U1 ; SUBCASE 11' - CALL CALCMDRPII (RH, DRMR8, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 11' - ENDIF - - ELSE IF ( EXAN .AND. .NOT. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR9) THEN - SCASE = 'U1 ; SUBCASE 12' - CALL CALCMDRPII (RH, DRMR9, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 12' - ENDIF - - ELSE IF ( EXAN .AND. EXSN .AND. .NOT. EXSC) THEN - IF (RH >= DRMR10) THEN - SCASE = 'U1 ; SUBCASE 13' - CALL CALCMDRPII (RH, DRMR10, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 13' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXSN) THEN ! *** NANO3 = 0 - IF ( EXAN .AND. EXAC .AND. EXSC) THEN - IF (RH >= DRMR11) THEN - SCASE = 'U1 ; SUBCASE 14' - CALL CALCMDRPII (RH, DRMR11, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 14' - ENDIF - - ELSE IF ( EXAN .AND. EXAC .AND. .NOT. EXSC) THEN - IF (RH >= DRMR12) THEN - SCASE = 'U1 ; SUBCASE 15' - CALL CALCMDRPII (RH, DRMR12, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 15' - ENDIF - ENDIF - - ELSE IF ( .NOT. EXSC) THEN ! *** NACL = 0 - IF ( EXAN .AND. EXAC .AND. EXSN) THEN - IF (RH >= DRMR13) THEN - SCASE = 'U1 ; SUBCASE 16' - CALL CALCMDRPII (RH, DRMR13, DRNH4NO3, CALCU1A, CALCU2A) - SCASE = 'U1 ; SUBCASE 16' - ENDIF - ENDIF - ENDIF - - RETURN - - -! IF (RH.LT.DRMM1) THEN -! SCASE = 'U1 ; SUBCASE 1' -! CALL CALCU1A ! SOLID PHASE ONLY POSSIBLE -! SCASE = 'U1 ; SUBCASE 1' -! ELSE -! SCASE = 'U1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE -! CALL CALCMDRPII (RH, DRMM1, DRNH4NO3, CALCU1A, CALCU2A) -! SCASE = 'U1 ; SUBCASE 2' -! ENDIF -!C -! RETURN -!C -! *** END OF SUBROUTINE CALCU1 ****************************************** - - END SUBROUTINE CALCU1 - -!======================================================================= - -! *** ISORROPIA CODE -! *** SUBROUTINE CALCU1A -! *** CASE U1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0); CRUSTAL+SODIUM RICH (CRNARAT >= 2.0); CRUSTAL POOR (CRRAT<2) -! 2. THERE IS ONLY A SOLID PHASE - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCU1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE SOLIDS ************************************************* - - CCASO4 = MIN (WAER(6), WAER(2)) ! CCASO4 - SO4FR = MAX(WAER(2) - CCASO4, ZERO) - CAFR = MAX(WAER(6) - CCASO4, ZERO) - CK2SO4 = MIN (0.5D0*WAER(7), SO4FR) ! CK2SO4 - FRK = MAX(WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX(SO4FR - CK2SO4, ZERO) - CMGSO4 = MIN (WAER(8), SO4FR) ! CMGSO4 - FRMG = MAX(WAER(8) - CMGSO4, ZERO) - SO4FR = MAX(SO4FR - CMGSO4, ZERO) - CNA2SO4 = MAX (SO4FR, ZERO) ! CNA2SO4 - FRNA = MAX (WAER(1) - 2.D0*CNA2SO4, ZERO) - - CNH42S4 = ZERO - - CNANO3 = MIN (FRNA, WAER(4)) - FRNO3 = MAX (WAER(4)-CNANO3, ZERO) - FRNA = MAX (FRNA-CNANO3, ZERO) - - CNACL = MIN (FRNA, WAER(5)) - FRCL = MAX (WAER(5)-CNACL, ZERO) - FRNA = MAX (FRNA-CNACL, ZERO) - - CNH4NO3 = MIN (FRNO3, WAER(3)) - FRNO3 = MAX (FRNO3-CNH4NO3, ZERO) - FRNH3 = MAX (WAER(3)-CNH4NO3, ZERO) - - CNH4CL = MIN (FRCL, FRNH3) - FRCL = MAX (FRCL-CNH4CL, ZERO) - FRNH3 = MAX (FRNH3-CNH4CL, ZERO) - -! *** OTHER PHASES ****************************************************** - - WATER = ZERO - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCU1A ***************************************** - - END SUBROUTINE CALCU1A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW13 -! *** CASE W13 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW13 - INCLUDE 'isrpia.inc' - - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! ION CONCENTRATIONS - - NAI = WAER(1) - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - KI = WAER(7) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW13') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = ZERO - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = ZERO - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW13 ****************************************** - - END SUBROUTINE CALCW13 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW12 -! *** CASE W12 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW12 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSI9O =-GREAT ! GREAT = 1.D10 - ROOT9 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7)) - CC = WAER(7)*(WAER(2)-WAER(6)) + 0.25D0*WAER(7)*WAER(7) - DD =-0.25*(WAER(7)*WAER(7)*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0, (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW12') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = ZERO - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW12 ****************************************** - - END SUBROUTINE CALCW12 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW11 -! *** CASE W11 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW11 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13) - CC = (WAER(7)-ROOT13)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13)**2.0 - DD =-0.25*((WAER(7)-ROOT13)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9,WAER(7)/2.0-ROOT13,(WAER(2)-WAER(6)),CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW11') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW11 ****************************************** - - END SUBROUTINE CALCW11 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW10 -! *** CASE W10 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4 -! 4. Completely dissolved: CA(NO3)2, CACL2, KCL, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW10 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13) - CC = (WAER(7)-ROOT13)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13)**2.0 - DD =-0.25*((WAER(7)-ROOT13)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9,WAER(7)/2.0-ROOT13,(WAER(2)-WAER(6)),CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = WAER(5) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW10') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = ZERO - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW10 ****************************************** - - END SUBROUTINE CALCW10 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW9 -! *** CASE W9 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW9 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5) + WAER(7) - 2.D0*ROOT9 - ROOT13) - CC = WAER(5)*(WAER(7) - 2.D0*ROOT9 - ROOT13) - A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = WAER(3) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14, ZERO) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW9') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = ZERO - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW9 ****************************************** - - END SUBROUTINE CALCW9 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW8 -! *** CASE W8 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW8 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5) - ROOT5 + WAER(7) - 2.D0*ROOT9 - ROOT13) - CC = (WAER(5)-ROOT5)*(WAER(7) - 2.D0*ROOT9 - ROOT13) - A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14) - CC = (WAER(5)-ROOT14)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5, ZERO) - CAI = ZERO - NAI = WAER(1) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW8') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = ZERO - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW8 ****************************************** - - END SUBROUTINE CALCW8 -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW7 -! *** CASE W7 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NANO3, NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW7 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = WAER(4)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*WAER(1) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW7') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = ZERO - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW7 ****************************************** - - END SUBROUTINE CALCW7 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW6 -! *** CASE W6 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2, NH4NO3 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW6 - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - PSCONV8 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) <= EPS*PSI8O - PSI8O = PSI8 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW6') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW6 ****************************************** - - END SUBROUTINE CALCW6 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW5 -! *** CASE W5 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, -! MG(NO3)2, MGCL2 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW5 - INCLUDE 'isrpia.inc' - - EXTERNAL CALCW1A, CALCW6 - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (WAER(4) > TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'W5 ; SUBCASE 1' - CALL CALCW5A - SCASE = 'W5 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A - SCASE = 'W1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP5) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCW1A - SCASE = 'W5 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W5 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP5, DRNH4NO3, CALCW1A, CALCW6) - SCASE = 'W5 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCW5 ****************************************** - - END SUBROUTINE CALCW5 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW5A -! *** CASE W5A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3 -! 4. Completely dissolved: CA(NO3)2, CACL2, MG(NO3)2, MGCL2 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW5A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - PSCONV8 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) <= EPS*PSI8O - PSI8O = PSI8 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW5') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW5 ****************************************** - - END SUBROUTINE CALCW5A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW4 -! *** CASE W4 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW4 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW5A - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - - IF (WAER(4) > TINY) THEN ! NO3 EXIST, WATER POSSIBLE - SCASE = 'W4 ; SUBCASE 1' - CALL CALCW4A - SCASE = 'W4 ; SUBCASE 1' - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A - SCASE = 'W1 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP4) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCW1A - SCASE = 'W4 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W4 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP4, DRMGNO32, CALCW1A, CALCW5A) - SCASE = 'W4 ; SUBCASE 3' - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCW4 ****************************************** - - END SUBROUTINE CALCW4 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW4A -! *** CASE W4A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, MG(NO3)2 -! 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW4A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - PSCONV8 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) <= EPS*PSI8O - PSI8O = PSI8 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW4') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW4A ****************************************** - - END SUBROUTINE CALCW4A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW3 -! *** CASE W3 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW3 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW4A - -! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ - -! IF (WAER(4).GT.TINY .AND. WAER(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE -! SCASE = 'W3 ; SUBCASE 1' -! CALL CALCW3A -! SCASE = 'W3 ; SUBCASE 1' -! ELSE ! NO3, CL NON EXISTANT -! SCASE = 'W1 ; SUBCASE 1' -! CALL CALCW1A -! SCASE = 'W1 ; SUBCASE 1' -! ENDIF - - CALL CALCW1A - - IF (WATER <= TINY) THEN - IF (RH < DRMP3) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCW1A - SCASE = 'W3 ; SUBCASE 2' - RETURN - ELSE - SCASE = 'W3 ; SUBCASE 3' ! MDRH REGION (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP3, DRCANO32, CALCW1A, CALCW4A) - SCASE = 'W3 ; SUBCASE 3' - ENDIF - ELSE ! NO3, CL NON EXISTANT - SCASE = 'W3 ; SUBCASE 1' - CALL CALCW3A - SCASE = 'W3 ; SUBCASE 1' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCW3 ****************************************** - - END SUBROUTINE CALCW3 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW3A -! *** CASE W3A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, CA(NO3)2, MG(NO3)2 -! 4. Completely dissolved: CACL2, MGCL2 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW3A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - PSCONV8 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI12 = CCANO32 - CHI11 = CCASO4 -!C - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, ZERO)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) <= EPS*PSI8O - PSI8O = PSI8 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW3') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW3A ****************************************** - - END SUBROUTINE CALCW3A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW2 -! *** CASE W2 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! THERE ARE THREE REGIMES IN THIS CASE: -! 1. CACL2(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A) -! 2. CACL2(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY -! 3. CACL2(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL - -! REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES W1A, W2B -! RESPECTIVELY -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - - SUBROUTINE CALCW2 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW3A, CALCW4A, CALCW5A, CALCW6 - -! *** FIND DRY COMPOSITION ********************************************** - - CALL CALCW1A - -! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** - - IF (CCACL2 > TINY) THEN - SCASE = 'W2 ; SUBCASE 1' - CALL CALCW2A - SCASE = 'W2 ; SUBCASE 1' - ENDIF - - IF (WATER <= TINY) THEN - IF (RH < DRMP2) THEN ! ONLY SOLIDS - WATER = TINY - DO 10 I=1,NIONS - MOLAL(I) = ZERO - 10 END DO - CALL CALCW1A - SCASE = 'W2 ; SUBCASE 2' - ELSE - IF (CMGCL2 > TINY) THEN - SCASE = 'W2 ; SUBCASE 3' ! MDRH (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MGCL2, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP2, DRMGCL2, CALCW1A, CALCW3A) - SCASE = 'W2 ; SUBCASE 3' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP3 .AND. RH < DRMP4) THEN - SCASE = 'W2 ; SUBCASE 4' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, CANO32, - ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP3, DRCANO32, CALCW1A, CALCW4A) - SCASE = 'W2 ; SUBCASE 4' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP4 .AND. RH < DRMP5) THEN - SCASE = 'W2 ; SUBCASE 5' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! MGNO32, NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP4, DRMGNO32, CALCW1A, CALCW5A) - SCASE = 'W2 ; SUBCASE 5' - ENDIF - IF (WATER <= TINY .AND. RH >= DRMP5) THEN - SCASE = 'W2 ; SUBCASE 6' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, - ! NANO3, NACL, NH4NO3, NH4CL) - CALL CALCMDRPII (RH, DRMP5, DRNH4NO3, CALCW1A, CALCW6) - SCASE = 'W2 ; SUBCASE 6' - ELSE - WATER = TINY - DO 20 I=1,NIONS - MOLAL(I) = ZERO - 20 END DO - CALL CALCW1A - SCASE = 'W2 ; SUBCASE 2' - ENDIF - ENDIF - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCW2 ****************************************** - - END SUBROUTINE CALCW2 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW2A -! *** CASE W2A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. THERE IS BOTH A LIQUID & SOLID PHASE -! 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, -! NANO3, NH4NO3, CA(NO3)2, MG(NO3)2, MGCL2 -! 4. Completely dissolved: CACL2 - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW2A - INCLUDE 'isrpia.inc' - - LOGICAL :: PSCONV9, PSCONV13, PSCONV14, PSCONV5, PSCONV7, PSCONV8 - REAL :: NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, CAI, KI, MGI - - COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, & - CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, & - CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, & - PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, & - PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, & - A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17 - -! *** SETUP PARAMETERS ************************************************ - - FRST = .TRUE. - CALAIN = .TRUE. - CALAOU = .TRUE. - - PSCONV9 = .TRUE. - PSCONV13= .TRUE. - PSCONV14= .TRUE. - PSCONV5 = .TRUE. - PSCONV7 = .TRUE. - PSCONV8 = .TRUE. - - PSI9O =-GREAT - PSI13O =-GREAT - PSI14O =-GREAT - PSI5O =-GREAT - PSI7O =-GREAT - PSI8O =-GREAT ! GREAT = 1.D10 - - ROOT9 = ZERO - ROOT13 = ZERO - ROOT14 = ZERO - ROOT5 = ZERO - ROOT7 = ZERO - ROOT8 = ZERO - -! *** CALCULATE INITIAL SOLUTION *************************************** - - CALL CALCW1A - - CHI9 = CK2SO4 ! SALTS - CHI13 = CKNO3 - CHI10 = CMGSO4 - CHI14 = CKCL - CHI5 = CNH4CL - CHI7 = CNACL - CHI8 = CNANO3 - CHI6 = CNH4NO3 - CHI15 = CMGNO32 - CHI12 = CCANO32 - CHI16 = CMGCL2 - CHI11 = CCASO4 - - PSI1 = CNA2SO4 ! SALTS DISSOLVED - PSI5 = CNH4CL - PSI6 = CNH4NO3 - PSI7 = CNACL - PSI8 = CNANO3 - PSI9 = CK2SO4 - PSI10 = CMGSO4 - PSI11 = CCASO4 - PSI12 = CCANO32 - PSI13 = CKNO3 - PSI14 = CKCL - PSI15 = CMGNO32 - PSI16 = CMGCL2 - PSI17 = CCACL2 - - CALL CALCMR ! WATER - - NAI = WAER(1) ! LIQUID CONCENTRATIONS - SO4I = MAX (WAER(2) - WAER(6), ZERO) - NH4I = WAER(3) - NO3I = WAER(4) - CLI = WAER(5) - CAI = WAER(6) - KI = WAER(7) - MGI = WAER(8) - - HSO4I = ZERO - NH3AQ = ZERO - NO3AQ = ZERO - CLAQ = ZERO - -! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ - - DO 10 I=1,NSWEEP - - A9 = XK17 *(WATER/GAMA(17))**3.0 ! K2SO4 <==> K+ - A13 = XK19 *(WATER/GAMA(19))**2.0 ! KNO3 <==> K+ - A14 = XK20 *(WATER/GAMA(20))**2.0 ! KCL <==> K+ - A5 = XK14*(WATER/GAMA(6))**2.0 ! NH4Cl <==> NH4+ - A7 = XK8 *(WATER/GAMA(1))**2.0 ! NaCl <==> Na+ - A8 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ - AKW = XKW*RH*WATER*WATER ! H2O <==> H+ - - ! POTASSIUM SULFATE - - IF (KI*KI*SO4I > A9) THEN - BB =-((WAER(2)-WAER(6)) + WAER(7) - ROOT13 - ROOT14) - CC = (WAER(7)-ROOT13-ROOT14)*(WAER(2)-WAER(6)) + & - & 0.25D0*(WAER(7)-ROOT13-ROOT14)**2.0 - DD =-0.25*((WAER(7)-ROOT13-ROOT14)**2.0*(WAER(2)-WAER(6)) - A9) - CALL POLY3(BB, CC, DD, ROOT9, ISLV) - IF (ISLV /= 0) ROOT9 = TINY - ROOT9 = MIN (ROOT9, WAER(7)/2.0-ROOT13-ROOT14, & - (WAER(2)-WAER(6)), CHI9) - ROOT9 = MAX (ROOT9, ZERO) - PSI9 = CHI9 - ROOT9 - ENDIF - PSCONV9 = ABS(PSI9-PSI9O) <= EPS*PSI9O - PSI9O = PSI9 - - ! POTASSIUM NITRATE - - IF (KI*NO3I > A13) THEN - BB =-(WAER(4) - ROOT8 + WAER(7) - 2.D0*ROOT9 - ROOT14) - CC = (WAER(4)-ROOT8)*(WAER(7) - 2.D0*ROOT9 - ROOT14) - A13 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT13A= 0.5D0*(-BB-DD) - ROOT13B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT13A) THEN - ROOT13 = ROOT13A - ELSE - ROOT13 = ROOT13B - ENDIF - ROOT13 = MIN(MAX(ROOT13, ZERO), CHI13) - PSI13 = CHI13-ROOT13 - ENDIF - PSCONV13 = ABS(PSI13-PSI13O) <= EPS*PSI13O - PSI13O = PSI13 - - ! POTASSIUM CLORIDE - - IF (KI*CLI > A14) THEN - BB =-(WAER(5)-ROOT5-ROOT7 + WAER(7)-2.D0*ROOT9-ROOT13) - CC = (WAER(5)-ROOT5-ROOT7)*(WAER(7)-2.D0*ROOT9-ROOT13)-A14 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT14A= 0.5D0*(-BB-DD) - ROOT14B= 0.5D0*(-BB+DD) - IF (ZERO <= ROOT14A) THEN - ROOT14 = ROOT14A - ELSE - ROOT14 = ROOT14B - ENDIF - ROOT14 = MIN(MAX(ROOT14, ZERO), CHI14) - PSI14 = CHI14-ROOT14 - ENDIF - PSCONV14 = ABS(PSI14-PSI14O) <= EPS*PSI14O - PSI14O = PSI14 - - ! AMMONIUM CLORIDE - - IF (NH4I*CLI > A5) THEN - BB =-(WAER(5) + WAER(3) - ROOT14 - ROOT7) - CC = (WAER(5) - ROOT14 - ROOT7)*WAER(3) - A5 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT5A = 0.5D0*(-BB-DD) - ROOT5B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT5A) THEN - ROOT5 = ROOT5A - ELSE - ROOT5 = ROOT5B - ENDIF - ROOT5 = MIN(MAX(ROOT5, ZERO), CHI5) - PSI5 = CHI5-ROOT5 - ENDIF - PSCONV5 = ABS(PSI5-PSI5O) <= EPS*PSI5O - PSI5O = PSI5 - - ! SODIUM CLORIDE - - IF (NAI*CLI > A7) THEN - BB =-(WAER(5) + WAER(1) - ROOT8 - ROOT14 - ROOT5) - CC = (WAER(5) - ROOT14 - ROOT5)*(WAER(1)-ROOT8) - A7 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT7A = 0.5D0*(-BB-DD) - ROOT7B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT7A) THEN - ROOT7 = ROOT7A - ELSE - ROOT7 = ROOT7B - ENDIF - ROOT7 = MIN(MAX(ROOT7, ZERO), CHI7) - PSI7 = CHI7-ROOT7 - ENDIF - PSCONV7 = ABS(PSI7-PSI7O) <= EPS*PSI7O - PSI7O = PSI7 - - ! SODIUM NITRATE - - IF (NAI*NO3I > A8) THEN - BB =-(WAER(4) - ROOT13 + WAER(1) - ROOT7) - CC = (WAER(4) - ROOT13)*(WAER(1)-ROOT7) - A8 - DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) - ROOT8A = 0.5D0*(-BB-DD) - ROOT8B = 0.5D0*(-BB+DD) - IF (ZERO <= ROOT8A) THEN - ROOT8 = ROOT8A - ELSE - ROOT8 = ROOT8B - ENDIF - ROOT8 = MIN(MAX(ROOT8, ZERO), CHI8) - PSI8 = CHI8-ROOT8 - ENDIF - PSCONV8 = ABS(PSI8-PSI8O) <= EPS*PSI8O - PSI8O = PSI8 - - ! ION CONCENTRATIONS ; CORRECTIONS - - KI = MAX (WAER(7) - 2.D0*ROOT9 - ROOT13 - ROOT14, ZERO) - SO4I = MAX (WAER(2)-WAER(6) - ROOT9, ZERO) - NH4I = MAX (WAER(3) - ROOT5, ZERO) - NO3I = MAX (WAER(4) - ROOT13 - ROOT8, ZERO) - CLI = MAX (WAER(5) - ROOT14 - ROOT5 - ROOT7, ZERO) - CAI = ZERO - NAI = MAX (WAER(1) - ROOT7 - ROOT8, ZERO) - MGI = WAER(8) - - ! SOLUTION ACIDIC OR BASIC? - - GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I & - - 2.D0*CAI - KI - 2.D0*MGI - IF (GG > TINY) THEN ! H+ in excess - BB =-GG - CC =-AKW - DD = BB*BB - 4.D0*CC - HI = 0.5D0*(-BB + SQRT(DD)) - OHI= AKW/HI - ELSE ! OH- in excess - BB = GG - CC =-AKW - DD = BB*BB - 4.D0*CC - OHI= 0.5D0*(-BB + SQRT(DD)) - HI = AKW/OHI - ENDIF - - ! UNDISSOCIATED SPECIES EQUILIBRIA - - IF (HI > OHI) THEN - ! CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) - ! HI = AKW/OHI - ! HSO4I = ZERO - ! ELSE - ! GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I - 2.D0*CAI - ! & - KI - 2.D0*MGI, ZERO) - ! GGCL = MAX(GG-GGNO3, ZERO) - ! IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl - ! IF (GGNO3.GT.TINY) THEN - ! IF (GGCL.LE.TINY) HI = ZERO - ! CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 - ! ENDIF - - ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species. - - CALL CALCHS4 (HI, SO4I, ZERO, DEL) - else - del= zero - ENDIF - SO4I = SO4I - DEL - HI = HI - DEL - HSO4I = DEL - ! IF (HI.LE.TINY) HI = SQRT(AKW) - OHI = AKW/HI - - IF (HI <= TINY) THEN - HI = SQRT(AKW) - OHI = AKW/HI - ENDIF - - ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** - - MOLAL(1) = HI - MOLAL(2) = NAI - MOLAL(3) = NH4I - MOLAL(4) = CLI - MOLAL(5) = SO4I - MOLAL(6) = HSO4I - MOLAL(7) = NO3I - MOLAL(8) = CAI - MOLAL(9) = KI - MOLAL(10)= MGI - - ! *** CALCULATE WATER ************************************************** - - CALL CALCMR - - ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** - - IF (FRST .AND. CALAOU .OR. .NOT. FRST .AND. CALAIN) THEN - CALL CALCACT - ELSE - IF (PSCONV9 .AND. PSCONV13 .AND. PSCONV14 .AND. PSCONV5 & - .AND. PSCONV7 .AND. PSCONV8) GOTO 20 - ENDIF - 10 END DO -! c CALL PUSHERR (0002, 'CALCW2') ! WARNING ERROR: NO CONVERGENCE - -! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* - - 20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ - A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- - A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- - - GNH3 = NH4I/HI/A2 - GHNO3 = HI*NO3I/A3 - GHCL = HI*CLI /A4 - - GASAQ(1)= NH3AQ - GASAQ(2)= CLAQ - GASAQ(3)= NO3AQ - - CNH42S4 = ZERO - CNH4NO3 = ZERO - CNH4CL = CHI5 - PSI5 - CNACL = CHI7 - PSI7 - CNANO3 = CHI8 - PSI8 - CMGSO4 = ZERO - CK2SO4 = CHI9 - PSI9 - CCASO4 = MIN (WAER(6), WAER(2)) - CCANO32 = ZERO - CKNO3 = CHI13 - PSI13 - KCL = CHI14 - PSI14 - CMGNO32 = ZERO - CMGCL2 = ZERO - CCACL2 = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW2A ****************************************** - - END SUBROUTINE CALCW2A - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW1 -! *** CASE W1 - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: -! 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) -! 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCP1A) - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW1 - INCLUDE 'isrpia.inc' - EXTERNAL CALCW1A, CALCW2A - -! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** - - IF (RH < DRMP1) THEN - SCASE = 'W1 ; SUBCASE 1' - CALL CALCW1A ! SOLID PHASE ONLY POSSIBLE - SCASE = 'W1 ; SUBCASE 1' - ELSE - SCASE = 'W1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE - CALL CALCMDRPII (RH, DRMP1, DRCACL2, CALCW1A, CALCW2A) - SCASE = 'W1 ; SUBCASE 2' - ENDIF - - RETURN - -! *** END OF SUBROUTINE CALCW1 ****************************************** - - END SUBROUTINE CALCW1 - -!======================================================================= - -! *** ISORROPIA CODE II -! *** SUBROUTINE CALCW1A -! *** CASE W1A - -! THE MAIN CHARACTERISTICS OF THIS REGIME ARE: -! 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2) -! 2. SOLID AEROSOL ONLY -! 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4, -! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL - -! *** COPYRIGHT 1996-2008, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY -! *** GEORGIA INSTITUTE OF TECHNOLOGY -! *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES - -!======================================================================= - - SUBROUTINE CALCW1A - INCLUDE 'isrpia.inc' - -! *** CALCULATE SOLIDS ************************************************** - - CCASO4 = MIN (WAER(2), WAER(6)) !SOLID CASO4 - CAFR = MAX (WAER(6) - CCASO4, ZERO) - SO4FR = MAX (WAER(2) - CCASO4, ZERO) - CK2SO4 = MIN (SO4FR, 0.5D0*WAER(7)) !SOLID K2SO4 - FRK = MAX (WAER(7) - 2.D0*CK2SO4, ZERO) - SO4FR = MAX (SO4FR - CK2SO4, ZERO) - CMGSO4 = SO4FR !SOLID MGSO4 - FRMG = MAX (WAER(8) - CMGSO4, ZERO) - CNACL = MIN (WAER(1), WAER(5)) !SOLID NACL - FRNA = MAX (WAER(1) - CNACL, ZERO) - CLFR = MAX (WAER(5) - CNACL, ZERO) - CCACL2 = MIN (CAFR, 0.5D0*CLFR) !SOLID CACL2 - CAFR = MAX (CAFR - CCACL2, ZERO) - CLFR = MAX (WAER(5) - 2.D0*CCACL2, ZERO) - CCANO32 = MIN (CAFR, 0.5D0*WAER(4)) !SOLID CA(NO3)2 - CAFR = MAX (CAFR - CCANO32, ZERO) - FRNO3 = MAX (WAER(4) - 2.D0*CCANO32, ZERO) - CMGCL2 = MIN (FRMG, 0.5D0*CLFR) !SOLID MGCL2 - FRMG = MAX (FRMG - CMGCL2, ZERO) - CLFR = MAX (CLFR - 2.D0*CMGCL2, ZERO) - CMGNO32 = MIN (FRMG, 0.5D0*FRNO3) !SOLID MG(NO3)2 - FRMG = MAX (FRMG - CMGNO32, ZERO) - FRNO3 = MAX (FRNO3 - 2.D0*CMGNO32, ZERO) - CNANO3 = MIN (FRNA, FRNO3) !SOLID NANO3 - FRNA = MAX (FRNA - CNANO3, ZERO) - FRNO3 = MAX (FRNO3 - CNANO3, ZERO) - CKCL = MIN (FRK, CLFR) !SOLID KCL - FRK = MAX (FRK - CKCL, ZERO) - CLFR = MAX (CLFR - CKCL, ZERO) - CKNO3 = MIN (FRK, FRNO3) !SOLID KNO3 - FRK = MAX (FRK - CKNO3, ZERO) - FRNO3 = MAX (FRNO3 - CKNO3, ZERO) - -! *** OTHER PHASES ****************************************************** - - WATER = ZERO - - GNH3 = ZERO - GHNO3 = ZERO - GHCL = ZERO - - RETURN - -! *** END OF SUBROUTINE CALCW1A ***************************************** - - END SUBROUTINE CALCW1A diff --git a/uEMEP_ml.f90 b/uEMEP_ml.f90 new file mode 100644 index 0000000..678ed45 --- /dev/null +++ b/uEMEP_ml.f90 @@ -0,0 +1,1056 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2017 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program is distributed in the hope that it will be useful, +!* but WITHOUT ANY WARRANTY; without even the implied warranty of +!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +module uEMEP_ml +! +! all subroutines for uEMEP +! +use CheckStop_ml, only: CheckStop,StopAll +use Chemfields_ml, only: xn_adv +use ChemSpecs, only: NSPEC_ADV, NSPEC_SHL,species_adv +use Country_ml, only: MAXNLAND,NLAND,Country +use EmisDef_ml, only: loc_frac, loc_frac_1d, loc_frac_hour, loc_tot_hour, & + loc_frac_hour_inst, loc_tot_hour_inst, & + loc_frac_day, loc_tot_day, loc_frac_month& + , loc_tot_month,loc_frac_full,loc_tot_full, NSECTORS,NEMIS_FILE, & + EMIS_FILE,nlandcode,landcode,flat_nlandcode,flat_landcode,& + sec2tfac_map, sec2hfac_map ,ISNAP_DOM,snapemis,& + snapemis_flat,roaddust_emis_pot,KEMISTOP + +use EmisGet_ml, only: nrcemis, iqrc2itot, emis_nsplit,nemis_kprofile, emis_kprofile +use GridValues_ml, only: dA,dB,xm2, dhs1i, glat, glon, projection, extendarea_N +use MetFields_ml, only: ps,roa +use ModelConstants_ml,only: KMAX_MID, KMAX_BND,USES, USE_uEMEP, uEMEP, IOU_HOUR, IOU_HOUR_INST,& + IOU_INST,IOU_YEAR,IOU_MON,IOU_DAY,IOU_HOUR,IOU_HOUR_INST, & + KMAX_MID, MasterProc,dt_advec, RUNDOMAIN +use NetCDF_ml, only: Real4,Out_netCDF +use OwnDataTypes_ml, only: Deriv, Npoll_uemep_max, Nsector_uemep_max +use Par_ml, only: me,LIMAX,LJMAX,MAXLIMAX,MAXLJMAX,gi0,gj0,li0,li1,lj0,lj1,GIMAX,GJMAX +use PhysicalConstants_ml, only : GRAV, ATWAIR +use SmallUtils_ml, only: find_index +use TimeDate_ml, only: date, current_date,day_of_week +use Timefactors_ml, only: & + DegreeDayFactors & ! degree-days used for SNAP-2 + ,Gridded_SNAP2_Factors, gridfac_HDD & + ,fac_min,timefactors & ! subroutine + ,fac_ehh24x7 ,fac_emm, fac_edd, timefac ! time-factors + +!(dx,dy,i,j) shows contribution of pollutants from (i+dx,j+dy) to (i,j) + +implicit none +private + +public :: init_uEMEP +public :: out_uEMEP +public :: av_uEMEP +public :: uemep_adv_x +public :: uemep_adv_y +public :: uemep_adv_k +public :: uemep_emis + +integer, public, save :: uEMEP_Size1=0 !total size of the first 3 dimensions of loc_frac +!uEMEP_Size1=uEMEP%Nsec_poll*(2*uEMEP%dist+1)**2 +integer, public, save :: uEMEP_Sizedxdy=0 !total size of the first 3 dimensions of loc_frac +!uEMEP_Sizedxdy=(2*uEMEP%dist+1)**2 + +real, private, save ::av_fac_hour,av_fac_day,av_fac_month,av_fac_full +real, allocatable, save ::loc_poll_to(:,:,:,:,:) + +logical, public, save :: COMPUTE_LOCAL_TRANSPORT=.false. + +contains +subroutine init_uEMEP + integer :: i, ix, itot, iqrc, iem, iemis, isec, ipoll, ixnh3, ixnh4 + + uEMEP%Nsec_poll = 0 + uEMEP%Npoll = 0 + do iemis=1,Npoll_uemep_max + if(uEMEP%poll(iemis)%emis=='none')then + call CheckStop(iemis==1,"init_uEMEP: no pollutant specified") + exit + else + uEMEP%Npoll = uEMEP%Npoll + 1 + uEMEP%poll(iemis)%Nsectors = 0 + uEMEP%poll(iemis)%sec_poll_ishift=uEMEP%Nsec_poll + do isec=1,Nsector_uemep_max + if(uEMEP%poll(iemis)%sector(isec)<0)then + call CheckStop(isec==0,"init_uEMEP: nosector specified for "//uEMEP%poll(iemis)%emis) + exit + else + uEMEP%Nsec_poll = uEMEP%Nsec_poll + 1 + uEMEP%poll(iemis)%Nsectors = uEMEP%poll(iemis)%Nsectors +1 + endif + enddo + endif + enddo + +!find indices in EMIS_File + do ipoll=1,uEMEP%Npoll + do iem=1,NEMIS_FILE + if(trim(EMIS_File(iem))==trim(uEMEP%poll(ipoll)%emis))then + uEMEP%poll(ipoll)%EMIS_File_ix = iem + exit + endif + enddo + call CheckStop(iem>NEMIS_FILE,"uemep pollutant not found: "//trim(uEMEP%poll(ipoll)%emis)) + enddo + +! uEMEP%dist = 5 +! uEMEP%Nvert =7 + do i=1,4 + if(uEMEP%DOMAIN(i)<0)uEMEP%DOMAIN(i) = RUNDOMAIN(i) + enddo + + uEMEP_Sizedxdy = (2*uEMEP%dist+1)**2 + uEMEP_Size1 = uEMEP%Nsec_poll*uEMEP_Sizedxdy + + if(MasterProc)then + write(*,*)'uEMEP pollutants : ',uEMEP%Npoll + write(*,*)'total uEMEP pollutants and sectors : ',uEMEP%Nsec_poll + end if + do ipoll=1,uEMEP%Npoll + iem=find_index(uEMEP%poll(ipoll)%emis ,EMIS_FILE(1:NEMIS_FILE)) + call CheckStop( iem<1, "uEMEP did not find corresponding emission file: "//trim(uEMEP%poll(ipoll)%emis) ) + call CheckStop( iem/=uEMEP%poll(ipoll)%EMIS_File_ix, "uEMEP wrong emis file index for: "//trim(uEMEP%poll(ipoll)%emis) ) + uEMEP%poll(ipoll)%Nix=emis_nsplit(iem) + do i=1,uEMEP%poll(ipoll)%Nix + iqrc=sum(emis_nsplit(1:iem-1)) + i + itot=iqrc2itot(iqrc) + ix=itot-NSPEC_SHL + uEMEP%poll(ipoll)%ix(i)=ix + uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt + if(uEMEP%poll(ipoll)%emis=="nox ")then + ix=find_index("NO2",species_adv(:)%name) + call CheckStop(ix<0,'Index for NO2 not found') + uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt + endif + if(uEMEP%poll(ipoll)%emis=="sox ")then + ix=find_index("SO2",species_adv(:)%name) + call CheckStop(ix<0,'Index for SO2 not found') + uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt + endif + +!!$ if(uEMEP%poll(ipoll)%emis=="nox ")then +!!$ uEMEP%poll(ipoll)%Nix=0 +!!$ ixnh4=find_index("NH4_F",species_adv(:)%name) +!!$ ixnh3=find_index("NH3",species_adv(:)%name) +!!$ do ix=1,NSPEC_ADV +!!$ if(ix==ixnh4.or.ix==ixnh3)cycle!reduced nitrogen +!!$ if(species_adv(ix)%nitrogens>0)then +!!$ uEMEP%poll(ipoll)%ix(uEMEP%poll(ipoll)%Nix)=ix +!!$ uEMEP%poll(ipoll)%Nix = uEMEP%poll(ipoll)%Nix + 1 +!!$ if(species_adv(ix)%nitrogens==1)uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=46 +!!$ if(species_adv(ix)%nitrogens==2)uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=92 +!!$ endif +!!$ enddo +!!$ endif + if(uEMEP%poll(ipoll)%emis=="nh3 ")then + uEMEP%poll(ipoll)%Nix=0 + ixnh4=find_index("NH4_F",species_adv(:)%name) + ixnh3=find_index("NH3",species_adv(:)%name) + do ix=1,NSPEC_ADV + if(ix/=ixnh4.and.ix/=ixnh3)cycle!not reduced nitrogen + if(species_adv(ix)%nitrogens>0)then + uEMEP%poll(ipoll)%Nix = uEMEP%poll(ipoll)%Nix + 1 + uEMEP%poll(ipoll)%ix(uEMEP%poll(ipoll)%Nix)=ix + uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=species_adv(ixnh3)%molwt!use NH3 mw also for NH4 + endif + enddo + endif + end do + if(MasterProc)then + write(*,*)'uEMEP pollutant : ',uEMEP%poll(ipoll)%emis + write(*,*)'uEMEP number of species in '//trim(uEMEP%poll(ipoll)%emis)//' group: ',uEMEP%poll(ipoll)%Nix + write(*,"(A,30(A,F6.2))")'including:',('; '//trim(species_adv(uEMEP%poll(ipoll)%ix(i))%name)//', mw ',uEMEP%poll(ipoll)%mw(i),i=1,uEMEP%poll(ipoll)%Nix) + write(*,"(A,30I4)")'sectors:',(uEMEP%poll(ipoll)%sector(i),i=1,uEMEP%poll(ipoll)%Nsectors) + write(*,"(A,30I4)")'ix:',(uEMEP%poll(ipoll)%ix(i),i=1,uEMEP%poll(ipoll)%Nix) + end if + end do + + COMPUTE_LOCAL_TRANSPORT = uEMEP%COMPUTE_LOCAL_TRANSPORT + + av_fac_hour=0.0 + av_fac_day=0.0 + av_fac_month=0.0 + av_fac_full=0.0 + + allocate(loc_frac(uEMEP%Nsec_poll,-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID)) + loc_frac=0.0 !must be initiated to 0 so that outer frame does not contribute. + if(COMPUTE_LOCAL_TRANSPORT)then + allocate(loc_poll_to(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID)) + loc_poll_to=0.0 + endif + allocate(loc_frac_1d(uEMEP%Nsec_poll,-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,0:max(LIMAX,LJMAX)+1)) + if(uEMEP%HOUR)then + allocate(loc_frac_hour(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) + loc_frac_hour=0.0 + allocate(loc_tot_hour(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) + loc_tot_hour=0.0 + endif + if(uEMEP%HOUR_INST)then + allocate(loc_frac_hour_inst(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) + loc_frac_hour_inst=0.0 + allocate(loc_tot_hour_inst(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) + loc_tot_hour_inst=0.0 + endif + if(uEMEP%DAY)then + allocate(loc_frac_day(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) + loc_frac_day=0.0 + allocate(loc_tot_day(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) + loc_tot_day=0.0 + endif + if(uEMEP%MONTH)then + allocate(loc_frac_month(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) + loc_frac_month=0.0 + allocate(loc_tot_month(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) + loc_tot_month=0.0 + endif + if(uEMEP%YEAR)then + allocate(loc_frac_full(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) + loc_frac_full=0.0 + allocate(loc_tot_full(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) + loc_tot_full=0.0 + endif + +end subroutine init_uEMEP + + +subroutine out_uEMEP(iotyp) + integer, intent(in) :: iotyp + character(len=200) ::filename, varname + real :: xtot,scale,invtot + integer ::i,j,k,dx,dy,ix,iix,isec,iisec,isec_poll,ipoll,isec_poll1 + integer ::ndim,kmax,CDFtype,dimSizes(10),chunksizes(10) + integer ::ndim_tot,dimSizes_tot(10),chunksizes_tot(10) + character (len=20) ::dimNames(10),dimNames_tot(10) + type(Deriv) :: def1 ! definition of fields + type(Deriv) :: def2 ! definition of fields + logical ::overwrite + logical,save :: first_call(10)=.true. + real ::tmp_ext(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,1-uEMEP%dist:LIMAX+uEMEP%dist,1-uEMEP%dist:LJMAX+uEMEP%dist,KMAX_MID-uEMEP%Nvert+1:KMAX_MID) + + if(iotyp==IOU_HOUR_INST .and. uEMEP%HOUR_INST)then + fileName='uEMEP_hour_inst.nc' + else if(iotyp==IOU_HOUR .and. uEMEP%HOUR)then + fileName='uEMEP_hour.nc' + else if(iotyp==IOU_DAY .and. uEMEP%DAY)then + fileName='uEMEP_day.nc' + else if(iotyp==IOU_MON .and. uEMEP%MONTH)then + fileName='uEMEP_month.nc' + else if(iotyp==IOU_YEAR .and. uEMEP%YEAR)then + fileName='uEMEP_full.nc' + else + return + endif + ndim=5 + ndim_tot=3 + kmax=uEMEP%Nvert + scale=1.0 + CDFtype=Real4 + ! dimSizes(1)=uEMEP%Nsec_poll + ! dimNames(1)='sector' + dimSizes(1)=2*uEMEP%dist+1 + dimNames(1)='x_dist' + dimSizes(2)=2*uEMEP%dist+1 + dimNames(2)='y_dist' + dimSizes(3)=LIMAX + dimSizes(4)=LJMAX + + dimSizes_tot(1)=LIMAX + dimSizes_tot(2)=LJMAX + + select case(projection) + case('Stereographic') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case('lon lat') + dimNames(3)='lon' + dimNames(4)='lat' + dimNames_tot(1)='lon' + dimNames_tot(2)='lat' + case('Rotated_Spherical') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case('lambert') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case default + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + end select + + dimSizes(5)=kmax + dimNames(5)='klevel' + dimSizes_tot(3)=kmax + dimNames_tot(3)='klevel' + def1%class='uEMEP' !written + def1%avg=.false. !not used + def1%index=0 !not used + def1%scale=1.0 !not used + def1%name=trim(varName) + def1%unit='' + def2=def1 + def2%unit='ug/m3' + chunksizes=1 + chunksizes(3)=dimSizes(3) + chunksizes(4)=dimSizes(4) + chunksizes(5)=dimSizes(5) + chunksizes_tot=1 + chunksizes_tot(1)=dimSizes_tot(1) + chunksizes_tot(2)=dimSizes_tot(2) + chunksizes_tot(3)=dimSizes_tot(3) + + isec_poll1=1 + overwrite=.true.!only first time + do ipoll=1,uEMEP%Npoll + def2%name=trim(uEMEP%poll(ipoll)%emis) + if(first_call(iotyp))then + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec=uEMEP%poll(ipoll)%sector(iisec) + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_full,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=.true.,chunksizes=chunksizes) + overwrite=.false. + if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then + write(def2%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' + if(isec==0)write(def2%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' + if(me==0)write(*,*)'making '//def2%name + call Out_netCDF(iotyp,def2,ndim,kmax,loc_frac_full,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.true.,chunksizes=chunksizes) + endif + enddo + + def2%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_full,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.true.,chunksizes=chunksizes_tot) + + endif + + if(iotyp==IOU_HOUR_INST)then + !compute instantaneous values + !need to transpose loc_frac. Could be avoided? + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=isec_poll1+iisec-1 + isec=uEMEP%poll(ipoll)%sector(iisec) + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + xtot=0.0 + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))/ATWAIR& + *roa(i,j,k,1)*1.E9 !for ug/m3 + ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 + end do + loc_tot_hour_inst(i,j,k,ipoll)=xtot + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + loc_frac_hour_inst(dx,dy,i,j,k,isec_poll)=loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + enddo + enddo + scale=1.0 + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_hour_inst(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + + if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then + call extendarea_N(loc_frac_hour_inst(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEP%Nvert) + + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + ! do k = KMAX_MID,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(1.E-20+loc_tot_hour_inst(i,j,k,ipoll))!tmp_ext are fractions -> convert to pollutant + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) + loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k)*invtot + enddo + enddo + enddo + enddo + enddo + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' + scale=1.0 + call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + endif + enddo + + scale=1.0 + def1%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def1,ndim_tot,kmax,loc_tot_hour_inst(1,1,KMAX_MID-uEMEP%Nvert+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + else if(iotyp==IOU_HOUR )then + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=isec_poll1+iisec-1 + isec=uEMEP%poll(ipoll)%sector(iisec) + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(loc_tot_hour(i,j,k,ipoll)+1.E-20) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + loc_frac_hour(dx,dy,i,j,k,isec_poll)=loc_frac_hour(dx,dy,i,j,k,isec_poll)*invtot + enddo + enddo + enddo + enddo + enddo + scale=1.0 + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_hour(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + enddo + ! loc_tot_hour=loc_tot_hour/av_fac_hour + scale=1.0/av_fac_hour + def1%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def1,ndim_tot,kmax,loc_tot_hour(1,1,KMAX_MID-uEMEP%Nvert+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + else if(iotyp==IOU_DAY)then + + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=isec_poll1+iisec-1 + isec=uEMEP%poll(ipoll)%sector(iisec) + !copy before dividing by loc_tot + if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_day(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEP%Nvert) + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(loc_tot_day(i,j,k,ipoll)+1.E-20) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + loc_frac_day(dx,dy,i,j,k,isec_poll)=loc_frac_day(dx,dy,i,j,k,isec_poll)*invtot + enddo + enddo + enddo + enddo + enddo + scale=1.0 + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_day(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) + loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) + enddo + enddo + enddo + enddo + enddo + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' + scale=1.0/av_fac_day + call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + endif + enddo + + scale=1.0/av_fac_day + def2%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_day(1,1,KMAX_MID-uEMEP%Nvert+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + + else if(iotyp==IOU_MON)then + + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=isec_poll1+iisec-1 + isec=uEMEP%poll(ipoll)%sector(iisec) + !copy before dividing by loc_tot + if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_month(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEP%Nvert) + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(loc_tot_month(i,j,k,ipoll)+1.E-20) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + loc_frac_month(dx,dy,i,j,k,isec_poll)=loc_frac_month(dx,dy,i,j,k,isec_poll)*invtot + enddo + enddo + enddo + enddo + enddo + scale=1.0 + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_month(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) + loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) + enddo + enddo + enddo + enddo + enddo + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' + scale=1.0/av_fac_month + call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + endif + enddo + + scale=1.0/av_fac_month + def2%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_month(1,1,KMAX_MID-uEMEP%Nvert+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + + else if(iotyp==IOU_YEAR)then + + do iisec=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=isec_poll1+iisec-1 + isec=uEMEP%poll(ipoll)%sector(iisec) + !copy before dividing by loc_tot_full + + if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_full(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEP%Nvert) + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(loc_tot_full(i,j,k,ipoll)+1.E-20) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + loc_frac_full(dx,dy,i,j,k,isec_poll)=loc_frac_full(dx,dy,i,j,k,isec_poll)*invtot + enddo + enddo + enddo + enddo + enddo + + scale=1.0 + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' + call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_full(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEP%Nvert+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + + if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + ! do k = KMAX_MID,KMAX_MID + do j=1,ljmax + do i=1,limax + !invtot=1.0/(1.E-20+loc_tot_full(i,j,k)) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) + loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) + enddo + enddo + enddo + enddo + enddo + write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' + if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' + scale=1.0/av_fac_full + call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + endif + enddo + + scale=1.0/av_fac_full + def1%name=trim(uEMEP%poll(ipoll)%emis) + call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_full(1,1,KMAX_MID-uEMEP%Nvert+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& + fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) + else + if(me==0)write(*,*)'IOU not recognized' + endif + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + enddo + + !reset the cumulative counters + if(iotyp==IOU_HOUR)then + av_fac_hour=0 + loc_frac_hour=0.0 + loc_tot_hour=0.0 + else if(iotyp==IOU_DAY)then + av_fac_day=0.0 + loc_frac_day=0.0 + loc_tot_day=0.0 + else if(iotyp==IOU_MON)then + av_fac_month=0.0 + loc_frac_month=0.0 + loc_tot_month=0.0 + else if(iotyp==IOU_YEAR)then + av_fac_full=0.0 + loc_frac_full=0.0 + loc_tot_full=0.0 + endif + + first_call(iotyp)=.false. + +end subroutine out_uEMEP + +subroutine av_uEMEP(dt,End_of_Day) + real, intent(in) :: dt ! time-step used in integrations + logical, intent(in) :: End_of_Day ! e.g. 6am for EMEP sites + real :: xtot + integer ::i,j,k,dx,dy,ix,iix,ipoll,isec_poll1 + integer ::isec_poll + + if(.not. uEMEP%HOUR.and.& + .not. uEMEP%DAY .and.& + .not. uEMEP%MONTH .and.& + .not. uEMEP%YEAR )return + + !do the averaging + do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID + do j=1,ljmax + do i=1,limax + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + xtot=0.0 + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))/ATWAIR& + *roa(i,j,k,1)*1.E9 !for ug/m3 + ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 + end do + if(uEMEP%HOUR)then + loc_tot_hour(i,j,k,ipoll)=loc_tot_hour(i,j,k,ipoll)+xtot + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac_hour(dx,dy,i,j,k,isec_poll)=loc_frac_hour(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + endif + if(uEMEP%DAY)then + loc_tot_day(i,j,k,ipoll)=loc_tot_day(i,j,k,ipoll)+xtot + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac_day(dx,dy,i,j,k,isec_poll)=loc_frac_day(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + endif + if(uEMEP%MONTH)then + loc_tot_month(i,j,k,ipoll)=loc_tot_month(i,j,k,ipoll)+xtot + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac_month(dx,dy,i,j,k,isec_poll)=loc_frac_month(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + endif + if(uEMEP%YEAR)then + loc_tot_full(i,j,k,ipoll)=loc_tot_full(i,j,k,ipoll)+xtot + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac_full(dx,dy,i,j,k,isec_poll)=loc_frac_full(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) + enddo + enddo + enddo + endif + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + enddo + enddo + enddo + enddo + av_fac_hour=av_fac_hour+1.0 + av_fac_day=av_fac_day+1.0 + av_fac_month=av_fac_month+1.0 + av_fac_full=av_fac_full+1.0 + +end subroutine av_uEMEP + + subroutine uemep_adv_y(fluxy,i,j,k) + real, intent(in)::fluxy(NSPEC_ADV,-1:LJMAX+1) + integer, intent(in)::i,j,k + real ::x,xn,xx,f_in,inv_tot + integer ::iix,ix,dx,dy,ipoll,isec_poll,isec_poll1 + + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + xn=0.0 + x=0.0 + xx=0.0 + !positive x or xx means incoming, negative means outgoing + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + xn=xn+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) + x=x-xm2(i,j)*fluxy(ix,j)*uEMEP%poll(ipoll)%mw(iix)!flux through "North" face (Up) + xx=xx+xm2(i,j)*fluxy(ix,j-1)*uEMEP%poll(ipoll)%mw(iix)!flux through "South" face (Bottom) + end do + !NB: here xn already includes the fluxes. Remove them! + xn=xn-xx-x + + xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. all outgoing flux + f_in=max(0.0,x)+max(0.0,xx)!positive part. all incoming flux + inv_tot=1.0/(xn+f_in+1.e-20)!incoming dilutes + + xx=max(0.0,xx)*inv_tot!factor due to flux through "South" face (Bottom) + x =max(0.0,x)*inv_tot!factor due to flux through "North" face (Up) + + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k) *xn *inv_tot + enddo + if(x>0.0.and.dy>-uEMEP%dist)then + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)+ loc_frac_1d(isec_poll,dx,dy-1,j+1)*x + enddo + endif + if(xx>0.0.and.dy0.0.and.dx>-uEMEP%dist)then + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)+ loc_frac_1d(isec_poll,dx-1,dy,i+1)*x + enddo + endif + if(xx>0.0.and.dx can use k+1 to access non-updated value + + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + + xn=0.0 + x=0.0 + xx=0.0 + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + xn=xn+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) + if(kKMAX_MID-uEMEP%Nvert+1)then + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k) * xn * inv_tot & + + loc_frac_km1(isec_poll,dx,dy,k-1) * xx& + + loc_frac(isec_poll,dx,dy,i,j,k+1) * x!k is increasing-> can use k+1 to access non-updated value + enddo + enddo + enddo + else + !k=KMAX_MID-uEMEP%Nvert+1 , assume no local fractions from above + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)* xn * inv_tot & + + loc_frac(isec_poll,dx,dy,i,j,k+1) * x!k is increasing-> can use k+1 to access non-updated value + enddo + enddo + enddo + endif + else + !k=KMAX_MID , no local fractions from below + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)* xn * inv_tot & + + loc_frac_km1(isec_poll,dx,dy,k-1) * xx + enddo + enddo + enddo + endif + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + enddo + + end do + end subroutine uemep_adv_k + + +subroutine uEMEP_emis(indate) +!include emission contributions to local fractions + +!NB: should replace most of the stuff and use gridrcemis instead! + + implicit none + type(date), intent(in) :: indate ! Gives year..seconds + integer :: i, j, k ! coordinates, loop variables + integer :: icc, ncc ! No. of countries in grid. + integer :: ficc,fncc ! No. of countries with + integer :: iqrc ! emis indices + integer :: isec ! loop variables: emission sectors + integer :: iem ! loop variable over 1..NEMIS_FILE + + ! Save daytime value between calls, initialise to zero + integer, save, dimension(MAXNLAND) :: daytime(1:MAXNLAND) = 0 ! 0=night, 1=day + integer, save, dimension(MAXNLAND) :: localhour(1:MAXNLAND) = 1 ! 1-24 local hour in the different countries + integer :: hourloc ! local hour + real, dimension(NRCEMIS) :: tmpemis ! local array for emissions + real :: tfac ! time-factor (tmp variable); dt*h*h for scaling + real :: s ! source term (emis) before splitting + integer :: iland, iland_timefac ! country codes, and codes for timefac + integer :: daytime_longitude, daytime_iland, hour_longitude, hour_iland + integer ::icc_uemep + integer, save :: wday , wday_loc ! wday = day of the week 1-7 + integer ::ix,iix, dx, dy, isec_poll, iisec_poll, isec_poll1, ipoll + real::dt_uemep, xtot, emis_uemep(KMAX_MID,NEMIS_FILE,NSECTORS),emis_tot(KMAX_MID,NEMIS_FILE) + + dt_uemep=dt_advec + + wday=day_of_week(indate%year,indate%month,indate%day) + if(wday==0)wday=7 ! Sunday -> 7 + do iland = 1, NLAND + daytime(iland) = 0 + hourloc = indate%hour + Country(iland)%timezone + localhour(iland) = hourloc ! here from 0 to 23 + if(hourloc>=7 .and. hourloc<=18) daytime(iland)=1 + end do ! iland + + do j = lj0,lj1 + do i = li0,li1 + ncc = nlandcode(i,j) ! No. of countries in grid + fncc = flat_nlandcode(i,j) ! No. of countries with flat emissions in grid + hourloc= mod(nint(indate%hour+24*(1+glon(i,j)/360.0)),24) + hour_longitude=hourloc + daytime_longitude=0 + if(hourloc>=7 .and. hourloc<= 18) daytime_longitude=1 + !************************************************* + ! First loop over non-flat (one sector) emissions + !************************************************* + tmpemis(:)=0. + icc_uemep=0 + emis_uemep=0.0 + emis_tot=0.0 + do icc = 1, ncc+fncc + ficc=icc-ncc + ! iland = landcode(i,j,icc) ! 1=Albania, etc. + if(icc<=ncc)then + iland=find_index(landcode(i,j,icc),Country(:)%icode) !array index + else + iland=find_index(flat_landcode(i,j,ficc),Country(:)%icode) + end if + !array index of country that should be used as reference for timefactor + iland_timefac = find_index(Country(iland)%timefac_index,Country(:)%timefac_index) + + if(Country(iland)%timezone==-100)then + daytime_iland=daytime_longitude + hour_iland=hour_longitude + 1 ! add 1 to get 1..24 + else + daytime_iland=daytime(iland) + hour_iland=localhour(iland) + 1 + end if + !if( hour_iland > 24 ) hour_iland = 1 !DSA12 + wday_loc=wday + if(hour_iland>24) then + hour_iland = hour_iland - 24 + wday_loc=wday + 1 + if(wday_loc==0)wday_loc=7 ! Sunday -> 7 + if(wday_loc>7 )wday_loc=1 + end if + + do iem = 1, NEMIS_FILE + do isec = 1, Nsectors ! Loop over snap codes + ! Calculate emission rates from snapemis, time-factors, + ! and if appropriate any speciation fraction (NEMIS_FRAC) + iqrc = 0 ! index over emisfrac + ! kg/m2/s + + if(icc<=ncc)then + tfac = timefac(iland_timefac,sec2tfac_map(isec),iem) & + * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc) + + !Degree days - only SNAP-2 + if(USES%DEGREEDAY_FACTORS .and. & + sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors) then + ! If INERIS_SNAP2 set, the fac_min will be zero, otherwise + ! we make use of a baseload even for SNAP2 + tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload + + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & + * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc) + end if ! =============== HDD + + s = tfac * snapemis(isec,i,j,icc,iem) + else + s = snapemis_flat(i,j,ficc,iem) + end if + + do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID + emis_tot(k,iem)=emis_tot(k,iem)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep + end do + + !if(isec==uEMEP%sector .or. uEMEP%sector==0)then + do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID + emis_uemep(k,iem,isec)=emis_uemep(k,iem,isec)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep + end do + !end if + + end do ! iem + + end do ! isec + ! ================================================== + end do ! icc + + + isec_poll1=1 + do ipoll=1,uEMEP%Npoll + iem = uEMEP%poll(ipoll)%EMIS_File_ix + + do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID + if(emis_tot(k,iem)<1.E-20)cycle + !units kg/m2 + !total pollutant + xtot=0.0 + do iix=1,uEMEP%poll(ipoll)%Nix + ix=uEMEP%poll(ipoll)%ix(iix) + xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))*(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV + end do + dx=0 ; dy=0!local fraction from this i,j + do iisec_poll=1,uEMEP%poll(ipoll)%Nsectors + isec_poll=iisec_poll+isec_poll1-1 + isec = uEMEP%poll(ipoll)%sector(iisec_poll) + if(isec==0)then + !sum of all sectors + loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot+emis_tot(k,iem))/(xtot+emis_tot(k,iem)+1.e-20) + else + loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot+emis_uemep(k,iem,isec))/(xtot+emis_tot(k,iem)+1.e-20) + endif + enddo + + !local fractions from other cells are updated (reduced) + do dy=-uEMEP%dist,uEMEP%dist + do dx=-uEMEP%dist,uEMEP%dist + if(dx==0 .and. dy==0)cycle!local fractions from other cells only + do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 + loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot)/(xtot+emis_tot(k,iem)+1.e-20) + enddo + enddo + enddo + + end do! k + isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors + enddo!Npoll + end do ! i + end do ! j + + +end subroutine uEMEP_emis +end module uEMEP_ml