! subroutine allocf ! ! Allocate and define flds structure array (excluding flds%data) ! for user requested fields cfields. ! Additional non-requested fields may be allocated, e.g., wind ! components for UNVN or UIVI, heights (always), etc., and ! dependencies for derived fields are not allocated. ! Data components will be allocated later by allocfdat, when ! history is read (see allocfdat in getflds). ! Fields may or may not be known to the processor. ! (This is called from tgcmproc before hist loop) ! use proc use fields use flist use input implicit none ! ! Args: ! character(len=8),intent(in) :: cfields(mxfproc) ! names requested ! ! Locals: integer :: i,ii,k,nf,ix,ier,nfdep,nfder,nrf,need_hmf2 character(len=8) :: rfields(mxfproc) ! names of fields allocated character(len=8) :: fdep(mxfproc) ! dependency list character(len=8) :: fder(mxfproc) ! dependency list logical :: densities ! ! Externals: integer,external :: ixfindc character(len=16),external :: float_to_str ! ! Count number of requested fields and put in rfields: rfields = cfields nf = count(rfields/=' ') ! ! Include structures for derived dependencies of derived fields: ! (non-derived dependencies are covered by allocfdat) ! densities = .false. nrf = nf do ix=1,nrf i = ixfindc(flds_known%fname8,nfknown,rfields(ix)) if (i > 0) then ! field is known if (flds_known(i)%derived) then ! field is derived if (trim(flds_known(i)%type)=='DENSITY') densities=.true. call getder(flds_known(i),fder,1) nfder = count(fder/=' ') if (nfder > 0) then ! there are derived dependencies do i=1,nfder if (.not.any(rfields==fder(i))) then nf = nf+1 rfields(nf) = fder(i) write(6,"('Requesting derived dependency ',a, + ' (required for ',a,')')") fder(i),rfields(ix) endif enddo endif endif endif enddo ! ! Need un and vn for tn+unvn or ht+unvn overlays, or unvn alone: ! if ((any(cfields=='TN ').and.map_tn_unvn>0).or. + (any(cfields=='Z ').and.map_ht_unvn>0).or. + any(cfields=='UNVN ')) then if (.not.any(rfields=='UN ')) then nf = nf+1 ; rfields(nf) = 'UN ' write(6,"('Requesting UN (needed for neutral velocity', + ' vectors)')") endif if (.not.any(rfields=='VN ')) then nf = nf+1 ; rfields(nf) = 'VN ' write(6,"('Requesting VN (needed for neutral velocity', + ' vectors)')") endif endif ! ! Need ion drifts for poten+uivi or uivi. If any ion drift component ! is requested or needed, get all 3 components: ! if ((any(cfields=='POTEN ').and.map_ep_uivi>0).or. + any(cfields=='UIVI ').or.any(cfields=='UI ').or. + any(cfields=='VI ').or.any(cfields=='WI ')) then if (.not.any(rfields=='UI ')) then nf = nf+1 ; rfields(nf) = 'UI ' write(6,"('Requesting UI (needed for vectors overlay)')") endif if (.not.any(rfields=='VI ')) then nf = nf+1 ; rfields(nf) = 'VI ' write(6,"('Requesting VI (needed for vectors overlay)')") endif if (.not.any(rfields=='WI ')) then nf = nf+1 ; rfields(nf) = 'WI ' endif endif ! ! Need EPVX and EPVY epflux vectors for overlay on EPVDIV, when ! ilon_epvdiv_yz > 0. (the vectors will be requested via dependencies ! for EPVYZ and (EPVYZMAG and ilon_epvyzmag_yz > 0)): ! if ((any(cfields=='EPVDIV ').and.ilon_epvdiv_yz>0)) then if (.not.any(rfields=='EPVY ')) then nf = nf+1 ; rfields(nf) = 'EPVY ' write(6,"('Requesting EPVY (needed for vectors overlay)')") endif if (.not.any(rfields=='EPVZ ')) then nf = nf+1 ; rfields(nf) = 'EPVZ ' write(6,"('Requesting EPVZ (needed for vectors overlay)')") endif endif ! ! Always need heights from the history: ! if (.not.any(rfields=='Z ')) then nf = nf+1 rfields(nf) = 'Z ' endif ! ! Need t,o2,o,n2 for density conversion (pkt, barm): ! if (densities.and.iden > 0) then if (.not.any(rfields=='TN ')) then nf = nf+1 rfields(nf) = 'TN ' write(6,"('Will process TN for density conversion.')") endif if (.not.any(rfields=='O2 ')) then nf = nf+1 rfields(nf) = 'O2 ' write(6,"('Will process O2 for density conversion.')") endif if (.not.any(rfields=='O1 ')) then nf = nf+1 rfields(nf) = 'O1 ' write(6,"('Will process O1 for density conversion.')") endif endif ! ! Need hmf2 if a user-selected ht/zp is "hmax" or "hmf2": ! (not available with maps) ! need_hmf2=0 do k=1,mxzpht if (ipltxyut>0.and. + (trim(float_to_str(xyut_zpht(k)))=='hmf2'.or. + trim(float_to_str(xyut_zpht(k)))=='HMF2'.or. | xyut_zpht(k)==hmf2flag)) need_hmf2=need_hmf2+1 enddo if (need_hmf2 > 0) then if (.not.any(rfields=='HMF2')) then nf = nf+1 rfields(nf) = 'HMF2' endif endif ! ! If doppler t,u,v requested for xyut, then need t,u,v: ! if (ipltxyut > 0.and.ixyut_doppler > 0) then if (.not.any(rfields=='TN')) then nf = nf+1 rfields(nf) = 'TN' endif if (.not.any(rfields=='UN')) then nf = nf+1 rfields(nf) = 'UN' endif if (.not.any(rfields=='VN')) then nf = nf+1 rfields(nf) = 'VN' endif endif ! ! Need VN for stream function: ! if (ipltlon > 0.and.istream > 0) then if (.not.any(rfields=='VN')) then nf = nf+1 rfields(nf) = 'VN' endif endif ! ! Do the allocation: ! allocate(flds(nf),stat=ier) if (ier /= 0) call allocerr(ier,"allocate flds from allocf.") if (diffs) then allocate(flds_cntr(nf),stat=ier) if (ier /= 0) + call allocerr(ier,"allocate flds_cntr from allocf.") endif ! ! Set components of known field structures, and name of ! any unknown fields: ! do i=1,nf call fldinit(flds(i)) if (diffs) call fldinit(flds_cntr(i)) ix = ixfindc(flds_known%fname8,nfknown,rfields(i)) if (ix > 0) then ! field is known flds(i) = flds_known(ix) ! structure assign if (diffs) flds_cntr(i) = flds_known(ix) else ! unknown field (diagnostic secondary history field) flds(i)%fname8 = rfields(i) write(flds(i)%fname56,"(a)") rfields(i) if (diffs) then flds_cntr(i)%fname8 = rfields(i) write(flds_cntr(i)%fname56,"(a)") rfields(i) endif endif ! ! Set field requested if it is in cfields, otherwise is ! needed but not requested (e.g., z, un and vn for unvn, ! ui and vi for uivi, etc). ! if (any(cfields==rfields(i))) then flds(i)%requested = .true. if (diffs) flds_cntr(i)%requested = .true. else flds(i)%requested = .false. if (diffs) flds_cntr(i)%requested = .false. endif enddo ! ! Turn off ion drifts if necessary (ionvel is checked by getflds): ! if (.not.any(rfields=='UI ')) ionvel = 0 ! ! If making rho with iden==0 (mass mix ratios), warn about ! getting constant rho=1.0, or rho diffs=0.0: ! if (densities.and.iden==0) then if (any(rfields=='RHO ')) then write(6,"('>>> WARNING: iden=',i2,' (mass mixing ratios)', + /' Mass mixing ratio of RHO (o2+o+n2) is constant 1.0', + /' (diffs of rho will be 0.0)')") iden endif endif ! ! Report to stdout: write(6,"(/'Requesting ',i3,' field structures:')") nf write(6,"('(These will be processed ONLY if they are ', + 'available on the history'/' OR they are derived and ', + 'all their dependencies are available.)')") write(6,"('Field Requested Known Derived ', + 'Dependencies')") write(6,"(60('-'))") do i=1,nf if (.not.flds(i)%derived) then write(6,"(a8,4x,3(l1,11x),'[none]')") + flds(i)%fname8,flds(i)%requested, + any(flds_known%fname8==flds(i)%fname8),flds(i)%derived else write(6,"(a8,4x,3(l1,11x))",advance='NO') + flds(i)%fname8,flds(i)%requested, + any(flds_known%fname8==flds(i)%fname8),flds(i)%derived ix = size(flds(i)%fneed) do ii=1,ix if (ii