! module mk_utlon use hist,only: history implicit none ! ! Make ut vs longitude contours at selected vertical and latitude. ! Selected vertical can be zp or height. ! type utlon_type integer,pointer :: mtimes(:,:)=>NULL() ! model times (ut on x-axis) real,pointer :: + xx(:)=>NULL(),yy(:)=>NULL(), ! x and y coords (x is ut, y is longitude) + xslt(:)=>NULL(), ! local times corresponding to ut's + data(:,:)=>NULL() ! data(nx,ny) to be contoured integer :: nx,ny ! number of x and y coordinates real :: zpht,glat ! vert and lat of current data character(len=5) :: vtype ! 'zp', 'ht', 'indep', or 'integ' character(len=8) :: sname ! field short name character(len=16) :: funits ! field units character(len=16) :: ftype ! field type character(len=40) :: xlab,ylab ! x and y axis labels character(len=56) :: fname ! full field name integer :: log10 ! if > 0, then log10 of field is plotted character(len=80) :: + tlabs(3),blabs(3), ! top and bottom labels + hvol0,hvol1, ! 1st and last hist vols + hvol0_cntr,hvol1_cntr ! 1st and last hist vols (control) character(len=8) :: difftype ! raw or percent logical :: known ! true if field is known to the processor end type utlon_type real :: tlabchsz(3) = (/.02,.02,.02/), + blabchsz(3) = (/.018,.018,.018/) ! ! utlon is utlon_type to be plotted type(utlon_type),save :: utlon ! ! utlondat(ntimes,nlon,nzphtlat,nf) is data from which utlon is set up. ! utlondat(itime,:,:,:) is defined each time sub mkutlon is called. ! The last time mkutlon is called (itime==ntimes), utlon is defined ! from utlondat, and contours are made. ! real,allocatable :: utlondat(:,:,:,:) contains !------------------------------------------------------------------- subroutine mkutlon(f,fcntr,nf,h,hcntr,itime) ! ! Set up ut on x-axis, longitude on y-axis, at selected zpht,lat. ! (contouring is done by pltutlon, in this module) ! This routine is called at every model time (index itime), and the ! data is saved in utlondat(itime,:,:,:). ! Contours are made (from utlondat) only if the current call is for the ! last time (itime==ntimes) ! use proc use fields,only: field,nohalt,oh_alt use input use plt ! ! Args: integer,intent(in) :: nf,itime type(field),intent(in) :: f(nf),fcntr(nf) type(history),intent(in) :: h,hcntr ! ! Locals: integer :: izphtlat,nfld,ifld,ixf,nfemis, + i,j,k,n,ier,l,ixlat,izp,logint,iadvfr,isltax integer,save :: ixz,nzphtlat,nzphtlat_nointeg,nsel_lat real :: slt,dum,fmin,fmax,vp(4),boff,flon1(nlon),flon2(nlon) real,allocatable :: flat(:,:),zlat(:,:) real,allocatable :: flat_cntr(:,:),zlat_cntr(:,:) real :: vputlon(4) = (/.15,.90,.30,.90/), donelats(10) real :: toffset=.06, boffset=.35 real :: utlon_tmp character(len=80) :: msgout logical :: isemis,nextnewlat ! ! Externals: real,external :: fslt,fmean,quadrat integer,external :: ixfind,ixfindc,nunique_r logical,external :: isslt ! if (itime==ntimes) then if (.not.diffs) then write(6,"(/'Ut vs longitude contours at selected zpht/lat:')") else write(6,"(/'DIFFERENCE FIELDS: Ut vs longitude contours at ', + 'selected zpht/lat.')") endif if (multiadvfr > 0) nppf = 0 ! utlon%hvol1 = h%mssvol ! if (diffs) utlon%hvol1_cntr = hcntr%mssvol utlon%hvol1 = h%histfile if (diffs) utlon%hvol1_cntr = hcntr%histfile endif ! ! Allocate utlondat if this is first call: ! Get number of valid zpht/lats and number of unique selected lats: if (itime==1) then nzphtlat = 0 ! total number of slices for dimensioning utlondat do i=1,mxslice if (utlon_zphtlat(1,i)/=spval.and.utlon_zphtlat(2,i)/=spval) | nzphtlat = nzphtlat+1 enddo nsel_lat = nunique_r(utlon_zphtlat(2,:),mxslice,spval) ! ! Add zphtlat slots for vertical integrations: ! (emission fields are integrated in height, once per selected latitude) nfemis = 0 ! number of requested emission fields do ixf=1,nf if (f(ixf)%requested.and.associated(f(ixf)%data).and. + (trim(f(ixf)%type)=='EMISSION'.or. + trim(f(ixf)%type)=='OH-BAND')) nfemis = nfemis+1 enddo nzphtlat_nointeg = nzphtlat nzphtlat = nzphtlat+nsel_lat*nfemis if (nzphtlat==0) then write(6,"('>>> mkutlon: need selected zp/ht and lats', + ' (utlon_zphtlat). Turning off ipltutlon.')") ipltutlon = 0 return endif ! ! Get number of fields (also increment nzphtlat for integrations): nfld = 0 ! number of fields to allocate do ixf=1,nf if (f(ixf)%requested.and.associated(f(ixf)%data)) then nfld = nfld+1 endif enddo if (nfld==0) then write(6,"('>>> mkutlon: need fields: nfld==0.', + ' Turning ipltutlon off.')") ipltutlon = 0 return endif ! ! Do the allocation: allocate(utlondat(ntimes,nlon,nzphtlat,nfld),stat=ier) if (ier /= 0) then write(6,"('mkutlon error allocating', + ' utlondat(ntimes,nlon,nzphtlat,nfld): ntimes=', + i4,' nlon=',i3,' nzphtlat=',i3,' nfld=',i3)") + ntimes,nlon,nzphtlat,nfld call allocerr(ier,"mkutlon allocating utlondat") else write(6,"('mkutlon: allocated utlondat(ntimes,nlon,', + 'nzphtlat,nfld), where:',/,' ntimes=',i4,' nlon=',i2, + ' nzphtlat=',i2,' nfld=',i2)") ntimes,nlon,nzphtlat, + nfld endif ! ! Locate index to heights field (needed for interp, etc): ! (if diffs, pert hts were saved at ixz and control hts at ixzcntr) ! (note locals ixz and ixzcntr are saved across all calls) ixz = ixfindc(f%fname8,nf,'Z ') if (ixz <= 0) then write(6,"('>>> mkutlon: need heights in fields: field ', + 'names = ',(8a8))") f%fname8 stop 'mkutlon z' endif ! ! Set up utlon x-axis (utlon%xx(itime) and utlon%mtimes(:,itime) are ! defined at each call below): utlon%nx = ntimes allocate(utlon%xx(utlon%nx),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating utlon%xx") utlon%xlab = 'UT (HRS)' allocate(utlon%mtimes(3,ntimes),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating utlon%mtimes") ! utlon%hvol0 = h%mssvol ! if (diffs) utlon%hvol0_cntr = hcntr%mssvol utlon%hvol0 = h%histfile if (diffs) utlon%hvol0_cntr = hcntr%histfile endif ! itime==1 ! ! Set up utlon y-axis if last time: if (itime==ntimes) then utlon%ny = nlon utlon%ylab = 'LONGITUDE (DEG)' allocate(utlon%yy(utlon%ny),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating utlon%yy") utlon%yy = gcmlon endif ! ! Define current time in utlon: utlon%xx(itime) = float(h%mtime(1))*24.+h%ut utlon%mtimes(:,itime) = h%mtime ! use pert for now ! ! Field loop: ifld = 0 fields_loop: do ixf=1,nf if (.not.f(ixf)%requested.or..not.associated(f(ixf)%data)) + cycle fields_loop ifld = ifld+1 ! field index to utlondat(:,:,:,ifld) isemis = .false. if (trim(f(ixf)%type)=='EMISSION'.or. + trim(f(ixf)%type)=='OH-BAND') isemis = .true. ! ! If this is last time, define parts of utlon and prepare for contouring: if (itime==ntimes) then ! if (.not.diffs) then ! utlon%fname = f(ixf)%fname56 ! else ! field difftype is "RAW" or "PERCENT" ! utlon%fname = trim(f(ixf)%difftype)//' DIFFS: '// ! + f(ixf)%fname56 ! endif utlon%fname = f(ixf)%fname56 utlon%sname = f(ixf)%fname8 utlon%funits = f(ixf)%units utlon%ftype = f(ixf)%type utlon%difftype = f(ixf)%difftype utlon%known = f(ixf)%known ! ! Set field min, max, and interval to be used in contouring: ! (default f(i)%cmin,cmax,cint is 0.,0.,0., but may be provided ! by user via namelist input fmnmxint) ! (pltmin,pltmax,conint are in plt.f) pltmin = f(ixf)%cmin pltmax = f(ixf)%cmax conint = f(ixf)%cint scfac = f(ixf)%scalefac endif ! itime==ntimes in fields loop ! ! Selected zphtlat loop: izphtlat = 0 ! loc index to utlondat(:,:,izphtlat,:) donelats = spval ! array op zphtlat_loop: do l=1,mxslice if (utlon_zphtlat(1,l)==spval.or.utlon_zphtlat(2,l)==spval) + cycle zphtlat_loop izphtlat = izphtlat+1 ! ! Check if next selected lat will be new (used in ht-integ conditional ! below): nextnewlat = .false. if (l < mxslice) then if ((utlon_zphtlat(1,l+1)/=spval.and. | utlon_zphtlat(2,l+1)/=spval.and. | utlon_zphtlat(2,l+1)/=utlon_zphtlat(2,l)).or. | izphtlat-1 == nzphtlat_nointeg) nextnewlat = .true. endif ! utlon%glat = utlon_zphtlat(2,l) ixlat = ixfind(gcmlat,nlat,utlon%glat,dlat) ! ! utlon%vtype can be zp, ht, indep, or integ (but is integ only ! after emission -- see goto 100) if (f(ixf)%nlev==1) then utlon%vtype = 'indep' elseif (utlon_zphtlat(1,l) <= gcmlev(npress)) then utlon%vtype = 'zp ' elseif (utlon_zphtlat(1,l) /= spval) then utlon%vtype = 'ht ' endif ! ! Save total heights zlat (if diffs, also save control heights): if (allocated(zlat)) deallocate(zlat) allocate(zlat(nlon,npress),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating zlat") do i=1,nlon do j=1,npress zlat(i,j) = f(ixz)%data(i,ixlat,j) enddo ! j enddo ! i if (diffs) then if (allocated(zlat_cntr)) deallocate(zlat_cntr) allocate(zlat_cntr(nlon,npress),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating zlat_cntr") zlat_cntr(:,:) = fcntr(ixz)%data(:,ixlat,:) endif ! ! Calculate field slice (if diffs, also save control field): if (allocated(flat)) deallocate(flat) allocate(flat(nlon,f(ixf)%nlev),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating flat") flat(:,:) = f(ixf)%data(:,ixlat,:) if (diffs) then if (allocated(flat_cntr)) deallocate(flat_cntr) allocate(flat_cntr(nlon,f(ixf)%nlev),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating flat_cntr") flat_cntr(:,:) = fcntr(ixf)%data(:,ixlat,:) endif 100 continue ! ! Define utlondat(itime,:,izphtlat,ifld) (where 2nd dim is nlon): ! ! Ht-independent field: select case (utlon%vtype) case ('indep') if (.not.diffs) then utlondat(itime,:,izphtlat,ifld) = flat(:,1) else call mkdiffs(flat(:,1),flat_cntr(:,1), + utlondat(itime,:,izphtlat,ifld),nlon,f(ixf)%difftype) endif ! ! At selected zp: case ('zp ') if (trim(f(ixf)%vtype)=='HEIGHT') cycle zphtlat_loop utlon_tmp = utlon_zphtlat(1,l) ! switch to kind=4 if default izp = ixfind(gcmlev,npress,utlon_tmp,dlev) if (izp <= 0) then write(6,"('>>> utlon: bad selected zp', + ' (utlon_zphtlat(1,l)=',f10.2)") utlon_zphtlat(1,l) cycle zphtlat_loop endif utlon%zpht = gcmlev(izp) if (.not.diffs) then utlondat(itime,:,izphtlat,ifld) = flat(:,izp) else call mkdiffs(flat(:,izp),flat_cntr(:,izp), + utlondat(itime,:,izphtlat,ifld),nlon,f(ixf)%difftype) endif ! ! At selected ht: case ('ht ') ! ! Do not process if doing height-only field (e.g. oh-v/b) and ! selected height is outside vertical range of the field: if (trim(f(ixf)%vtype)=='HEIGHT'.and. + (utlon_zphtlat(1,l) < oh_alt(1) .or. + utlon_zphtlat(1,l) > oh_alt(nohalt))) then write(6,"('Note: height ',f10.2,' is outside ', + 'vertical resolution of field ',a)") + utlon_zphtlat(1,l),f(ixf)%fname8 cycle zphtlat_loop endif utlon%zpht = utlon_zphtlat(1,l) ! ! Height-only field (oh-v/b): if (trim(f(ixf)%vtype)=='HEIGHT') then k = ixfind(oh_alt,nohalt,utlon%zpht,1.) if (k <= 0) write(6,"('>>> mkutlon: cannot find', + ' utlon%zpht=',f10.2,' in oh_alt.')") utlon%zpht if (.not.diffs) then utlondat(itime,:,izphtlat,ifld) = flat(:,k) else call mkdiffs(flat(:,k),flat_cntr(:,k), + utlondat(itime,:,izphtlat,ifld),nlon, + f(ixf)%difftype) endif ! ! Interpolate to selected height: else logint = 0 if (trim(f(ixf)%type)=='DENSITY') logint = 1 if (.not.diffs) then ! dum = utlon_zphtlat(1,l) ! switch to kind=4 if default call cuthtint(flat,zlat,nlon,f(ixf)%nlev,flon1, + dum,1,logint,spval,ier,1) utlondat(itime,:,izphtlat,ifld) = flon1(:) ! ! Diffs at selected height: else dum = utlon_zphtlat(1,l) ! switch to kind=4 if default call cuthtint(flat,zlat,nlon,f(ixf)%nlev,flon1, + dum,1,logint,spval,ier,0) call cuthtint(flat_cntr,zlat_cntr,nlon,f(ixf)%nlev, + flon2,dum,1,logint,spval,ier,0) call mkdiffs(flon1,flon2, + utlondat(itime,:,izphtlat,ifld),nlon,f(ixf)%difftype) endif endif ! ! ht-integrated: case ('integ') do j=1,nlon if (trim(f(ixf)%vtype)/='HEIGHT') then utlondat(itime,j,izphtlat,ifld) = + quadrat(flat(j,:),zlat(j,:),f(ixf)%nlev) else ! ht-only field (f(ixf)%nlev==nohalt) utlondat(itime,j,izphtlat,ifld) = + quadrat(flat(j,:),oh_alt,f(ixf)%nlev) endif enddo ! ! Diffs of ht-integrations: if (diffs) then flon1 = utlondat(itime,:,izphtlat,ifld) ! save pert do j=1,nlon if (trim(f(ixf)%vtype)/='HEIGHT') then flon2(j) = quadrat(flat_cntr(j,:),zlat(j,:), + f(ixf)%nlev) else ! ht-only field (f(ixf)%nlev==nohalt) flon2(j) = quadrat(flat_cntr(j,:),oh_alt,f(ixf)%nlev) endif enddo call mkdiffs(flon1,flon2,utlondat(itime,:,izphtlat,ifld), + nlon,f(ixf)%difftype) endif case default write(6,"('>>> mkutlon: unknown utlon%vtype=',a)") + utlon%vtype end select ! ! Make plots and/or output data: if (itime==ntimes) then if (.not.associated(utlon%data)) then allocate(utlon%data(utlon%nx,utlon%ny),stat=ier) if (ier/=0) + call allocerr(ier,"mkutlon allocating utlon%data") endif utlon%data = utlondat(:,:,izphtlat,ifld) ! ! Set ht-integrated units: if (utlon%vtype=='integ') then if (trim(f(ixf)%type)=='OH-BAND') then if (ibohv_watts <= 0) then utlon%data = utlon%data * 1.e-9 ! kilo-rayleighs utlon%funits = "KILO-RAYLEIGHS" else utlon%data = utlon%data / (4.*pi) ! watts/cm2-str utlon%funits = "WATTS/CM2-STR" endif else ! emission field utlon%data = utlon%data * 1.e-6 ! rayleighs utlon%funits = "RAYLEIGHS" endif endif ! ! Take log10 if requested: if ((iutlon_log10==1.and.trim(f(ixf)%type)=='DENSITY').or. + iutlon_log10==2) then call log10f(utlon%data,utlon%nx*utlon%ny,1.e-20,spval) utlon%log10 = 1 else utlon%log10 = 0 endif if (iplot > 0) then call setmultivp(vputlon,iadvfr,nppf+1,multiplt, + ipltrowcol,vp) isltax = 0 call pltutlon(utlon,isltax,vp) ! ! Add top and bottom labels: call mkutlonlabs(h,hcntr,msgout) boff = boffset if (isltax <= 0) boff=.20 call wrlab6(utlon%tlabs,toffset,tlabchsz, + utlon%blabs,boff ,blabchsz,vp,ilab_hq) ! ! Advance frame and write info to stdout: nppf = nppf+1 call advframe(iwk_cgm,igks_cgm,iwk_ps,igks_ps, + iwk_x11,igks_x11,multiplt,iadvfr,nppf,msgout, + 'ut vs lonitude',iframe) ! ! If not making plots, wrout will need zmin,zmax. else call fminmax(utlon%data,size(utlon%data),zmin,zmax) endif ! iplot > 0 ! ! Write output data files: call wrout_utlon(h,hcntr) endif ! itime==ntimes ! ! Do height integration of emission field at current latitude: ! (do this only once per selected latitude, after zpht's have been ! done at current lat) ! if (isemis .and. utlon%vtype /= 'integ' .and. nextnewlat .and. | .not.any(donelats==utlon_zphtlat(2,l)).or. | (isemis.and.utlon%vtype /= 'integ'.and. | izphtlat==nzphtlat_nointeg.and.nsel_lat==1)) then utlon%vtype = 'integ' izphtlat = izphtlat+1 do i=1,mxslice if (donelats(i)==spval) then donelats(i) = utlon_zphtlat(2,l) exit endif enddo goto 100 endif ! ! Release slices: deallocate(flat) deallocate(zlat) if (allocated(flat_cntr)) deallocate(flat_cntr) if (allocated(zlat_cntr)) deallocate(zlat_cntr) enddo zphtlat_loop enddo fields_loop ! ! If doing multiplt and multiadvfr > 0, advance frame if page is only ! partially full (was advanced above if page is full) if (itime==ntimes) then if (multiplt > 0 .and. multiadvfr == 1 .and. iadvfr <= 0 .and. + iplot > 0) + call advframe(iwk_cgm,igks_cgm,iwk_ps,igks_ps, + iwk_x11,igks_x11,multiplt,1,nppf,' ','ut vs lonitude', + iframe) ! ! Release allocated memory: if (allocated(utlondat)) deallocate(utlondat) if (associated(utlon%xx)) deallocate(utlon%xx) if (associated(utlon%yy)) deallocate(utlon%yy) if (associated(utlon%data)) deallocate(utlon%data) endif return end subroutine mkutlon !------------------------------------------------------------------- subroutine mkutlonlabs(h,hcntr,msgout) use plt,only: zmin,zmax,ciu,scfac use proc,only: spval,diffs use input,only: ie5577,ie6300 ! ! Construct 3 top labels (utlon%tlabs) and 3 bottom labels ! (utlonv%blabs) for ut vs lon plots: ! ! Args: type(history),intent(in) :: h,hcntr character(len=*),intent(out) :: msgout ! ! Locals: integer :: lenlab ! ! Set up top and bottom text labels: ! ! Top (1st) top label is optionally provided by user: utlon%tlabs(1) = ' ' ! ! Middle (2nd) top label is full field name + units: ! (prefaced with LOG10 if utlon%log10 > 0) ! (diffs raw or percent part was added by mklons if necessary) ! lenlab = len_trim(utlon%fname)+len_trim(utlon%funits)+3 ! if (utlon%log10 > 0) lenlab = lenlab+6 ! if (lenlab <= len(utlon%tlabs(1))) then ! if (utlon%log10 > 0) then ! utlon%tlabs(2) = 'LOG10 '//trim(utlon%fname)//' ('// ! + trim(utlon%funits)//')' ! else ! utlon%tlabs(2) = ! + trim(utlon%fname)//' ('//trim(utlon%funits)//')' ! endif ! else ! utlon%tlabs(2) = trim(utlon%fname) ! endif ! ! Middle (2nd) top label is full field name + units: ! (prefaced with LOG10 if utlon%log10 > 0) ! if (utlon%known) then lenlab = len_trim(utlon%fname)+len_trim(utlon%funits)+3 if (utlon%log10 > 0) lenlab = lenlab+6 if (lenlab <= len(utlon%tlabs(2))) then if (utlon%log10 > 0) then utlon%tlabs(2) = 'LOG10 '//trim(utlon%fname)//' ('// + trim(utlon%funits)//')' else utlon%tlabs(2) = trim(utlon%fname)//' ('// + trim(utlon%funits)//')' endif else utlon%tlabs(2) = trim(utlon%fname) endif else ! unknown to proc lenlab = len_trim(utlon%sname)+2+len_trim(utlon%fname)+ | len_trim(utlon%funits)+3 if (utlon%log10 > 0) lenlab = lenlab+6 if (lenlab <= len(utlon%tlabs(2))) then if (utlon%log10 > 0) then if (trim(utlon%sname)/=trim(utlon%fname)) then utlon%tlabs(2) = 'LOG10 '//trim(utlon%sname)//': '// | trim(utlon%fname)//' ('//trim(utlon%funits)//')' else utlon%tlabs(2) = 'LOG10 '//trim(utlon%fname)// | ' ('//trim(utlon%funits)//')' endif else ! no log10 if (trim(utlon%sname)/=trim(utlon%fname)) then utlon%tlabs(2) = trim(utlon%sname)//': '// | trim(utlon%fname)//' ('//trim(utlon%funits)//')' else utlon%tlabs(2) = trim(utlon%fname)// | ' ('//trim(utlon%funits)//')' endif endif else utlon%tlabs(2) = trim(utlon%fname) endif endif ! known or unknown ! ! Add DIFFS to label: if (diffs) then if (trim(utlon%difftype)=='RAW') then if (len_trim(utlon%tlabs(2))+7 <= len(utlon%tlabs(2))) then utlon%tlabs(2) = 'DIFFS: '//trim(utlon%tlabs(2)) else utlon%tlabs(2) = 'DIFFS: '//trim(utlon%fname) endif else ! percent if (len_trim(utlon%tlabs(2))+15 <= len(utlon%tlabs(2))) then utlon%tlabs(2) = trim(utlon%difftype)//' DIFFS: '// | trim(utlon%tlabs(2)) else utlon%tlabs(2) = '% DIFFS: '//trim(utlon%fname) endif endif endif ! ! Bottom (3rd) top label is grid info: select case (utlon%vtype) case ('zp ') ! lat at zp write(utlon%tlabs(3),"(' ZP = ',f5.1,' LATITUDE = ',f9.2)") + utlon%zpht,utlon%glat case ('ht ') ! lat at ht write(utlon%tlabs(3),"(' HEIGHT = ',f6.1,' LATITUDE = ', + f9.2)") utlon%zpht,utlon%glat case ('indep') ! lat at ht-indep write(utlon%tlabs(3),"(' LATITUDE = ',f9.2)") utlon%glat case ('integ') ! lat at ht-integ write(utlon%tlabs(3),"(' HEIGHT-INTEGRATED: LATITUDE = ', + f9.2)") utlon%glat case default end select ! ! Top (1st) bottom label is min,max,interval: ! (zmin,zmax, and ciu are in module plt and were defined by contour) ! (scfac is in module plt) if (scfac==1.) then write(utlon%blabs(1),"('MIN,MAX=',2(1pe12.4),' INTERVAL=', + 1pe12.4)") zmin,zmax,ciu else write(utlon%blabs(1),"('MIN,MAX=',2(1pe12.4),' INTERVAL=', + 1pe12.4,' (X',1pe9.2,')')") zmin,zmax,ciu,scfac endif ! ! Middle (2nd) and bottom (3rd) bottom label are history info: ! if (.not.diffs) then ! if (len_trim(utlon%hvol0)+len_trim(utlon%hvol1)+15 <= ! + len(utlon%blabs(2))) then ! write(utlon%blabs(2),"('FIRST, LAST: ',a,', ',a)") ! + trim(utlon%hvol0), trim(utlon%hvol1) ! else ! write(utlon%blabs(2),"('FIRST: ',a)") trim(utlon%hvol0) ! endif ! utlon%blabs(3) = ' ' ! if (trim(utlon%ftype)=='EMISSION') then ! call mkemislab(utlon%sname,ie5577,ie6300,utlon%blabs(3)) ! if (len_trim(utlon%blabs(3)) > 48) blabchsz(3) = .015 ! endif ! else ! if (len_trim(utlon%hvol0)+len_trim(utlon%hvol1)+22 <= ! + len(utlon%blabs(2)).and. ! + len_trim(utlon%hvol0_cntr)+len_trim(utlon%hvol1_cntr)+22 <= ! + len(utlon%blabs(3))) then ! write(utlon%blabs(2),"('FIRST, LAST: ',a,', ',a,' MINUS ')") ! + trim(utlon%hvol0), trim(utlon%hvol1) ! write(utlon%blabs(3),"('FIRST, LAST: ',a,', ',a)") ! + trim(utlon%hvol0_cntr), trim(utlon%hvol1_cntr) ! else ! write(utlon%blabs(2),"('FIRST: ',a,' MINUS ')") ! + trim(utlon%hvol0) ! write(utlon%blabs(3),"('FIRST: ',a)") ! + trim(utlon%hvol0_cntr) ! endif ! endif ! ! 5/05 btf: Put first and last history files in blabs(2 and 3): if (.not.diffs) then if (trim(utlon%hvol0) /= trim(utlon%hvol1)) then write(utlon%blabs(2),"('FIRST: ',a)") trim(utlon%hvol0) write(utlon%blabs(3),"('LAST: ',a)") trim(utlon%hvol1) else write(utlon%blabs(2),"('MODEL ',a)") trim(h%version) write(utlon%blabs(3),"(a)") trim(utlon%hvol0) endif else ! diffs: show perturbed and control files: if (trim(utlon%hvol0) /= trim(utlon%hvol1)) then write(utlon%blabs(2),"('PERT FIRST: ',a,' LAST: ',a)") | trim(utlon%hvol0),trim(utlon%hvol1) write(utlon%blabs(3),"('CNTR FIRST: ',a,' LAST: ',a)") | trim(utlon%hvol0_cntr),trim(utlon%hvol1_cntr) else write(utlon%blabs(2),"('PERT FILE: ',a)") trim(utlon%hvol0) write(utlon%blabs(3),"('CNTR FILE: ',a)") | trim(utlon%hvol0_cntr) endif endif ! ! Return message to be printed to stdout: select case (utlon%vtype) case ('zp ') ! lat at zp write(msgout,"(a,' zp=',f6.1,' lat=',f7.1,' min,max=', + 2e11.4)") utlon%sname,utlon%zpht,utlon%glat,zmin,zmax case ('ht ') ! lat at ht write(msgout,"(a,' ht=',f6.1,' lat=',f7.1,' min,max=', + 2e11.4)") utlon%sname,utlon%zpht,utlon%glat,zmin,zmax case ('indep') ! lat at ht-indep write(msgout,"(a,' ht-indep lat=',f7.1,' min,max=', + 2e11.4)") utlon%sname,utlon%glat,zmin,zmax case ('integ') ! lat at ht-integ write(msgout,"(a,' ht-integ lat=',f7.1,' min,max=', + 2e11.4)") utlon%sname,utlon%glat,zmin,zmax case default end select end subroutine mkutlonlabs !------------------------------------------------------------------- subroutine wrout_utlon(h,hcntr) use plt,only: zmin,zmax use proc use input ! ! Args: type(history),intent(in) :: h,hcntr ! ! Locals: character(len=80) :: msgout ! if (iwrdat==0.and.iwrxdr==0) return ! ! Make labels if not done for plots: if (iplot == 0) call mkutlonlabs(h,hcntr,msgout) ! ! Write to ascii data file: ! subroutine wrdat(iwr,lu,f,nx,ny,xx,yy,xlab,ylab,fieldlab, ! + infolab,histlab,iframe,proclab,senddat) ! if (iwrdat > 0) then call wrdat(iwrdat,ludat,utlon%data,utlon%nx,utlon%ny, + utlon%xx,utlon%yy,utlon%xlab,utlon%ylab,utlon%tlabs(2), + utlon%tlabs(3),utlon%blabs(2),iframe_dat,'tgcmproc',senddat) if (iplot==0) then write(6,"('Data frame ',i4,': ',a)") iframe_dat,trim(msgout) endif iframe_dat = iframe_dat+1 endif ! ! Write to xdr data file: ! subroutine wrxdr(flnm,f,nx,ny,xx,yy,xlab,ylab,lab1, ! + lab2,lab3,lab4,mtime,iclose) ! if (iwrxdr > 0) then call wrxdr(flnm_xdr,utlon%data,utlon%nx,utlon%ny, + utlon%xx,utlon%yy,utlon%xlab,utlon%ylab, + utlon%tlabs(2),utlon%tlabs(3),utlon%blabs(2), + utlon%blabs(1),h%mtime,0) flnm_xdr = flnm_xdr(1:len_trim(flnm_xdr)-1) if (iplot==0) then write(6,"('Xdr frame ',i4,': ',a)") iframe_xdr,trim(msgout) endif iframe_xdr = iframe_xdr+1 endif end subroutine wrout_utlon !------------------------------------------------------------------- subroutine pltutlon(utlon,isltax,vp) use plt ! ! Args: type(utlon_type),intent(in) :: utlon real,intent(in) :: vp(4) integer,intent(inout) :: isltax ! ! Set up conpack: call cpseti('SET',0) call cpseti('MAP',0) call cpsetr('XC1',utlon%xx(1)) call cpsetr('XCM',utlon%xx(utlon%nx)) call cpsetr('YC1',utlon%yy(1)) call cpsetr('YCN',utlon%yy(utlon%ny)) call set(vp(1),vp(2),vp(3),vp(4), + utlon%xx(1),utlon%xx(utlon%nx),utlon%yy(1), + utlon%yy(utlon%ny),1) ! ! Contour: call contour(utlon%data,utlon%nx,utlon%nx,utlon%ny) ! ! Add axes and labels: call labutxy(utlon%mtimes,utlon%nx,utlon%yy,utlon%ny, + utlon%ylab,0.,isltax,utlon%glat) ! end subroutine pltutlon c----------------------------------------------------------------- end module mk_utlon