text:
Olive Tree Lane is a pedestrian and Bike Paths bicycle path on the UC Davis Campus campus lined on both sides with an endless row of trees.  The path is located off Russell Boulevard near Arlington Farm and can be seen while riding the Unitrans D bus line. The path ends near the University Airport.

Olive Tree Lane is home to several Feral Bees feral colonies of Honeybees.

The lane is not on Google Maps (as of 2008).  Got a free weekend?  Go to wiki:sf:Google and wiki:wikipedia:Don Quixote complain until they fix it!

Whoah, I thought the sunlit picture was showing the trees on fire... I have fond memories of biking to camp putah along this path!  Users/StevenDaubert

As of 2 Feb 2010, Google Maps labels this as Airport Road, but I recently reported it as a problem and suggested changing it to Olive Tree Lane, as the locals call it. Users/AliPezeshkpour

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
!!  Copyright (C)  Stichting Deltares, 2012-2016.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License version 3,
!!  as published by the Free Software Foundation.
!!
!!  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 <http://www.gnu.org/licenses/>.
!!
!!  contact: delft3d.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands
!!
!!  All indications and logos of, and references to registered trademarks
!!  of Stichting Deltares remain the property of Stichting Deltares. All
!!  rights reserved.

      subroutine RADALG     ( pmsa   , fl     , ipoint , increm, noseg ,
     &                        noflux , iexpnt , iknmrk , noq1  , noq2  ,
     &                        noq3   , noq4   )
!>\file
!>       Light efficiency function DYNAMO algae
!>
!>              Routine is called per algae species with species specific coefficients
!>              Function returns 1.0 if:
!>              - both light at top of cell and at bottom of cell are larger than saturation
!>              - saturation value is zero
!>              If light within the cell becomes below the saturation value, then for
!>              that light a linear dependency between 0.0 and the saturation value is
!>              assumed: mu(I) = I/Isat for I < Isat and 1.0 for I > Isat.\n
!>              This (partly) linear lightcurve is analytically integrated over depth for
!>              the given extinction coefficient.\n
!>              If the extinction coefficient or the water depth is zero, like more or less
!>              in a chemostat, then the function value for the given amount of light
!>              is returned: either 1.0 or a value on the slope.

      implicit none

!     Type    Name         I/O Description

      real(4) pmsa(*)     !I/O Process Manager System Array, window of routine to process library
      real(4) fl(*)       ! O  Array of fluxes made by this process in mass/volume/time
      integer ipoint(  6) ! I  Array of pointers in pmsa to get and store the data
      integer increm(  6) ! I  Increments in ipoint for segment loop, 0=constant, 1=spatially varying
      integer noseg       ! I  Number of computational elements in the whole model schematisation
      integer noflux      ! I  Number of fluxes, increment in the fl array
      integer iexpnt(4,*) ! I  From, To, From-1 and To+1 segment numbers of the exchange surfaces
      integer iknmrk(*)   ! I  Active-Inactive, Surface-water-bottom, see manual for use
      integer noq1        ! I  Nr of exchanges in 1st direction (the horizontal dir if irregular mesh)
      integer noq2        ! I  Nr of exchanges in 2nd direction, noq1+noq2 gives hor. dir. reg. grid
      integer noq3        ! I  Nr of exchanges in 3rd direction, vertical direction, pos. downward
      integer noq4        ! I  Nr of exchanges in the bottom (bottom layers, specialist use only)
      integer ipnt(  6)   !    Local work array for the pointering
      integer iseg        !    Local loop counter for computational element loop

!***********************************************************************
!
!     Project : STANDAARDISATIE PROCES FORMULES T721.72
!     Author  : Pascal Boderie
!     Date    : 921210             Version : 0.01
!
!     History :
!
!     Date      Author          Description
!     --------  --------------  --------------------------------------
!     19921229  Pascal Boderie  Add third algae type, nutrient ratio's
!                               per species
!     20140530  Leo Postma      Allow for zero depth, zero extinction
!                               and/or zero RadSat
!
!***********************************************************************

!     Type    Name         I/O Description                                         Unit

      real(4) Depth       ! I  depth of segment                                    (m)
      real(4) Rad         ! I  irradiation at the segment upper-boundary           (W/m2)
      real(4) RadSat      ! I  total radiation growth saturation for this species  (W/m2)
      real(4) ExtVl       ! I  total extinction coefficient visible light          (1/m)
      real(4) TFGro       ! I  temperature function growth of this species <0-1>   (-)
      real(4) LimRad      ! O  radiation limitation function of this species <0-1> (-)
      logical LgtOpt      !    False if RadSat, Frad and LnFrad are equal for all cells
      real(4) Frad        !    Saturation fraction: < 1.0 is under-saturation      (-)
      real(4) LnFrad      !    natural logarithm of Frad                           (-)
      real(4) ExtDpt      !    product of extinction and depth                     (-)
      real(4) RadBot      !    radiation at the bottom of the cell                 (-)

      ipnt        = ipoint

      LgtOpt = .true.
      if ( increm(2) .eq. 0 .and. increm(3) .eq. 0 .and. increm(5) .eq. 0 ) then
         LgtOpt = .false.             !  This is constant for all cells
         Rad    = pmsa( ipnt(  2) )
         RadSat = pmsa( ipnt(  3) )
         TFGro  = pmsa( ipnt(  5) )
         RadSat = TFGro * RadSat      !  Correct RadSat for temperature
         if ( RadSat .gt. 1e-20 ) then
            Frad   = Rad / RadSat
            LnFrad = 0.0
            if ( Rad .gt. 1E-5 ) LnFrad = Log ( Frad )
         endif
      endif

      do 9000 iseg = 1 , noseg

         if ( btest(iknmrk(iseg),0) ) then

            if ( LgtOpt ) then
               Rad    = pmsa( ipnt(  2) )
               RadSat = pmsa( ipnt(  3) )
               TFGro  = pmsa( ipnt(  5) )
               RadSat = TFGro * RadSat
               if ( RadSat .gt. 1e-20 ) then
                  Frad   = Rad / RadSat
                  LnFrad = 0.0
                  if ( Rad .gt. 1E-5 ) LnFrad = Log ( Frad )
               endif
            endif

            if ( RadSat .le. 1e-20 ) then
               LimRad = 1.0
            else
               Depth = pmsa( ipnt(  1) )
               ExtVl = pmsa( ipnt(  4) )
               ExtDpt = ExtVl * Depth
               if ( ExtDpt .le. 1.0e-10 ) then    !  No extinction, e.g. chemostat
                  LimRad = min( Frad, 1.0 )
               else
                  RadBot = Frad * exp( - ExtDpt )
                  if ( Frad .gt. 1.0 ) then       !  Saturation at the surface of the cell
                     if ( RadBot .gt. 1.0 ) then
                        LimRad = 1.0
                     else
                        LimRad = ( 1.0 + LnFrad - RadBot ) / ExtDpt
                     endif
                  else
                     LimRad = ( Frad - RadBot ) / ExtDpt
                  endif
               endif
            endif

            pmsa( ipnt(  6)   ) = LimRad

         endif

         ipnt        = ipnt        + increm

 9000 continue

      return
      end subroutine

max_stars_repo_name: liujiamingustc/phd

max_issues_repo_name: liujiamingustc/phd

max_forks_repo_name: liujiamingustc/phd


text:
!-----------------------------------------------------------------------
!     Subroutine:    stellopt_bcast_vmec
!     Authors:       S. Lazerson (lazerson@pppl.gov)
!     Date:          05/26/2012
!     Description:   This subroutine broadcasts the entire VMEC INDATA
!                    namelist because the processors in the local_comm
!                    never read the INDATA namelist.  Essentially it
!                    mimics the VMEC initialization routines.  This was
!                    probably overkill but at least the whole namelist
!                    gets updated.
!-----------------------------------------------------------------------
      SUBROUTINE stellopt_bcast_vmec(local_master,local_comm,iflag)
!-----------------------------------------------------------------------
!     Libraries
!-----------------------------------------------------------------------
      USE vmec_input
      USE mpi_params
      USE mpi_inc
      IMPLICIT NONE
!-----------------------------------------------------------------------
!     Local Variables
!        ier         Error flag
!        iunit       File unit number
!----------------------------------------------------------------------
      INTEGER,INTENT(INOUT) :: local_master
      INTEGER,INTENT(INOUT) :: local_comm
      INTEGER,INTENT(INOUT) :: iflag

!----------------------------------------------------------------------
!     BEGIN SUBROUTINE
!----------------------------------------------------------------------
!DEC$ IF DEFINED (MPI_OPT)
      iflag = 0
      ! Logicals
      CALL MPI_BCAST(lpofr,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lmac,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lfreeb,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lrecon,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(loldout,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(ledge_dump,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lasym,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lforbal,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lrfp,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lmovie,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lmove_axis,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lwouttxt,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(ldiagno,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lmoreiter,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lfull3d1out,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(l_v3fit,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lspectrum_dump,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(loptim,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lgiveup,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BCAST(lbsubs,1,MPI_LOGICAL,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      ! Integers
      CALL MPI_BCAST(nfp,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(ncurr,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nsin,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(niter,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nstep,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nvacskip,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(mpol,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(ntor,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(ntheta,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nzeta,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(mfilter_fbdy,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nfilter_fbdy,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(max_main_iterations,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(imse,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(isnodes,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(itse,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(ipnodes,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(iopt_raxis,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(imatch_phiedge,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nflxs,1,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      ! Integer Arrays
      CALL MPI_BCAST(ns_array,100,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(niter_array,100,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(nbfld,nbsetsp,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(indxflx,nfloops,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BCAST(indxbfld,nbcoilsp*nbsetsp,MPI_INTEGER,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      ! Reals
      CALL MPI_BCAST(time_slice,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(curtor,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(delt,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ftol,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(tcon0,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(gamma,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(phiedge,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(phidiam,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_current,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_delphid,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(tensi,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(tensp,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(tensi2,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(fpolyi,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(presfac,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(mseangle_offset,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(pres_offset,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(mseangle_offsetm,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(spres_ped,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(bloat,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(pres_scale,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(prec2d_threshold,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(bcrit,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(fgiveup,1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      ! Real Arrays
      CALL MPI_BCAST(rbc,(2*ntord+1)*(mpol1d+1),MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(zbs,(2*ntord+1)*(mpol1d+1),MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(rbs,(2*ntord+1)*(mpol1d+1),MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(zbc,(2*ntord+1)*(mpol1d+1),MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(am,21,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ai,21,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ac,21,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(aphi,20,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ah,21,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(at,21,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(am_aux_s,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(am_aux_f,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ac_aux_s,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ac_aux_f,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ai_aux_s,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ai_aux_f,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ah_aux_s,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ah_aux_f,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(at_aux_s,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(at_aux_f,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(raxis,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(zaxis,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(raxis_cc,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(raxis_cs,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(zaxis_cc,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(zaxis_cs,ntord+1,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ftol_array,100,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(extcur,nigroup,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(mseprof,nmse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(rthom,ntse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(datathom,ntse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_thom,ntse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(rstark,nmse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(datastark,nmse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_stark,nmse,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(dsiobt,nfloops,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_flux,nfloops,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(bbc,nbcoilsp*nbsetsp,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(sigma_b,nbcoilsp*nbsetsp,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(psa,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(pfa,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(isa,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BCAST(ifa,ndatafmax,MPI_DOUBLE_PRECISION,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      ! Strings
      CALL MPI_BCAST(pcurr_type,20,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(piota_type,20,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(pmass_type,20,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(pt_type,20,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(ph_type,20,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(mgrid_file,200,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(trip3d_file,200,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(precon_type,10,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(arg1,120,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BCAST(input_extension,100,MPI_CHARACTER,local_master,local_comm,iflag)
      CALL MPI_BARRIER(local_comm,iflag)
      IF (iflag /= 0) RETURN
!DEC$ ENDIF

      ! DO A CHECK HERE
      iflag = 0
      !IF (rbc(0,1) < 0) iflag = -1
      !IF (rbc(0,0) < (SUM(SUM(rbc,DIM=2),DIM=1)-rbc(0,0))) iflag = -1
      RETURN
!----------------------------------------------------------------------
!     END SUBROUTINE
!----------------------------------------------------------------------
      END SUBROUTINE stellopt_bcast_vmec

max_stars_repo_name: joseluisvelasco/STELLOPT

max_issues_repo_name: joseluisvelasco/STELLOPT

max_forks_repo_name: joseluisvelasco/STELLOPT


text:
port P

queued component C {

  async input port p: P

}

instance c: C base id 0x100 \
  queue size 10 \
  cpu 0

ext: fpp

max_stars_repo_name: kevin-f-ortega/fpp

max_issues_repo_name: kevin-f-ortega/fpp

max_forks_repo_name: kevin-f-ortega/fpp


text:
subroutine rdtdcn(lundia    ,lunout    ,lunrd     ,error     ,filout    , &
                & filbcc    ,runid     ,profil    ,eol       ,itstrt    , &
                & itfinish  ,nto       ,lstsc     ,kmax      ,nambnd    , &
                & namcon    ,bubble    ,gdp       )
!----- GPL ---------------------------------------------------------------------
!
!  Copyright (C)  Stichting Deltares, 2011-2016.
!
!  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 version 3.
!
!  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 <http://www.gnu.org/licenses/>.
!
!  contact: delft3d.support@deltares.nl
!  Stichting Deltares
!  P.O. Box 177
!  2600 MH Delft, The Netherlands
!
!  All indications and logos of, and references to, "Delft3D" and "Deltares"
!  are registered trademarks of Stichting Deltares, and remain the property of
!  Stichting Deltares. All rights reserved.
!
!-------------------------------------------------------------------------------
!  $Id: rdtdcn.f90 5717 2016-01-12 11:35:24Z mourits $
!  $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/tags/6686/src/engines_gpl/flow2d3d/packages/io/src/preprocessor/rdtdcn.f90 $
!!--description-----------------------------------------------------------------
!
!    Function: Reads time dependent constituent data from new
!              bc-file for the constituents
! Method used:
!
!!--pseudo code and references--------------------------------------------------
! NONE
!!--declarations----------------------------------------------------------------
    use precision
    !
    use globaldata
    use string_module
    !
    implicit none
    !
    type(globdat),target :: gdp
    !
    ! The following list of pointer parameters is used to point inside the gdp structure
    !
    include 'pardef.igd'
    integer                    , pointer :: itdate
    real(fp)                   , pointer :: tstop
    real(fp)                   , pointer :: dt
    real(fp)                   , pointer :: tunit
    character*20, dimension(:) , pointer :: keywrd
    character*37, dimension(:) , pointer :: fmtbcc
!
! Global variables
!
    integer                        , intent(in)  :: itfinish !  Description and declaration in inttim.igs
    integer                                      :: itstrt   !  Description and declaration in inttim.igs
    integer                                      :: kmax     !  Description and declaration in esm_alloc_int.f90
    integer                        , intent(in)  :: lstsc    !  Description and declaration in dimens.igs
    integer                                      :: lundia   !  Description and declaration in inout.igs
    integer                                      :: lunout   !  Unit number for direct access Delft3D-FLOW help file between TDATOM and TRISIM
    integer                                      :: lunrd    !  Unit number of the attribute file containing the time series
    integer                        , intent(in)  :: nto      !  Description and declaration in esm_alloc_int.f90
    logical                        , intent(in)  :: bubble   !  Description and declaration in procs.igs
    logical                                      :: error    !  Flag=TRUE if an error is encountered
    character(*)                                 :: filbcc   !  Name of the specified data file
    character(*)                                 :: filout   !  Name of the output file to be opened
    character(*)                   , intent(in)  :: runid    !  Run identification code for the current simulation (used to determine
                                                             !  the names of the in- /output files used by the system)
    character(1)                   , intent(in)  :: eol      !  ASCII code for End-Of-Line (^J)
    character(20), dimension(lstsc), intent(in)  :: namcon   !  Description and declaration in esm_alloc_char.f90
    character(20), dimension(nto)                :: nambnd   !  Description and declaration in esm_alloc_char.f90
    character(40)                  , intent(in)  :: profil   !  Total string of possible profiles
!
! Local variables
!
    integer                                   :: ibeg   ! Begin position in the RECORD from where the search for data/record is started
    integer                                   :: iend   ! Last position in the RECORD when the searched data/record is finished
    integer                                   :: ier    ! =  0 -> end of record encountered =  1 -> real value found = -1 -> length or number of data is larger then specified by the calling routine
    integer                                   :: iocond ! IO status for reading
    integer                                   :: irec
    integer                                   :: irecrd ! Counter of records if input file is a direct access file
    integer                                   :: itold  ! Help var. to store last read time to test accending order
    integer                                   :: ittdep ! Help var. for the time read (now de- fined as multiples of DT, but in fu- ture it may take any value)
    integer                                   :: ix
    integer                                   :: k
    integer                                   :: l
    integer                                   :: lflbcc ! Actual length of FILBCC
    integer                                   :: lflout ! Actual length of FILOUT
    integer                                   :: lrecrd ! Length of record read
    integer                                   :: mxlrec ! Actual maximum record length (:= KMAX*24*2 + 24)
    integer                                   :: n      ! Help var. for the nr. of data to be read (see LENDAT)
    integer                                   :: nb
    integer                                   :: newlun
    integer                                   :: nlook  ! Nr. of data to look for in RECORD
    integer                                   :: np
    integer                                   :: npara  ! Number of parameter records
    integer                                   :: nparrd ! NR. of parameter records actual read
    integer                                   :: npconc ! NR. of parameter records actual read for constituents only
    integer                                   :: nr
    integer                                   :: ntimrd
    logical                                   :: access ! Flag to read file as direct access or sequential
    logical                                   :: ex     ! Flag to test if file exists
    real(fp)                                  :: rdfaul ! Default value when RARRAY(N) not found
    real(fp)                                  :: sdt    ! dt*tunit/60
    real(fp)                                  :: timrd  ! Time in minutes read
    real(fp)                                  :: timscl
    real(fp), dimension(5)                    :: rarray ! Help array to read 5 values from RECORD
    real(fp), dimension(:,:,:,:),allocatable  :: rwbval ! 7 Array for the time dependent data:
                                                        !    1,1,N,L = value at surface, at A
                                                        !    1,2,N,L = value at bottom , at A
                                                        !    2,1,N,L = value at surface, at B
                                                        !    2,2,N,L = value at bottom , at B
                                                        !   or
                                                        !    1,K,N,L = value at layer K, at A
                                                        !    2,K,N,L = value at layer K, at B
    real(fp), dimension(:,:),allocatable      :: zstep  ! Time varying location of disconti- nuity for the 3D BC for constituents
    character(1)                              :: interp
    character(1)                              :: quote  ! Apostrophe ASCII-character 39
    character(10), dimension(2)               :: parunt ! Unit name fitting the parameter
    character(10), dimension(:,:),allocatable :: tprofc ! Vertical profile for constituent - uniform - linear - step - 3d-profile
    character(36), dimension(1 + 2*mxkmax)    :: parrd  ! Parameter names read
    character(36), dimension(2)               :: parnam ! Names of the paramaters to write to time dependent files for BCC
    character(40)                             :: cntain
    character(400)                            :: errmsg ! Character var. containing the error message to be written to file. The message depends on the error.
    character(5000)                           :: record ! Standard rec. length in an attribute file (maximum MXKMAX*24*2 + 48)
    character(63)                             :: tablnm ! Table name specification
    !
    data rarray/5*0.0/
!
!! executable statements -------------------------------------------------------
!
    ! Initialisation
    ! >>>>>for now reading the direct access file not possible
    !
    fmtbcc  => gdp%gdfmtbcc%fmtbcc
    keywrd  => gdp%gdkeywtd%keywrd
    itdate  => gdp%gdexttim%itdate
    tstop   => gdp%gdexttim%tstop
    dt      => gdp%gdexttim%dt
    tunit   => gdp%gdexttim%tunit
    !
    allocate(rwbval(mxkmax, 2, mxnto, lstsc))
    allocate(zstep(mxnto, lstsc))
    allocate(tprofc(mxnto, lstsc))
    !
    access = .false.
    irecrd = 0
    quote  = char(39)
    cntain = ' # at ends A&B of open boundary segment '
    interp = 'Y'
    !
    call remove_leading_spaces(filout    ,lflout    )
    call remove_leading_spaces(filout    ,lflbcc    )
    !
    ! Define parameter name for time column
    !
    parnam(1) = 'Time starting at ITDATE = 0.0       '
    parunt(1) = '[   min  ]'
    !
    ! Initialize RWBVAL, ZSTEP and TPROFC array
    !
    do n = 1, nto
       do l = 1, lstsc
          do k = 1, kmax
             rwbval(k, 1, n, l) = 0.0
             rwbval(k, 2, n, l) = 0.0
          enddo
          zstep (n, l) = 0.0
          tprofc(n, l) = ' '
       enddo
    enddo
    !
    ! Start reading the time dependent data.
    !
    do n = 1, nto
       do l = 1, lstsc
          ittdep = -1
          itold  = -1
          !
          read (lunrd, '(a)', iostat = iocond) record
          !
          ! Premature EOR encountered or error (IOCOND <> 0)
          ! Test last time read
          ! Error messages not completely correct
          !
          if (iocond/=0) then
             error = .true.
             call prterr(lundia    ,'G007'    ,filbcc    )
             if (iocond<0) then
                if (itold < itfinish) then
                   write(errmsg,'(a,a,a)') 'Last time in file ', trim(filbcc), ' <'
                   call prterr(lundia    ,'U042'    ,errmsg)
                   error = .true.
                   goto 9999
                elseif (n<nto .or. l<lstsc) then
                   write(errmsg,'(a,a)') 'not for all open boundaries BCC data defined in ', trim(filbcc)
                   call prterr(lundia    ,'U021'    ,errmsg)
                   error = .true.
                   goto 9999
                else
                endif
             endif
          endif
          !
          ! Check for EOL in file and find maximum number of characters
          ! to read if EOL is located.
          ! Only for UNIX systems where EOL = ^J
          !
          lrecrd = len(record)
          if (eol/=' ' .and. index(record, eol)/=0) lrecrd = index(record, eol)
          !
          ! Read all keywords prior to time dependent data records
          !
          npara = 1 + 2*kmax
          call flhnew(lunrd     ,lundia    ,error     ,record(:lrecrd)      ,access    , &
                    & irecrd    ,nambnd(n) ,tprofc(n, l)         ,interp    ,itdate    , &
                    & timscl    ,ntimrd    ,parrd     ,npara     ,nparrd    , &
                    & bubble    ,gdp       )
          if (error) goto 9999
          !
          ! Test profile definition
          !
          if (index(profil, tprofc(n, l))==0) then
             call prterr(lundia    ,'V096'    ,tprofc(n, l)         )
             error = .true.
             goto 9999
          endif
          !
          ! Test number of parameters read incombination with defined
          !
          if (tprofc(n, l)(:7)=='uniform') then
             if (nparrd/=3) then
                call prterr(lundia    ,'V097'    ,' '       )
                error = .true.
                goto 9999
             endif
          elseif (tprofc(n, l)(:6)=='linear') then
             if (nparrd/=5) then
                call prterr(lundia    ,'V097'    ,' '       )
                error = .true.
                goto 9999
             endif
          elseif (tprofc(n, l)(:4)=='step') then
             if (nparrd/=6) then
                call prterr(lundia    ,'V097'    ,' '       )
                error = .true.
                goto 9999
             endif
          elseif (tprofc(n, l)=='3d-profile') then
             if (nparrd/=1 + 2*kmax) then
                call prterr(lundia    ,'V097'    ,' '       )
                error = .true.
                goto 9999
             endif
          else
          endif
          !
          ! Test name of constituent conform read parameter name
          ! Only for the constituent names, so for step last parameter
          ! should be tested for 'dicontinuity'
          !
          npconc = nparrd
          if (tprofc(n, l)(:4)=='step') npconc = nparrd - 1
          do np = 2, npconc
             if (parrd(np)(:20)/=namcon(l)) then
                call prterr(lundia    ,'V096'    ,parrd(np) )
                error = .true.
                goto 9999
             endif
          enddo
          !
          if (tprofc(n, l)(:4)=='step') then
             if (parrd(nparrd)(:13)/='discontinuity') then
                call prterr(lundia    ,'V096'    ,parrd(nparrd)        )
                error = .true.
                goto 9999
             endif
          endif
          !
          ! Determine the record length for direct access file and the
          ! corresponding format
          !
          if (n==1 .and. l==1) then
             mxlrec = max(89,16 + kmax*2*14 + 1)
             if (mxlrec > 89) then
                do nb = 1, mxfmtc
                   ix = index(fmtbcc(nb), 't89')
                   if (ix/=0) then
                      write (fmtbcc(nb)(ix + 1:ix + 4), '(i4.4)') mxlrec
                   endif
                enddo
             endif
             !
             ! Open output file
             ! and write length direct access file to file first
             !
             lunout = newlun(gdp)
             inquire (file = filout(:lflout), exist = ex)
             if (ex) then
                open (lunout, file = filout(:lflout))
                close (lunout, status = 'delete')
             endif
             open (lunout, file = filout(:lflout), form = 'formatted',          &
                  & access = 'direct', status = 'unknown', recl = mxlrec)
             irec = 1
             write (lunout, fmtbcc(1), rec = irec) '#', mxlrec, eol
          endif
          !
          ! Define table name
          !
          tablnm = 'T-serie BCC ' // nambnd(n) // '-' // namcon(l)              &
                  & // ' for run: '
          !
          ! Write first 7 description records to file
          !
          write (lunout, fmtbcc(2), rec = irec + 1) &
              & keywrd(1), quote, tablnm, runid, quote, eol
          write (lunout, fmtbcc(3), rec = irec + 2) &
              & keywrd(2), quote, tprofc(n, l), quote, cntain, eol
          write (lunout, fmtbcc(4), rec = irec + 3) &
              & keywrd(3), quote, nambnd(n), quote, eol
          write (lunout, fmtbcc(7), rec = irec + 4) &
              & keywrd(8), quote, 'non-equidistant', quote, eol
          write (lunout, fmtbcc(8), rec = irec + 5) keywrd(9), itdate, eol
          write (lunout, fmtbcc(9), rec = irec + 6) &
              & keywrd(10), quote, 'minutes', quote, eol
          write (lunout, fmtbcc(10), rec = irec + 7) &
              & keywrd(12), quote, 'linear', quote, eol
          !
          ! Write parameter name for time to file
          !
          npara = 1
          write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
              & keywrd(14), quote, parnam(1), quote, keywrd(15)(:10), quote, parunt(1),  &
              & quote, eol
          !
          ! Re-define parameter name for constituent L
          !
          parnam(2)(:20) = namcon(l)
          parunt(2) = '[    -   ]'
          if (parnam(2)(:8)=='salinity') parunt(2) = '[   ppt  ]'
          if (parnam(2)(:11)=='temperature') parunt(2) = '[   deg  ]'
          !
          ! Write parameter names for profile <uniform>
          !
          if (tprofc(n, l)(:7)=='uniform') then
             npara = npara + 1
             parnam(2)(21:) = ' end A uniform  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end B uniform  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
          !
          ! Write parameter names for profile <linear>
          !
          elseif (tprofc(n, l)(:6)=='linear') then
             npara = npara + 1
             parnam(2)(21:) = ' end A surface  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end A bed      '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end B surface  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end B bed      '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
          !
          ! Write parameter names for profile <step>
          !
          elseif (tprofc(n, l)(:4)=='step') then
             npara = npara + 1
             parnam(2)(21:) = ' end A surface  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end A bed      '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end B surface  '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2)(21:) = ' end B bed      '
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
             npara = npara + 1
             parnam(2) = 'discontinuity'
             parunt(2) = '[    m   ]'
             write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                 & keywrd(14), quote, parnam(2) , quote, keywrd(15)(:10), quote, parunt(2)  &
                 & , quote, eol
          !
          ! Write parameter names for profile <3d-profile>
          !
          elseif (tprofc(n, l)=='3d-profile') then
             do k = 1, kmax
                npara = npara + 1
                parnam(2)(21:) = ' end A layer    '
                write (parnam(2)(34:36), '(i3)') k
                write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                    & keywrd(14), quote, parnam(2), quote, keywrd(15) (:10), quote,  &
                    & parunt(2), quote, eol
             enddo
             do k = 1, kmax
                npara = npara + 1
                parnam(2)(21:) = ' end B layer    '
                write (parnam(2)(34:36), '(i3)') k
                write (lunout, fmtbcc(11), rec = irec + 7 + npara) &
                    & keywrd(14), quote, parnam(2), quote, keywrd(15) (:10), quote,  &
                    & parunt(2), quote, eol
             enddo
          else
          endif
          !
          ! Write number of time dependent data to file
          !
          write (lunout, fmtbcc(12), rec = irec + 8 + npara) &
              & keywrd(16), ntimrd, eol
          !
          ! Re-define IREC 8+NPARA description records forward
          !
          irec = irec + 8 + npara
          !
          ! Read step values (optional) & concentrations for all open
          ! boundaries and all constituents depending on TPROFC value
          !
          do nr = 1, ntimrd
             !
             ! Read time.
             !
             ibeg = 1
             call read1r(record    ,lrecrd    ,ibeg      ,iend      ,timrd     , &
                       & rdfaul    ,ier       )
             !
             ! Premature EOR (IER = 0) or empty value (IER = -1)
             !
             if (ier<=0) then
                error = .true.
                call prterr(lundia    ,'G007'    ,filbcc    )
                !
                write (lundia, '(a,a)') 'RECORD: ', record(:72)
                goto 9999
             endif
             !
             ! Re-defined time read (TIMRD ) in minutes
             !
             timrd = timrd*timscl
             !
             ! Perform some checks on time value read
             !
             sdt = dt*(tunit/60.0)
             call chckit(lundia    ,error     ,filbcc    ,timrd     ,sdt       , &
                       & ittdep    ,itold     ,itstrt    ,nr        ,gdp       )
             if (error) goto 9999
             !
             ! Read time dependent data depending on value of TPROFC
             !
             if (tprofc(n, l)=='3d-profile') then
                if (tprofc(n, l)/=tprofc(max(1, n - 1), l)) then
                   errmsg = '3d-profile must precede other type'
                   call prterr(lundia    ,'U021'    ,errmsg    )
                   error = .true.
                   goto 9999
                endif
                !
                ! KMAX values for 3d-profile open boundary point A
                !
                ibeg = iend + 1
                call readnr(record    ,lrecrd    ,ibeg      ,iend      ,kmax      , &
                          & rwbval(1, 1, n, l)   ,rdfaul    ,ier       )
                !
                ! Premature EOR (IER = 0) or empty value (IER = -1)
                !
                if (ier<=0) then
                   error = .true.
                   call prterr(lundia    ,'G007'    ,filbcc    )
                   write (lundia, '(a,a)') 'RECORD: ', record(:72)
                   goto 9999
                endif
                !
                ! KMAX values for 3d-profile open boundary point B
                !
                ibeg = iend + 1
                call readnr(record    ,lrecrd    ,ibeg      ,iend      ,kmax      , &
                          & rwbval(1, 2, n, l)   ,rdfaul    ,ier       )
                !
                ! Premature EOR (IER = 0) or empty value (IER = -1)
                !
                if (ier<=0) then
                   error = .true.
                   call prterr(lundia    ,'G007'    ,filbcc    )
                   write (lundia, '(a,a)') 'RECORD: ', record(:72)
                   goto 9999
                endif
             else
                !
                ! Other profiles for open boundary point A and B
                !
                nlook = 5
                if (tprofc(n, l)=='linear    ') nlook = 4
                if (tprofc(n, l)=='uniform   ') nlook = 2
                ibeg = iend + 1
                call readnr(record    ,lrecrd    ,ibeg      ,iend      ,nlook     , &
                          & rarray    ,rdfaul    ,ier       )
                !
                ! Premature EOR or empty value (IER = -1)
                !
                if (ier<=0) then
                   error = .true.
                   call prterr(lundia    ,'G007'    ,filbcc    )
                   write (lundia, '(a,a)') 'RECORD: ', record(:72)
                   goto 9999
                endif
                !
                ! Define NLOOK values to respective array's
                ! timscl introduced to make input of times more flexible
                !
                rwbval(1, 1, n, l) = rarray(1)
                if (tprofc(n, l)=='uniform   ') then
                   rwbval(1, 2, n, l) = rarray(2)
                else
                   rwbval(kmax, 1, n, l) = rarray(2)
                   rwbval(1, 2, n, l) = rarray(3)
                   rwbval(kmax, 2, n, l) = rarray(4)
                   if (tprofc(n, l)=='step      ') then
                      zstep(n, l) = rarray(5)
                   endif
                endif
             endif
             !
             ! Check for negative values
             !
             do k = 1, kmax
                if (rwbval(k, 1, n, l)<0.0) error = .true.
                if (rwbval(k, 2, n, l)<0.0) error = .true.
             enddo
             if (error) then
                write(errmsg,'(a,a)') 'Concentration at open boundary in ', trim(filbcc)
                call prterr(lundia    ,'V061'    ,errmsg)
             endif
             !
             ! If an NaN is read -> error
             !
             do k = 1, kmax
                if (isnan(rwbval(k, 1, n, l))) error = .true.
                if (isnan(rwbval(k, 2, n, l))) error = .true.
             enddo
             if (error) then
                write(errmsg,'(a,a)') 'Concentration at open boundary contains NaN in ', trim(filbcc)
                call prterr(lundia    ,'P004'    ,errmsg      )
             endif
             !
             ! Write time dependent data depending on value of TPROFU
             !
             if (tprofc(n, l)(:7)=='uniform') then
                fmtbcc(13)(8:10) = '  2'
                write (lunout, fmtbcc(13), rec = irec + nr) &
                    & timrd, rwbval(1, 1, n, l), rwbval(1, 2, n, l), eol
             elseif (tprofc(n, l)(:6)=='linear') then
                fmtbcc(13)(8:10) = '  4'
                write (lunout, fmtbcc(13), rec = irec + nr) &
                    & timrd, rwbval(1, 1, n, l), rwbval(kmax, 1, n, l), rwbval(1, 2, n, l),  &
                    & rwbval(kmax, 2, n, l), eol
             elseif (tprofc(n, l)(:4)=='step') then
                fmtbcc(13)(8:10) = '  5'
                write (lunout, fmtbcc(13), rec = irec + nr) &
                    & timrd, rwbval(1, 1, n, l), rwbval(kmax, 1, n, l), rwbval(1, 2, n, l),  &
                    & rwbval(kmax, 2, n, l), zstep(n, l), eol
             else
                write (fmtbcc(13)(8:10), '(i3)') 2*kmax
                write (lunout, fmtbcc(13), rec = irec + nr) &
                    & timrd, (rwbval(k, 1, n, l), k = 1, kmax), (rwbval(k, 2, n, l),  k = 1, kmax), eol
             endif
             !
             ! Re-define ITOLD and
             ! As long as NR < NTIMRD read new RECORD
             !
             itold = ittdep
             if (nr<=ntimrd - 1) read (lunrd, '(a)') record(:lrecrd)
          enddo
          !
          ! Re-define IREC NTIMRD records forward
          !
          irec = irec + ntimrd
          !
          ! Define maximum time
          !
          if (itold/= - 1) then
             if (itold < itfinish) then
                write(errmsg,'(a,a,a,a,a)') 'Last time in file ', trim(filbcc), ' for section #',trim(nambnd(n)),'# <'
                call prterr(lundia    ,'U042'    ,errmsg)
                error = .true.
                goto 9999
             endif
          endif
       enddo
    enddo
    !
    ! stop reading file
    !
 9999 continue
    deallocate(rwbval)
    deallocate(zstep)
    deallocate(tprofc)
end subroutine rdtdcn


text:
      SUBROUTINE CONV_GEO_CRD(LATIN,LONIN,HEIGHT,
     $             LATOUT,LONOUT,IFLAG,IERROR)
c  ------------------------------------------------------------------------
c  Part of "poa_calfos" (STECF/IPMG)
c  Part of "NEWBILCAL" program to produce IGRF geomagnetic model (GSFC)
c
c  History:
c  --------
c  Version   Date        Author          Description
c      1.0       Jul 00  M. Rosa         POA calibration code
c  ------------------------------------------------------------------------
C
C Here comes a subroutine from SuperDARN to compute Altitude-corrected
C geomagnetic coordinates
C
C How do I convert a geographic position to AACGM (or vice versa)?
C There are two ways to do this. The direct call to the new AACGM software is:
C
C [in FORTRAN]
C       CALL CONV_GEO_CRD(x_in_lat, x_in_long, x_height,
C                         x_out_lat, x_out_long, i_flag, i_err)
C where:
C   x_in_lat  =  input latitude (in degrees)(real single precision)
C   x_in_long =  input longitude (in degrees) (real single precision)
C   x_height  =  input altitude (in km) (real single precision)
C   x_out_lat =  returned magnetic latitude (real single precision)
C   x_out_long = returned magnetic longitude (real single precision)
C   i_flag    =  1 (32-bit integer) [flag indicating geo->AACGM conversion]
C   i_err     =  returned integer error code (0 = OK)
C
C latitude must be in the range -90 to +90.
C longitude must be in the range 0 to 360
C height must be in the range 0 to 2000
C out_lat is returned in the range -90 to + 90
C out_long is returned in the range 0 to 360
C i_flag must be 1 (geo->AACGM) or 2 (AACGM->geo)
C i_err (see below)
C
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
C     Purpose:
C
C         This subroutine uses a set of spherical harmonic coefficients to
C         perform a coordinate conversion between geographic and corrected
C         geomagnetic coordinates (or vice versa).
C
C         The spherical harmonics for the geographic to corrected geomagnetic
C         coordinate system correspond to a conversion from geographic to
C         the corrected geomagnetic coordinates (expressed in terms of
C         centered dipole coordinates at the input altitude), and are then
C         transformed to ground level.
C
C         The spherical harmonic coefficients used for the inverse are
C         computed relative to centered dipole coordinates at the input
C         altitude. The input CGM coordinates are converted to equivalent
C         values in this coordinate sytem using the inverse altitude
C         algorithm before the evaluation of the geographic spherical
C         harmonic expansion.
C
C     Method:
C
C         This subroutine uses a five-step process in converting a position
C         in one coordinate system to a position in the other.
C         The five steps are as follows:
C
C         1.  The appropriate spherical harmonic coefficients for the
C             coordinate conversion are computed for the input altitude.
C
C         2.  The appropriate coordinates for use in the spherical harmonic
C             expansion are computed. For the geographic ==> corrected
C             geomagnetic coordinate version, these are geographic colatitude
C             and longitude. For the inverse coordinate conversion, the
C             input coordinates are first converted into equivalent dipole
C             coordinates at the input altitude.
C
C         3.  The Cartesian coordinates of the unit vector in the desired
C             coordinate system are then computed using the appropriate
C             spherical harmonic expansion.
C
C         4.  For the geographic ==> corrected geomagnetic coordinate
C             conversion, the dipole-equivalent coordinates at input
C             altitude are converted to their cgm cartesian coordinates.
C
C         5.  Standard trigonometric identities are used to compute the
C             latitude and longitude in the desired output coordinate system.
C
C     Input Arguments:
C
C         LATIN        - REAL*4 - The input latitude in degrees.
C                        This could be either geographic latitude
C                        or corrected geomagnetic latitude.  The
C                        acceptable range of values is (-90 to +90
C                        degrees).
C
C         LONIN        - REAL*4 - The input longitude in degrees east.
C                        This could be either geographic longitude
C                        or corrected geomagnetic longitude.  The
C                        acceptable range of values is (0 to 360 degrees).
C
C         HEIGHT       - REAL*4 - The height in kilometers for which the
C                        coordinate transformation will be accomplished.
C                        The acceptable range of values is (0 km to
C                        2000 km)
C
C         IFLAG        - INTEGER - The flag that indicates which way
C                        the conversion will proceed.
C
C                        = 1  convert geographic to corrected
C                                 geomagnetic coordinates
C
C                        = 2  convert corrected geomagnetic
C                                 to geographic coordinates
C
C     Output Arguments:
C
C         LATOUT      - REAL*4 - The output latitude in degrees.
C                       This could be either the geographic latitude
C                       or corrected geomagnetic latitude.  This
C                       value will be between -90 and +90 degrees.
C
C         LONOUT      - REAL*4 - The output longitude in degrees.
C                       This could be either geographic longitude or
C                       corrected geomagnetic longitude.  This
C                       value will be between 0 and 360 degrees.
C
C         IERROR      - INTEGER - The error flag
C
C                       =  0  normal processing
C                       = -2  R_HEIGHT_IN is outside the allowable range
C                       = -4  I_FLAG value is invalid
C                       = -8  R_LAT_IN is outside the allowable range
C                       = -16 R_LON_IN is outside the allowable range
C                       = -32 Magnitude of the "unit vector" of the
C                             target coordinate system deviates
C                             significantly (+/- 10% or more) from 1.
C                       = -64 For altitudes > 0, for the corrected
C                             geomagnetic to geographic coordinate
C                             conversion there is a range of latitudes
C                             for which the transformation is invalid.
C                             This flag is set when the requested input
C                             cgm latitude falls within the invalid
C                             region.
C
C     Local Variables:
C
C         DCINT(,,)       - Double Precision Array (3-D) -
C                            Contains the spherical harmonic coefficients
C                            interpolated to the input height, R_HEIGHT_IN.
C
C         DCOEF(,,,)      - Double Precision Array (3-D) -
C                            Contains the spherical harmonic coefficients
C                            used to compute the Cartesian coordinates of
C                            unit vector in the target coordinate system.
C
C                            First index: sp. harm. coeff. index
C                            Second       x, y, z components of unit vector
C                            Third        altitude indices 0, 300, 1200 km
C                            Fourth       direction of conversion index
C
C                            coefficients for a given altitude have the form
C
C                            a0 + h a1 + h * h a2 where h = alt/1000 [km]
C
C         DCOLTEMP         - Double Precision - colatitude (radians) in the
C                            input coordinate system
C
C         DLONTEMP         - Double Precision - longitude (radians) in the
C                            input coordinatesystem
C
C         DX,DY,DZ         - Double Precision - the XYZ-components of the
C                            unit radius vector in target coordinate system
C
C         DR               - Double Prec unit radius in target coord system
C
C         DYLMVAL          - Double Precision - the array of spherical
C                            harmonic basis functions evaluated at
C                            a particular colatitude and longitude.
C
C         IERR64           - Logical - error flag of CGM2ALT routine
C
C         K,L,M            - Integer  indices of spherical harmonic functions
C
C         HEIGHTOLD(2)     - Real*4 Array  - Variable containing
C                            previous height (km) used to determine whether
C                            the interpolation to compute DCINT() from
C                            DCOEF() needs to be done.
C
C         LATADJ           - Real*4 - result of ALT2CGM or CGM2ALT conversion.
C
C         LATALT           - Real*4 - altitude at dipole latitude.
C
C         RR               - Real*4 - magnitude of unit vector (DR in float)
C
C     Constants:
C         NAXES       - Integer  - the number of axes in a Cartesian
C                            coordinate system (3)
C         NFLAG       - Integer  - the number of coordinate trans-
C                            formation flags available (2)
C         NLEVEL      - Integer  - the number of grid levels
C                            available.  This is the number of
C                            distinct heights for which there are
C                            spherical harmonic coefficients available
C         IORDER          - Integer  - the order of the spherical harmonic
C                            expansion used.
C
C         DEGRAD           - Double Precision  - the multiplicative
C                            conversion factor for converting degrees
C                            to radians
C
C         PI               - Double Precision  - mathematical constant
C
C     Subroutines Required:
C
C         RYLM              - This subroutine returns the spherical harmonic
C                            function value array for a given colatitude and
C                            longitude.  The spherical harmonics are returned
C                            in the D_YLMVAL array.
C
C         CG_ALT_DIP       - Given altitude (km), latitude, and a direction
C                            flag, returns altitude corrected latitude, and
C                            an error flag. See comments in subroutine for
C                            additional information.
C
C     Files Used at Compile Time:
C     Files Used at Run Time:  None
C     Databases Accessed:  None
C
C     Warnings:
C
C     1. For certain values of Corrected Geomagnetic Coordinates, the
C        transformation to Geographic Coordinates (Geocentric) is
C        undefined. When this situation occurs, an error flag is set
C        IERROR = -64 and returned to the calling routine.
C
C     Revision History:
C        Original Routine was converted to a standard library
C        subroutine for SFC$$ by MFS on  14 OCT 1992.
C
C     09/17/93 SPR1993-0203 (SWS) The return condition value needs to
C             be initialized before coordinate conversion processing begins
C
C     08/18/93 SPR1993-0175 (SWS) Routine performed a comparison of
C             Z with a -1.D0. The variable Z should be D_Z.
C
C     The present routine represents the use of an improved algorithm for
C     the computation of corrected geomagnetic coordinates and (where
C     it exists) the inverse, together with the use of an updated
C     magnetic field model (IGRF 1995).
C
C     The present routine incorporates the functionality of the previous
C     routine, and, uses the same subroutine calls. Relevent portions of
C     the old FORTRAN code have been retained where possible.
C
C     The new algorithm and the current code have been developed by
C     Radex, Inc, 3 Preston Court, Bedford, MA 01730. A technical
C     report describing the improved algorithm, and discussing its
C     limitations is in preparation, and will be published as a
C     Philips Laboratory technical report entitled:.
C
C     An Improved Algorithm for the Computation of Corrected Geomagnetic
C     Coordinates, by K. Bhavnani and C. Hein.
C
C     The principal changes implementing the new algorithm and code are
C     as follows:
C
C        (1) The set of spherical harmonic function values are computed
C            recursively using a single call to a new subroutine RYLM
C            rather than using repetitive function call.
C
C            Computationally this method is much faster than computing
C            each of the spherical harmonics as they are needed.
C
C        (2) The new spherical harmonic coefficients are based upon
C            the IGRF 95 magnetic field model. The order of the
C            spherical harmonic expansion used here is 10 (previously
C            was 4).
C
C        (3) The coefficients represent a quadratic fit to the spherical
C            harmonic fits at 0, 300 and 1200 km altitude. The allowable
C            range of altitudes is 0 - 2000 km. The previous version used
C            polynomial interpolations of the coefficients at 0, 150,
C            300 and 450 km.
C
C        (4) The spherical harmonic coefficients were computed in an
C            auxilliary coordinate system, which is aligned with the
C            desired target coordinate system. This results in a
C            considerable simplification of the code, eliminating the
C            need to perform multiple coordinate system rotations.
C
C     17/07/95
C
C     MODIFIED FOR THE IGRF 95 MAGNETIC FIELD MODEL.
C
C     CHANGES: BLOCKDATA SECTION HAS BEEN REPLACED WITH COEFFICIENTS
C              APPROPRIATE FOR THE IGRF 1995 MODEL
C
C              REFERENCES TO IGRF 90 IN THE COMMENT LINES HAVE BEEN
C              CHANGED TO IGRF 95.
C
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c   RCS revision log for POSIX systems
c
c $Log: conv_geo_crd.f,v $
c Revision 1.1.1.1  2000/07/12 19:25:10  ecf-poa
c stpoa branch with a close version to the first release
c
c Revision 2.2  2000/07/11 12:26:29  aalexov
c Updated all the code to have a history (new history for poa
c code) and appended a history for calfos files which were
c updated by us.  Also deleted .f files from the reposutory
c which were no longer being used (cleaning up).
c
c Revision 2.1  2000/07/10 19:06:37  aalexov
c These are Michael's changes, for the release.  Comments were
c added for the headers of all poa new files.  Also, new files
c were created in order to make sure that all subroutines were
c in their own files.  mkpkg was updated to look "clean".
c
c Revision 2.0  2000/05/02 14:52:02  mrosa
c Re-delivery of POA_calfos from April 5, 2000
c
c Revision 1.1  1999/12/07 13:22:58  aalexov
c updates to calfos using Michael Rosa's flight software code and
c POA code;  data files are now preprocessed with additions of new
c group parameter keywords which are updated (per group) using these
c new code additions.  the new pieces of code calculate the
c hst positions, velocities, geomagnetic vectors and pixel offsets in
c x and y;  the code places these new values in the new header keywords.
c the results are also printed to the screen.  new "calibration" tables
c are used (norad and dgrf files).
c
c Revision 1.6  1996/03/20  22:53:03  baker
c Explicitly declared the sizes of the arguments to the
c subroutine.  This should help avoid compatibility
c problems when mixing C and Fortran with different
c machines and different compilers.
c
c Revision 1.5  1996/03/12  18:59:18  baker
c Added code to force a recomputation of the
c conversion coefficients at a given ghheight if the
c coordinates model has changed from the last call.
c
c Revision 1.4  1996/03/11  19:25:36  baker
c Modifications for the 1995 version of AACGM.
c
c Revision 1.3  94/10/17  12:35:32  12:35:32  baker (Kile Baker S1G)
c added error code -64 to indicate invalid magnetic coordinates specified
c as input.  This also requires a change in the call to cg_alt_dip
c
c Revision 1.2  94/10/14  10:53:36  10:53:36  baker (Kile Baker S1G)
c Added the SAVE instruction to make variables static
c
c Revision 1.1  94/10/12  15:28:38  15:28:38  baker (Kile Baker S1G)
c Initial revision
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      IMPLICIT NONE
      SAVE    !make all variables static
C
      INTEGER IORDER,IERROR,IFLAG,NTERMS,NAXES,NLEVEL,NFLAG

      REAL*8 DCINT(121,3,2)
      REAL*8 DCOEF(121,3,3,2)
      REAL*8 DYLMVAL(121)
c
      REAL*8 DCOLTEMP,DLONTEMP
      REAL*8 COLATI,COLATO,DLONI,DLONO
      REAL*8 DX,DY,DZ,DR
      REAL*8 PI, DEGRAD
      REAL*8 FCOEFFOLD

      REAL*4 HEIGHT,LATIN,LONIN,LATOUT,LONOUT,LATADJ,LATALT
      REAL*4 HEIGHTOLD(2)
      REAL*4 altvar, altvarsq,rr
      INTEGER i,j,k,l,m
      LOGICAL       IERR64
C
      COMMON /IGRCOEFF/ DCOEF

      DATA IORDER /10/      ! Set the order used in this algorithm to 10.
C         Parameterize the maximum values of the indices of the
C         spherical harmonic coefficient array D_COEF( , , , ) and the
C         interpolated spherical harmonic coefficient array, D_CINT( , , ).
      DATA NTERMS,NAXES,NLEVEL,NFLAG /121,3,3,2/
c      REAL*8 DCINT(NTERMS,NAXES,NFLAG)
c      REAL*8 DCOEF(NTERMS,NAXES,NLEVEL,NFLAG)
c      REAL*8 DYLMVAL(NTERMS)
      DATA PI /3.141592656589793D0/
      DATA DEGRAD /1.745329251994330D-2/
      DATA HEIGHTOLD,FCOEFFOLD/-1.,-1.,-1.D0/ !Initialize to impossible values.
C
C     The COMMON block / SPH_HARM_MODEL / array D_COEF contains
C     the spherical harmonic coefficients used to generate the
C     Cartesian coordinates of the unit vector in the target coordinate
C     system.  The target coordinate system is the system to which
C     the algorithm is converting and is the coordinate system
C     corresponding to the output variables, R_LAT_OUT and R_LON_OUT.
C
C     The coefficient set is stored in a 4-dimensional array with
C     indices defined as follows:
C
C         First Index  - Represents the number of terms used in the
C                        spherical harmonic expansion. Equal to
C                        (I_ORDER + 1) * (I_ORDER + 1)
C
C         Second Index - Represents the Cartesian coordinate a particular
C                        coefficient will be used to generate.  Indices are
C                        defined as follows:
C
C                        1  - X-coordinate (the X-axis points from the
C                             center of the earth to where the prime
C                             meridian crosses the equator.
C
C                        2  - Y-coordinate (the Y-axis points from the
C                             center of the earth to 90 degrees east
C                             of the X-axis)
C
C                        3  - Z-coordinate (the Z-axis points from the
C                             center of the earth to the north pole)
C
C         Third Index  - Represents the terms of a quadratic fit to
C                        altitude (independent variable h =
C                        altitude [km]/1200) for a given spharical
C                        harmonic coefficient. The indices are defined
C                        as follows:
C
C                        1  - Constant term: corresponds to the fit at
C                             0 km altitude
C                        2  - linear term
C                        3  - quadratic term
C
C         Fourth Index - Represents the direction of the coordinate
C                        transformation.  Indices are defined as follows:
C
C                        1  - Conversion of geographic coordinates to
C                             corrected geomagnetic coordinates.
C
C                        2  - Conversion of corrected geomagnetic coordinates
C                             to geographioc coordinates.
C
C
C     The Data for D_COEF is provided in a BLOCK DATA file (see below)
c
C     Initialize the error return condition indicator
      IERROR = 0
      PI = 4.0D0*DATAN(1.0D0)

C
C This IF statement checks to see if the magnetic
C     coordinates model has been changed.  If so, we
C     have to force the recalculation of the conversion
C     coefficients, by resetting the values of the old height
      IF ( FCOEFFOLD .NE. DCOEF(1,1,1,1)) THEN
         HEIGHTOLD(1) = -1
         HEIGHTOLD(2) = -1
      ENDIF
      FCOEFFOLD = DCOEF(1,1,1,1)
C
C Checkin input arguments to ensure they are within allowable ranges.
      IF ((HEIGHT .LT. 0.) .OR. (HEIGHT .GT. 2000.)) THEN
C     The height in kilometers is outside the allowable range.
        IERROR = -2
        RETURN
      ELSEIF ((IFLAG .LT. 1) .OR. (IFLAG .GT. 2)) THEN
C     The conversion flag is neither 1 nor 2.
        IERROR = -4
        RETURN
      ELSEIF (ABS(LATIN) .GT. 90.) THEN
C     The latitude is outside the allowable range.
        IERROR = -8
        RETURN
      ELSEIF ((LONIN .LT. 0.) .OR. (LONIN .GT. 360.)) THEN
C     The longitude is outside the allowable range.
        IERROR = -16
        RETURN
      ENDIF
C All input arguments are within allowable ranges.
C
C Compute Spherical Harmonic Coefficients for current altitude if required
      IF (HEIGHT .NE. HEIGHTOLD(IFLAG)) THEN
        ALTVAR    = HEIGHT/1200.0
        ALTVARSQ  = ALTVAR * ALTVAR
        DO 20 I = 1, 3
         DO 10 J = 1, 121
           DCINT(J,I,IFLAG) = DCOEF(J,I,1,IFLAG) + ALTVAR *
     $     DCOEF(J,I,2,IFLAG) + ALTVARSQ *  DCOEF(J,I,3,IFLAG)
 10        CONTINUE
 20     CONTINUE
        HEIGHTOLD(IFLAG) = HEIGHT
      ENDIF
C
C Zero Sums for Spherical Harmonic Expansion Computation
      DX = 0.0D0
      DY = 0.0D0
      DZ = 0.0D0
C
C Prepare for Spherical Harmonic Expansion Computation
      DLONI   = DBLE(LONIN) * DEGRAD
      IF (IFLAG .EQ. 1) THEN
C     Computing CGM from Geographic Coordinates. No altitude
C     correction required
        COLATI = (90.0D0 - DBLE(LATIN)) * DEGRAD
      ELSE
C     Computing Geographic Coordinates from CGM Coordinates.
C     Convert CGM Latitude to Dipole Latitude at Altitude HEIGHT
        CALL CGM2ALT(HEIGHT,LATIN,LATADJ,IERR64)
        IF (IERR64 .EQV. .TRUE.) THEN
            IERROR = -64
            RETURN
        ENDIF
        COLATI = (90.0D0 - DBLE(LATADJ)) * DEGRAD
      ENDIF
C
C Generate the spherical harmonics at the coordinate point
      CALL RYLM(COLATI,DLONI,IORDER,DYLMVAL)
C
C Calculate cartesian coordinates of unit vector in target coordinate system.
      DO 40 L= 0, IORDER
        DO 30 M = -L, L
          K = L * (L + 1) + M + 1
C         Add the contribution of each spherical harmonic to the
C         Cartesian components of the unit vector in the
C         appropriate coordinate system.
          DX = DX + DCINT(K,1,IFLAG) * DYLMVAL(K)
          DY = DY + DCINT(K,2,IFLAG) * DYLMVAL(K)
          DZ = DZ + DCINT(K,3,IFLAG) * DYLMVAL(K)
 30     CONTINUE
 40   CONTINUE
C
C Compute magnitude of Cartesian unit vector of magnetic dipole coord system.
      DR = SQRT(DX * DX + DY * DY + DZ * DZ)
C       If the magnitude of the unit vector differs significantly
C       from 1, set the error flag and continue processing.
        IF ((DR .LT. 0.9D0) .OR. (DR .GT. 1.1D0)) THEN
          RR = SNGL(DR)
          IERROR = -32
          RETURN
        ENDIF
C
C Adjust the components so they do represent the components of
C       a unit vector.  If DR is equal to 1.0D0, this step will not
C       change the values of D_X, D_Y, or D_Z.
        DZ = DZ / DR
        DX = DX / DR
        DY = DY / DR
C
C Obtain output co_latitude and longitude from the unit
C           vector using standard formulas
        IF (DZ .GT. 1.0D0) THEN
          DCOLTEMP = 0.0D0
        ELSE IF (DZ .LT.- 1.0D0) THEN
          DCOLTEMP = PI
        ELSE
          DCOLTEMP = DACOS(DZ)
        ENDIF
c
        IF ((ABS(DX) .LT. 1.0D-8) .AND. (ABS(DY) .LT. 1.0D-8)) THEN
          DLONTEMP = 0.0D0
        ELSE
          DLONTEMP = DATAN2(DY,DX)
        ENDIF
C
C Prepare Latitude Data for Output
       DLONO   = DLONTEMP
       IF (IFLAG .EQ. 1) THEN
         LATALT = 90.0 - DCOLTEMP/DEGRAD
         CALL ALT2CGM(HEIGHT,LATALT,LATADJ)
         COLATO = (90.0D0 - DBLE(LATADJ)) * DEGRAD
       ELSE
         COLATO = DCOLTEMP
       ENDIF
C
C Convert colatitude into latitude and convert both coordinates
C     from REAL*8 radians to REAL degrees.
      LATOUT = SNGL(90.0D0 - COLATO / DEGRAD)
      LONOUT = SNGL(DLONO / DEGRAD)
      IF (LONOUT .LT. 0.0) LONOUT = LONOUT + 360.
C
      RETURN
c90    FORMAT(' INVERSE UNDEFINED AT CGM LAT ',F6.2,' CGM LON ',F7.2,
c     $ ' ALTITUDE ',F8.2)
      END

max_stars_repo_name: iraf-community/stsdas


text:
http://citizenswhocare.us/Beer.html Beerfest is an annual fundraiser for Citizens who Care.

Beer Fest 2007 is titled A Celebration of All Things Beer
It will be held on June 2, 2007 from 2  5 PM at Sudwerk
Tickets are $25 at the door and include unlimited tastings.
For more information goto http://citizenswhocare.us/Beer.html

20070530 13:32:18 nbsp Thanks for creating the page. Please add this years beerfest to the events board. Users/ArlenAbraham


text:
      MODULE fndbeg_I
      INTERFACE
!...Generated by Pacific-Sierra Research 77to90  4.3E  11:01:42   1/ 5/07
!...Modified by Charlotte Froese Fischer
!                     Gediminas Gaigalas  10/05/17
      SUBROUTINE fndbeg (JASTRT, JBSTRT, INDEX, LLISTT, LLISTV)
      INTEGER, INTENT(INOUT) :: JASTRT
      INTEGER, INTENT(INOUT) :: JBSTRT
      INTEGER, INTENT(INOUT) :: INDEX
      INTEGER, INTENT(OUT) :: LLISTT
      INTEGER, DIMENSION(:), pointer :: LLISTV
      END SUBROUTINE
      END INTERFACE
      END MODULE

max_stars_repo_name: sylas/grasp-continuum

max_issues_repo_name: sylas/grasp-continuum

max_forks_repo_name: sylas/grasp-continuum


text:
Campus Munchies is like an online convenience store which delivers. They carry much more than munchies. Their aisles are: snacks, food, drinks, candy/gum, ice cream, drug store & supplies. A bit of everything. They do have refrigerated items such as milk and eggs, but do not have hot prepared items such as pizza. Prices seem to be slightly higher than places like Albertsons/Safeway. Their warehouse is in Davis and they deliver anywhere within city limits. Delivery is in about an hour and the minimum is $2.99. They were started by students.

20051128 20:13:21 nbsp 20051128 California Aggie ad says Get 5% today! Use coupon code: CM5 Users/SteveDavison

20051128 20:14:20 nbsp They apparently have specials on slow days, today their web site says RAINY DAY SPECIAL! All orders today will get 25% OFF on Checkout!. Users/SteveDavison

20051207 23:38:39 nbsp I talked to the proprietor tonight, 12/7/05, he was cool. They are looking at expanding into booze. They seem to be based out of Olive Drive Market, (great place.) If you need chips and soda, Id give these guys a try. If they can manage to pull off the cigarette&booze delivery, they will be unstoppable.  Users/ChrisLambertus

20060503 14:17:58 nbsp These guys are awesome, just need to advertise more! Users/KevinPatterson

20060503 16:01:38 nbsp Will these guys deliver on campus?  I know a lot of delivery places like Woodstocks wont step foot on UCD property... Users/LeightonHinkley

20070207 15:17:20 nbsp Anyone know what happened to these guys? Users/LeightonHinkley


text:
There are 12 bridges crossing the Arboretum Waterway arboretum waterway.  If a wikier were feeling industrious, he or she might visit each bridge and then describe here the foliage in the different areas (e.g. the Redwood Bridge section below says that its in the Redwood Grove section of the Arboretum).

The following names are suggestive and not authoritative.  As far as we know, these bridges do not have official names!

 Easternmost Foot Bridge
This first bridge is similar in style to several of the other foot bridges. It is close to the Davis Commons

 Old Bridge (1919)

Before the A Street bridge was put in this was the main traffic bridge for cars and wagons. It connected Davisville to the immediately adjacent Tremont Tremont Township to the south, and by extension, it accessed the wagon road that eventually branched off towards Sacramento in the east and Benicia to the west. This road was an early form of Old Davis Road. Following the creation of the arboretum, the road layout has since changed, and the bridge now mainly serves foot and bike traffic from Solano Park apartments to UCD parking lot #10, although grounds crews also drive across from time to time.  According to the keystone, the bridge was built in 1919, but county maps show an earlier version of the bridge in existence since at least 1900. It did not seem to have an official name; it was simply labeled bridge or given no label whatsoever on maps.

When the bridge was finally built, it came far too late for many Tremont residents who had been fording the Putah Creek for decades. According to historian David Vaught in his book, http://books.google.com/books?idVMurtYK_wOgC&lpgPP1&dqgold%20rush%20%20vaught&pgPP1#vonepage&q&ffalse After the Gold Rush, Tremont residents often could not ford the canal for weeks on end after a bad storm, which meant that to get to Davisville, they had to ride several miles to Dixon across the soggy prairie and then take the train. Their repeated cries for a public bridge fell on deaf ears, as the Solano Board of Supervisors continued its tradition of refusing to spend even a dime on these outlying residents while gladly taking their tax dollars. As late as 1897, Tremont farmers were still trying to secede from their county to escape the clutches of the VallejoFairfield ring that oppresses us.

Although on some old maps it may appear as though the bridge connected directly to University Avenue, this was not the case; University Avenue always terminated a block to the north of the bridge; however, there was an alleyway that continued on through Rice Lane, ending up near the bridge. The only major street in Davis that connected to the bridge was Front Street, now known as 1st Street.

The keystone of this bridge was the subject of a shortlived Mystery Picture/History Mystery Picture..

 A Street Bridge
Under this bridge youll find a A Street Bridge Mural mural painted by UCD entomology students.

 Redwood Bridge

This bridge no longer exists.  It once connected the T. Elliot Weier Redwood Grove Arboretum Redwood Grove to the Art Buildings, but it was removed in late 2010/early 2011.  If you try and cross here now, youll just fall into the creek and turn into a mutant.  :(

 Concrete Spafford Bridge
The most spartan and functional off all the nonvehicle bridges. If it were not for steep approaches on both banks it would be nicely Mobility Impaired Access accessible.

 Wooden Spafford Bridge

 Mrak Hall Bridge
The vehicle approach to Mrak Hall. There is only a path on the north side of the arboretum here, and bikes should not be ridden on the narrow path.

 Mondavi Foot Bridge
This bridge predates the Mondavi Center by many years. It is also near King Hall.

 California Avenue Bridge
Part of the UC Davis Loop, located south of Academic Surge. There are signs about bats and signs that suggest you walk your bike under the bridge.

 Cole Facility Foot Bridge

 Earth Bridge

 Lodge Bridge
This is one of the more striking bridges when it is painted and in good repair.

Also see:
  Bike Bridges

20050505 00:11:45 nbsp These pictures are absolutely beautiful!  I didnt realize how many bridges there actually are, or that they all had names (unless you named them yourself).  Nice documentation and photos! Users/KalenRidenour

20080807 22:03:13 nbsp What kind of camera was used to take these pictures?  They are incredible... Users/SunjeetBaadkar
  Jason took most of them, but I think hes a pretty good photographer regardless of what camera he uses (also I dont know what he uses).  My few photos were taken with a Fuji A700, the same camera used by National Geographic photographers (not).

20081001 12:05:39 nbsp I have observed bats emerging from the bottom of the mrak hall bridge Users/ChrisWaterstraat

20081010 20:37:09 nbsp ^ when did u see the bats? ive been looking everywhere but i cant find any... Users/itsedmondfoo


text:
module algorithms_api
    use :: matrix_multiplication_api, only : &
            matrix_multiplication, &
            matrix_multiplication_factory, &
            mm_initialize, &
            mm_finalize

    use :: tensor_permute_api, only : &
            tensor_permute, &
            tensor_permute_factory, &
            tp_initialize, &
            tp_finalize

    use :: tensor_contraction_api, only : &
            tensor_contraction, &
            tensor_contraction_factory, &
            tc_initialize, &
            tc_finalize
    use :: easy_tensor_contraction_interface, only : contract

    use :: tensor_update_api, only : &
            scalar_inline_update, &
            tensor_update_factory, &
            tu_initialize, &
            tu_finalize

    use :: batched_matrix_multiplication_api, only : &
            batched_matrix_multiplication, &
            batched_matrix_multiplication_factory, &
            bmm_initialize, &
            bmm_finalize

    use :: batched_tensor_permute_api, only : &
            batched_tensor_permute, &
            batched_tensor_permute_factory, &
            btp_initialize, &
            btp_finalize

    use :: batched_tensor_contraction_api, only : &
            batched_tensor_contraction, &
            batched_tensor_contraction_factory, &
            btc_initialize, &
            btc_finalize

    implicit none
    public
end module algorithms_api

max_stars_repo_name: cheshyre/ntcl-algorithms

max_issues_repo_name: cheshyre/ntcl-algorithms

max_forks_repo_name: cheshyre/ntcl-algorithms


text:
! MIT License
!
! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!
! FTObjectLibrary contains code that, to the best of our knowledge, has been released as
! public domain software:
! * `b3hs_hash_key_jenkins`: originally by Rich Townsend,
! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
!
! --- End License

!
!////////////////////////////////////////////////////////////////////////
!
!      Constants.f90
!      Created: June 12, 2013 2:54 PM
!      By: David Kopriva
!
!////////////////////////////////////////////////////////////////////////
!
!> Defines constants to be used by the library
!

      Module FTOLConstants
         IMPLICIT NONE
         INTEGER, PARAMETER :: FT_ORDERED_ASCENDING = 1, FT_ORDERED_DESCENDING = -1, FT_ORDERED_SAME = 0
         INTEGER, PARAMETER :: QUAD_DIGITS = 30
      END Module FTOLConstants

max_stars_repo_name: HigherOrderMethods/FTObjectLibrary

max_issues_repo_name: HigherOrderMethods/FTObjectLibrary

max_forks_repo_name: HigherOrderMethods/FTObjectLibrary


text:
      SUBROUTINE BPASS(FL,FH,FILT,NPTS,SI,SCR)
C    BPASS1 GENERATES A ZERO PHASE TIME DOMAIN FILTER.  THE IMPULSE RESPONSE
C WILL HAVE AN ENERGY OF 1., THUS ALLEVIATING SCALING PROBLEMS DUE TO DIFFERENT
C BANDWIDTHS.
C    THE DESIGN IS DONE IN THE TIME DOMAIN AND IS THE SHORTEST AND SIMPLEST,
C BUT IS NOT AS GOOD (STEEPNESS OF CUT OFF) AS SOME OPTIMIZING METHODS.
C THE FILTER IS BETTER THE MORE POINTS IT HAS, AND IS WORSE THE LESS POINTS IT
C HAS.  39 POINTS IS A NICE NUMBER
C    THE METHOD OF DESIGN IS:
C   1) GENERATE A COSINE AT A FREQUENCY W1 WHICH IS HALFWAY BETWEEN THE CUTOFF
C     IN THE FREQUENCY DOMAIN THIS IS A SPIKE AT FREQUENCY W1.
C   2) MULTIPLY 1 BY A SINC FUNCTION OF FREQUENCY WC WHICH IS HALF THE BANDWIDTH
C     IN THE FREQUENCY DOMAIN THIS IS CONVOLVING 1 WITH A BOX CAR.
C   3) MULTIPLY THE RESULT BY A WINDOW TO PREVENT DISCONTINUITIES.  IN THE
C     FREQUENCY DOMAIN THIS IS CONVOLVING THE BOX CAR WITH A SMOOTHING FUNCTION.
C
C  ARGUMENTS:
C      FL     - THE FREQUENCY OF THE LOW CORNER
C      FH     - THE FREQUENCY OF THE HIGH CORNER
C      FILT   - THE ARRAY TO RECEIVE THE TIME DOMAIN FILTER POINTS.
C      NPTS   - THE NUMBER OF FILTER POINTS WANTED
C      SI     - THE SAMPLE INTERVAL IN SECONDS
C      SCR    - A SCRATCH ARRAY AT LEAST NPTS/2+1 LONG
C
C
C  WRITTEN AND COPYRIGHTED BY:
C  PAUL HENKART, SCRIPPS INSTITUTION OF OCEANOGRAPHY, FEBRUARY 1979
C  ALL RIGHTS ARE RESERVED BY THE AUTHOR.  PERMISSION TO COPY OR REPRODUCE THIS
C  SUBROUTINE, BY COMPUTER OR OTHER MEANS, MAY BE OBTAINED ONLY FROM THE AUTHOR.
c  mod 6 Oct 09 - hange the documentation - sample interval, not sample rate.
c
      DIMENSION FILT(*),SCR(*)
      PI2=6.283197
      N=NPTS/2+1                                                         /* THE CENTRE POINT OF A ZERO PHASE FILTER
      W1=(FL+FH)/2.                                                     /* FIND THE CENTRE FREQUENCY
      WC=(FH-FL)/2.                                                     /* THE WIDTH OF THE BANDPASS
C****
C****    GENERATE A COSINE WAVE
C****
      P=1./W1/SI
      DO 100 I=1,N
  100 SCR(I)=COS(FLOAT(I-1)/P*PI2)
C****
C****   MULTIPLY BY A HALF SINC
C****
      P=1./WC/SI
      SCR(1)=1.
      DO 200 I=2,N
      X=FLOAT(I-1)/P*PI2
  200 SCR(I)=SCR(I)*SIN(X)/X
C****
C****     MULTIPLY BY A GOOD WINDOW  ( HAMMING)
C****
      CALL WINDOW(-6,FILT,N,DUM)
      DO 300 I=1,N
  300 SCR(I)=SCR(I)*FILT(N-I+1)
C****
C****      NOW MAKE A SYMMETRICAL FILTER OUT OF IT
C****
      DO 400 I=1,N
      FILT(I)=SCR(N-I+1)
      FILT(N+I-1)=SCR(I)
  400 CONTINUE
C****
C****        MAKE THE FILTER HAVE AN ENERGY OF 1.
C****
      E=0.
      DO 500 I=1,NPTS
  500 E=E+FILT(I)*FILT(I)
      C=1./SQRT(E)
      DO 550 I=1,NPTS
  550 FILT(I)=FILT(I)*C
      RETURN
      END

max_stars_repo_name: apthorpe/sioseis

max_issues_repo_name: henkart/sioseis

max_forks_repo_name: henkart/sioseis