pro constit13, file=file, iout ; this procedure reads in the f33 file from base9hb runs ; ; reader for the COMBINED Fixed/Coupled models ; common share9, c, m, w, v, kyy, kyz, kzz, lat, late, zz, p2d, zzx, zzxe, imm, L$, Z$, cgl, cl0, cl1, cly cl0 = [.001, .01, .03, .1, .2, .3, .5, 1, 2, 5, 7, 10, 30, 100, 300, 1000] cl1 = findgen(800)-400. ;; cly = [2, 5, 10, 20, 50, 100, 200, 400, 600, 800, 1000] ;; cly = [2, 5, 10, 20+indgen(50)*20] cly = [4, 10, indgen(5)*20+20, indgen(18)*50+150] ; nex is the number of extra "species", ie, temp, ubar, drag ; nread is the number of species written out (CNOUT array) nex = 11 nspec = 90 + nex nread = 98 close,1 openr, 1, file, /f77_unformatted, /swap_if_big_endian L$=long(0) & Z$=long(0) FORRD, 1, L$, Z$, yrst ;print,' L$=',L$,' Z$=',Z$,' yrst=',yrst LAT=fltarr(L$) & LATE=fltarr(L$+1) & ZZ=fltarr(Z$) & P2D=fltarr(Z$) ZZX=fltarr(Z$+12) & ZZXE=fltarr(Z$+12+1) FORRD, 1, lat, late, zz, p2d, zzx, zzxe ;print,' lat=',lat,' late=',late,' zz=',zz,' p2d=',p2d,' zzx=',zzx,' zzxe=',zzxe for i=0,iout-1 do begin if (i eq 0) then begin c = fltarr(iout,nspec,L$,Z$) w = fltarr(iout,L$,Z$+12+1) v = fltarr(iout,L$+1,Z$+12) kyy = fltarr(iout,L$+1,Z$+12) kyz = fltarr(iout,L$+1,Z$+12+1) kzz = fltarr(iout,L$,Z$+12+1) endif u=fltarr(nread,L$,Z$) ;print,' i=',i FORRD, 1, u ;print,' u1=',u(0,20,30) ;; load in Ray Fric and fixed model DELF in next-to-last 2 entries c(i,0:nread-1,*,*) = u(*,*,*) c(i,nspec-3,*,*) = u(32-1,*,*) c(i,nspec-2,*,*) = u(58-1,*,*) wr = dblarr(L$,Z$+12+1) FORRD, 1, wr w(i,*,*) = wr(*,*) ; convert v* to m/sec vr = dblarr(L$+1,Z$+12) FORRD, 1, vr v(i,*,*) = vr(*,*)/100. kyyr = fltarr(L$+1,Z$+12) FORRD, 1, kyyr kyy(i,*,*) = kyyr(*,*)/1.e8 kyzr = fltarr(L$+1,Z$+12+1) FORRD, 1, kyzr kyz(i,*,*) = kyzr(*,*)/1.e6 kzzr = fltarr(L$,Z$+12+1) FORRD, 1, kzzr kzz(i,*,*) = kzzr(*,*)/1.e4 endfor close,1 print,'after forrd' print,'after read pa' m=c(*,2,*,*)/0.21 for j1=0,nspec-1-nex do c(*,j1,*,*) = c(*,j1,*,*)/m(*,0,*,*) ; convert rainout cn(59) to days for zz(0:15) ONLY - cn(58) is now BrOx in model ; latent heating is in cn(59,*,20:45), load into c(i,nspec-1,*,*) ; c(*,59-1,*,*) = c(*,59-1,*,*)*m(*,0,*,*) c(*,nspec-1,*,0:25) = c(*,59-1,*,20:45) ; ;; set minimum rainout time scale to ~11000 days rx = c(*,59-1,*,0:14) iss = where(rx le 1.e-9) & if (total(iss) ne -1) then rx(iss) = 1.e-9 c(*,59-1,*,0:14) = rx(*,0,*,*) c(*,59-1,*,0:14) = 1./(c(*,59-1,*,0:14)*86400.) c(*,59-1,*,15:*) = 999999. ; get DU/km using o3 mix ratio, since cn(4) changes after COLDEN c(*,79,*,*) = c(*,4-1,*,*)*m(*,0,*,*)*1.e5/2.69E16 ;;;; c(*,79,*,*) = c(*,79,*,*)*m(*,0,*,*)/2.69E16 ; load NOx (N + NO + NO2 + NO3 + 2*N2O5) into c(32) c(*,32-1,*,*) = c(*,9-1,*,*) + c(*,5-1,*,*) + c(*,6-1,*,*) + c(*,7-1,*,*) + 2.*c(*,8-1,*,*) ; load ClOx (Cl + ClO + ClO3 + OClO + ClOO + 2*Cl2 + 2*Cl2O2) into c(21) c(*,21-1,*,*) = c(*,27-1,*,*) + c(*,28-1,*,*) + c(*,26-1,*,*) + c(*,62-1,*,*) + c(*,65-1,*,*) $ + 2.*c(*,61-1,*,*) + 2.*c(*,64-1,*,*) ; load BrOx (Br + BrO + 2*Br2 + BrCl) into c(58) c(*,58-1,*,*) = c(*,45-1,*,*) + c(*,44-1,*,*) + 2.*c(*,43-1,*,*) + c(*,60-1,*,*) ; define time index using YRST (IYR) from model imm = [0., findgen(iout-1)/12. + 15./360.] + yrst + 1935. ; compute age from simple linear time increasing mixing ratio, species 77, then reload ; compute from tropical tropopause; c = fltarr(iout,nspec,L$,Z$) ; ; first define tropical tropopause - dependent on grid - ctt(iout) if (L$ eq 45 and Z$ eq 76) then ctt = (c(*,77,22,15) + c(*,77,22,16))/2. if (L$ eq 18 and Z$ eq 46) then ctt = (c(*,77,8,7) + c(*,77,8,8) + c(*,77,9,7) + c(*,77,9,8))/4. aage = fltarr(iout,L$,Z$) for ii=0,iout-1 do aage(ii,*,*) = reform( ctt(ii) - c(ii,77,*,*) ) for ii=0,iout-1 do c(ii,77,*,*) = aage(ii,*,*) ;ageg = fltarr(720,18,58) & for im=0,719 do ageg(im,*,*) = c(im,4,9,0) - c(im,4,*,*) ;agetr = (ageg(*,8,7) + ageg(*,8,8) + ageg(*,9,7) + ageg(*,9,8))/4. ;age = fltarr(720,18,58) & for im=0,719 do age(im,*,*) = ageg(im,*,*) - agetr(im) ; compute global avg; c(iout,nspec,L$,Z$); cgl is in share9 cgl = fltarr(iout,nspec,Z$) & cosl = cos(lat/!radeg) for ij=0,L$-1 do cgl(*,*,*) = cgl(*,*,*) + c(*,*,ij,*)*cosl(ij)/total(cosl) ; smooth UBAR, TBAR, convert to equidistant vertical grid, reset sfc to original ;zzeq = findgen(92)+.5 ;for is=81-1,82-1 do for ii=0,iout-1 do begin ; xx = reform(c(ii,is,*,*)) ; xxe = INTERPOL_2d(xx(*,*), zz, zzeq) ; xxe, xxs(45,92) ; xxs = smooth5_nobc(xxe) ; c(ii,is,*,*) = INTERPOL_2d(xxs(*,*), zzeq, zz) ;endfor ; currently, Rayl fric contribution is not written out, so load in correctly here, ; convert to m/sec/day; this is the coupled model rayleigh friction profile, ; interpolate to current vertical grid, convert to 1/day;; c(iout,nspec,L$,Z$), ralp(76) ; DON'T need this now ;;rfric zzp = findgen(47)*2.03+1.015 ;;rfric ralpc= -[1.4507218e-07, 1.4511708e-07, 1.4541634e-07, 1.4653936e-07, 1.4929081e-07, $ ;;rfric 1.5422066e-07, 1.6126423e-07, 1.6995774e-07, 1.7995194e-07, 1.9123830e-07, $ ;;rfric 2.0403516e-07, 2.1866744e-07, 2.3556053e-07, 2.5528237e-07, 2.7860827e-07, $ ;;rfric 3.0662548e-07, 3.4090769e-07, 3.8382058e-07, 4.3909290e-07, 5.1296246e-07, $ ;;rfric 6.1653333e-07, 7.6977665e-07, 1.0041176e-06, 1.3479928e-06, 1.7662973e-06, $ ;;rfric 2.1118465e-06, 2.2759798e-06, 2.3168111e-06, 2.3211549e-06, 2.3211549e-06, $ ;;rfric 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, $ ;;rfric 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, $ ;;rfric 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211549e-06, 2.3211551e-06, $ ;;rfric 2.3211551e-06, 2.3211551E-06]*86400. ;;rfric ;;rfric ralp = INTERPOL(ralpc, zzp, zz) ;;rfric for i=0,iout-1 do for ik=0,Z$-1 do c(i,nspec-1,*,ik) = c(i,82-1,*,ik)*ralp(ik) end