mod_probe.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

MODULE probes 
!==============================================================================!
!  PROBES MOD: CONTROLS TIME SERIES OUTPUT OF QUANTITIES AT SELECT LOCATIONS   !
!                                                                              !
!  CONTROL:  IF PROBE_ON = T IN RUNTIME PARAMETER CONTROL FILE TIME SERIES DUMP! 
!            IS ACTIVATED                                                      !
!                                                                              !
!  SETUP: TIME SERIES NML OBJECTS ARE PUT IN THE RUN FILE FOR EACH PROBE       !
!                                                                              !
!                                                                              !
!  SETUP FILE NAMING CONVENTION:                                               !
!     ***_timeseriesXX.dat                                                     !
!     *** = case id tag           (ex: gom/sat/mhb, etc)                       !
!     XX  = digit from 01 to 99, not sequential                                !
!                                                                              !
!  SETUP VARIABLE DESCRIPTION:                                                 !
!     D_LOC = element/node location of time-series data                        !
!     D_TYP = type of location ("element" or "node")                           !
!     D_TIT = title of location, used for time series output filename          !
!     D_DES = description of data (placed in time series output header)        !
!     O_INT = printing interval for data                                       !
!     K_ONE = initial sigma level 
!     K_TWO = final sigma level 
!     VAR   = variable to output in time series                                !
!     VNAME = variable description (placed in time series output header)       !
!                                                                              !
!     CURRENT VARS SET UP:                                                     !
!       u,v,w,ww,t1,s1,ua,va,rho1                                              !
!                                                                              !
!                                                                              !
!  NOTE 1:                                         !
!    IF FILE ALREADY EXIST, A NEW FILE WILL BE CREATED NAMED FILENAME-01       !
!    IF FILENAME-01 EXISTS, A NEW FILE WILL BE CREATED NAMED FILENAME-02       !
!    ETC                                                                       !
!==============================================================================!

  USE mod_utils
  USE mod_prec
  USE mod_time
  USE control
  USE lims
  USE mod_par
  IMPLICIT NONE
  SAVE
  !
  !--Probe Object Type               
  !
  TYPE probe_obj          
     LOGICAL   :: mine
     TYPE(time):: o_int
     TYPE(time):: o_next
     INTEGER  :: d_loc                                        !!LOCAL ELEMENT/NODE LOCATION   
     INTEGER  :: d_loc_gl                                     !!GLOBAL ELEMENT/NODE LOCATION   
     INTEGER  :: k_one                                        !!INITIAL SIGMA LEVEL
     INTEGER  :: k_two                                        !!FINAL SIGMA LEVEL
     INTEGER  :: o_num                                        !!OBJECT NUMBER    
     REAL(sp) :: xloc                                         !!X POSITION OF DATA LOCATION
     REAL(sp) :: yloc                                         !!Y POSITION OF DATA LOCATION
     REAL(sp) :: lonloc                                       !!LON POSITION OF DATA LOCATION
     REAL(sp) :: latloc                                       !!LAT POSITION OF DATA LOCATION
     REAL(sp) :: dpth                                         !!BATHYMETRIC DEPTH AT DATA LOC
     REAL(sp), POINTER, DIMENSION(:)              :: vec      !!USED FOR STORING DATA 
     REAL(sp), POINTER                            :: scl      !!USED FOR STORING DATA 
     CHARACTER(LEN=80)                            :: d_tit    !!OBJECT TITLE (FOR FILENAMING) 
     CHARACTER(LEN=80)                            :: d_des    !!OBJECT DESCRIPTION
     CHARACTER(LEN=80)                            :: var      !!VARIABLE TO DUMP
     CHARACTER(LEN=80)                            :: vname    !!VARIABLE NAMES 
     CHARACTER(LEN=120)                           :: filename !!FILE NAME      
  END TYPE probe_obj

   INTERFACE ASSIGNMENT(=)
      MODULE PROCEDURE assign_probe
   END INTERFACE

   INTERFACE myprobe
      MODULE PROCEDURE myprobe_vec
      MODULE PROCEDURE myprobe_arr
   END INTERFACE


  !
  !--Probe Namelist             
  !
  CHARACTER(LEN=80) :: probe_interval
  INTEGER           :: probe_location                                        !!LOCAL ELEMENT/NODE LOCATION
  INTEGER           :: probe_levels(2)                                        !!FINAL SIGMA LEVEL
  CHARACTER(LEN=80) :: probe_title    !!OBJECT TITLE (FOR FILENAMING) 
  CHARACTER(LEN=80) :: probe_description    !!OBJECT DESCRIPTION
  CHARACTER(LEN=80) :: probe_variable      !!VARIABLE TO DUMP
  CHARACTER(LEN=80) :: probe_var_name  !!VARIABLE NAMES 

  namelist /nml_probe/       &
       & probe_interval,     &
       & probe_location,     &
       & probe_levels,       &
       & probe_title,        &
       & probe_description,  &
       & probe_variable,     &
       & probe_var_name

  !
  !--Probe Variables                    
  !
  TYPE(probe_obj), Allocatable  :: glb_probe(:) !!GLOBAL PROBE OBJECTS
  TYPE(probe_obj), Allocatable  :: lcl_probe(:) !!LOCAL PROBE OBJECTS

  LOGICAL :: probe_on
  INTEGER :: global_probes, local_probes
  CHARACTER :: input_fname

CONTAINS !------------------------------------------------------------------!
  ! SET_PROBES          :   READ PROBE OBJECTS FROM INPUT            !
  ! OPEN_PROBES         :   OPEN PROBE OUTPUT FILES                  !
  ! PROBE_STORE         :   ACCUMULATE DATA IN STORAGE ARRAY         !
  ! DUMP_PROBE_DATA     :   WRITE DATA TO PROBE FILES                !
  ! -----------------------------------------------------------------!

  !==============================================================================|
  !==============================================================================|

  SUBROUTINE init_nml_probe     
    IMPLICIT NONE

    probe_interval = 'none'
    probe_location   = -1                                     !!LOCAL ELEMENT/NODE LOCATION   
    probe_levels     = -1                                      !!FINAL SIGMA LEVEL
    probe_title      = 'none'  !!OBJECT TITLE (FOR FILENAMING) 
    probe_description = 'none'   !!OBJECT DESCRIPTION
    probe_variable = 'none'     !!VARIABLE TO DUMP
    probe_var_name = 'none' !!VARIABLE NAMES 

  END SUBROUTINE init_nml_probe

SUBROUTINE alloc_probe(PROBE,N)     
    IMPLICIT NONE
    INTEGER,INTENT(IN) :: N
    TYPE(probe_obj),Allocatable  :: PROBE(:)
    INTEGER :: STATUS,I

    ALLOCATE(probe(n),stat=status)
    IF(status/=0) CALL fatal_error("MOD_PROBE: COULD NOT ALLOCATE PROBE TYPE")

    ! INITIALIZE TYPE DATA
    probe%MINE= .false.
    probe%O_INT= zerotime
    probe%O_NEXT= zerotime
    probe%O_NUM=0
    probe%D_LOC=0
    probe%D_LOC_GL=0
    probe%K_ONE=0
    probe%K_TWO=0
    probe%xloc=0.0_sp
    probe%yloc=0.0_sp
    probe%lonloc=0.0_sp
    probe%latloc=0.0_sp
    probe%dpth=0.0_sp
    probe%D_TIT    ='none' 
    probe%D_DES    ='none' 
    probe%VAR      ='none' 
    probe%VNAME    ='none' 
    probe%FILENAME ='none' 
    DO i=1,n
       NULLIFY(probe(i)%SCL)
       NULLIFY(probe(i)%VEC)
    END DO

  END SUBROUTINE alloc_probe

!======================================================
   SUBROUTINE assign_probe(A,B)
     IMPLICIT NONE
     TYPE(probe_obj), INTENT(OUT) ::A
     TYPE(probe_obj), INTENT(IN)  ::B

     a%MINE     = b%MINE
     a%O_INT    = b%O_INT
     a%O_NEXT   = b%O_NEXT
     a%O_NUM    = b%O_NUM
     a%D_LOC    = b%D_LOC
     a%D_LOC_GL = b%D_LOC_GL
     a%K_ONE    = b%K_ONE
     a%K_TWO    = b%K_TWO
     a%xloc     = b%xloc
     a%yloc     = b%yloc
     a%lonloc   = b%lonloc
     a%latloc   = b%latloc
     a%dpth     = b%dpth
     a%D_TIT    = b%D_TIT
     a%D_DES    = b%D_DES
     a%VAR      = b%VAR 
     a%VNAME    = b%VNAME
     a%FILENAME = b%FILENAME

     a%VEC      =>b%VEC
     a%SCL      =>b%SCL

   END SUBROUTINE assign_probe

   SUBROUTINE myprobe_vec(PROBE,VEC)
     USE all_vars, only:xmc,ymc,h1,h,xm,ym,h,lon,lat,lonc,latc
     IMPLICIT NONE
     TYPE(probe_obj) :: PROBE
     REAL(SP), ALLOCATABLE, TARGET :: VEC(:)
     CHARACTER(LEN=80):: cstr1,cstr2,cstr3
     INTEGER :: I,J,IBND,PROCMAX
     !============SEE IF DATA POINT IS IN THE GLOBAL DOMAIN=================
     
     if(dbg_set(dbg_sbr)) write(ipt,*) "START: MYPROBE_VEC"
     
     IF (probe%K_ONE /= -1 .or. probe%K_TWO /= -1) CALL fatal_error&
          &("ERROR IN PROBE SETUP: PROBE_LEVELS should not be set for vector variables",&
          & "Do not specify it in the PROBE Namelist object for "//trim(probe_variable))

     IF(probe%D_LOC_GL  <1)THEN 
        write(cstr1,'(i8)') probe%D_LOC_GL
        write(cstr2,'(i8)') ngl
        
        CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
             & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
     END IF
     
     IF( ubound(vec,1) == nt)THEN

        IF(probe%D_LOC_GL > ngl)THEN 
           
           write(cstr1,'(i8)') probe%D_LOC_GL
           write(cstr2,'(i8)') ngl
           
           CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
                & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
        END IF

        IF(elid(probe%D_LOC_GL) /= 0) THEN
           
           probe%D_LOC = elid(probe%D_LOC_GL)
           probe%MINE=.true.
           
           ! METERS
           probe%XLOC = xmc(probe%D_LOC)
           probe%YLOC = ymc(probe%D_LOC)
           ! SPHERICAL
           probe%LONLOC = lonc(probe%D_LOC)
           probe%LATLOC = latc(probe%D_LOC)
           ! DEPTH 
           probe%DPTH = h1(probe%D_LOC) 
           
           probe%SCL => vec(probe%D_LOC)
        END IF
        
     ELSE IF ( ubound(vec,1) == mt)THEN
        
        IF(probe%D_LOC_GL > mgl)THEN 
           write(cstr1,'(i8)') probe%D_LOC_GL
           write(cstr2,'(i8)') mgl
           
           CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
                & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
           
        END IF

        IF(nlid(probe%D_LOC_GL) == 0) RETURN

        IF(nlid(probe%D_LOC_GL) > 0) THEN
           
           IF(nde_id(nlid(probe%D_LOC_GL)) == 1)THEN   !!BOUNDARY NODE
              DO j=1,nbn
                 IF(bn_lst(j) == probe%D_LOC_GL) ibnd = j
              END DO
              !----Choose Processor of Lowest ID to be responsible for node
              procmax = 10000
              DO j=1,nprocs
                 IF(bn_ney(ibnd,j)==1) THEN
                    IF(j < procmax) procmax = j
                 END IF
              END DO
              
              IF(procmax == myid) THEN
                 probe%MINE = .true. !!NOT RESPONSIBLE FOR TIME SERIES
                 probe%D_LOC = nlid(probe%D_LOC_GL)
                 
                 ! METERS
                 probe%XLOC = xm(probe%D_LOC)
                 probe%YLOC = ym(probe%D_LOC)
                 ! SPHERICAL
                 probe%LONLOC = lon(probe%D_LOC)
                 probe%LATLOC = lat(probe%D_LOC)
                 ! DEPTH 
                 probe%DPTH = h(probe%D_LOC) 

                 probe%SCL => vec(probe%D_LOC)
              END IF
            ELSE
              probe%MINE = .true. !!NOT RESPONSIBLE FOR TIME SERIES
              probe%D_LOC = nlid(probe%D_LOC_GL)
                 
              ! METERS
              probe%XLOC = xm(probe%D_LOC)
              probe%YLOC = ym(probe%D_LOC)
              ! SPHERICAL
              probe%LONLOC = lon(probe%D_LOC)
              probe%LATLOC = lat(probe%D_LOC)
              ! DEPTH 
              probe%DPTH = h(probe%D_LOC) 

              probe%SCL => vec(probe%D_LOC)
        
           END IF
        END IF
        

     ELSE
        CALL fatal_error('MYPROBE: INVALID VARIABLE SIZE (Not equal MT or NT?)'&
             &,'Variable:'//trim(probe%VAR))
     END IF
     if(dbg_set(dbg_sbr)) write(ipt,*) "END: MYPROBE_VEC"

   END SUBROUTINE myprobe_vec

   SUBROUTINE myprobe_arr(PROBE,ARR)
     USE all_vars, only:xmc,ymc,h1,h,xm,ym,h,lon,lat,lonc,latc
     IMPLICIT NONE
     TYPE(probe_obj) :: PROBE
     REAL(SP), ALLOCATABLE, TARGET :: ARR(:,:)
     CHARACTER(LEN=80):: cstr1,cstr2,cstr3
     INTEGER :: I,J,IBND,PROCMAX
     !============ENSURE SIGMA RANGE IS TENABLE=============================

     if(dbg_set(dbg_sbr)) write(ipt,*) "START: MYPROBE_ARR"

     IF(probe%K_ONE > ubound(arr,2) .or. probe%K_TWO > ubound(arr,2) )THEN
        CALL fatal_error('ERROR IN PROBE SETUP: PROBE LEVEL RANGE NOT CORRECT FOR VARIABLE: '//trim(probe_variable),&
             & 'MAKE SURE PROBE LEVELS ARE LESS THAN OR EQUAL TO THE NUMBER OF MODEL LEVELS') 
     END IF

     IF(probe%K_ONE < 1 .or. probe%K_TWO <1)THEN
        CALL fatal_error('ERROR IN PROBE SETUP: PROBE LEVEL RANGE NOT CORRECT FOR VARIABLE: '//trim(probe_variable),&
             & 'MAKE SURE PROBE LEVELS ARE GREATER THAN OR EQUAL TO ONE') 
     END IF
     
     
     IF(probe_levels(1) >  probe_levels(2) )THEN
        CALL fatal_error&
             &('ERROR IN PROBE SETUP: PROBE LEVEL RANGE NOT CORRECT FOR VARIABLE: '//trim(probe_variable),&
             & 'THE PROBE LEVEL INTERVAL MUST SPECIFY A VALID RANGE a:b') 
     END IF
     
     
     IF(probe%D_LOC_GL  <1)THEN 
        write(cstr1,'(i8)') probe%D_LOC_GL
        write(cstr2,'(i8)') ngl
        
        CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
             & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
     END IF
     
     IF( ubound(arr,1) == nt)THEN

        IF(probe%D_LOC_GL > ngl)THEN 
           
           write(cstr1,'(i8)') probe%D_LOC_GL
           write(cstr2,'(i8)') ngl
           
           CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
                & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
        END IF

        IF(elid(probe%D_LOC_GL) /= 0) THEN
           
           probe%D_LOC = elid(probe%D_LOC_GL)
           probe%MINE=.true.
           
           ! METERS
           probe%XLOC = xmc(probe%D_LOC)
           probe%YLOC = ymc(probe%D_LOC)
           ! SPHERICAL
           probe%LONLOC = lonc(probe%D_LOC)
           probe%LATLOC = latc(probe%D_LOC)
           ! DEPTH 
           probe%DPTH = h1(probe%D_LOC) 
           
           probe%VEC => arr(probe%D_LOC,probe%K_ONE:probe%K_TWO)
        END IF


     ELSE IF ( ubound(arr,1) == mt)THEN

        IF(probe%D_LOC_GL > mgl)THEN 
           write(cstr1,'(i8)') probe%D_LOC_GL
           write(cstr2,'(i8)') mgl
           
           CALL fatal_error('ERROR IN PROBE SETUP: DATA LOCATION'//trim(cstr1)//' FOR TIME SERIES FILE: '//trim(probe_variable),&
                & 'IS NOT IN GLOBAL DOMAIN: 1 --> '//trim(cstr2))
           
        END IF

        IF(nlid(probe%D_LOC_GL) == 0) RETURN

        IF(nlid(probe%D_LOC_GL) > 0) THEN
           
           IF(nde_id(nlid(probe%D_LOC_GL)) == 1)THEN   !!BOUNDARY NODE
              DO j=1,nbn
                 IF(bn_lst(j) == probe%D_LOC_GL) ibnd = j
              END DO
              !----Choose Processor of Lowest ID to be responsible for node
              procmax = 10000
              DO j=1,nprocs
                 IF(bn_ney(ibnd,j)==1) THEN
                    IF(j < procmax) procmax = j
                 END IF
              END DO
              
              IF(procmax == myid) THEN
                 probe%MINE = .true. !!NOT RESPONSIBLE FOR TIME SERIES
                 probe%D_LOC = nlid(probe%D_LOC_GL)

                 ! METERS
                 probe%XLOC = xm(probe%D_LOC)
                 probe%YLOC = ym(probe%D_LOC)
                 ! SPHERICAL
                 probe%LONLOC = lon(probe%D_LOC)
                 probe%LATLOC = lat(probe%D_LOC)
                 ! DEPTH 
                 probe%DPTH = h(probe%D_LOC) 

                 probe%VEC => arr(probe%D_LOC,probe%K_ONE:probe%K_TWO)
              END IF
           ELSE
             probe%MINE = .true. !!NOT RESPONSIBLE FOR TIME SERIES
             probe%D_LOC = nlid(probe%D_LOC_GL)

             ! METERS
             probe%XLOC = xm(probe%D_LOC)
             probe%YLOC = ym(probe%D_LOC)
             ! SPHERICAL
             probe%LONLOC = lon(probe%D_LOC)
             probe%LATLOC = lat(probe%D_LOC)
             ! DEPTH 
             probe%DPTH = h(probe%D_LOC) 

             probe%VEC => arr(probe%D_LOC,probe%K_ONE:probe%K_TWO)
       
           END IF
        END IF
        

     ELSE
        CALL fatal_error('MYPROBE: INVALID VARIABLE SIZE?'&
             &,'Variable:'//trim(probe%VAR))
     END IF

     if(dbg_set(dbg_sbr)) write(ipt,*) "END: MYPROBE_ARR"

   END SUBROUTINE myprobe_arr

 

  SUBROUTINE set_probes(P_ON,NP,FNM)     
    !------------------------------------------------------------------------------|
    !  READ IN TIME SERIES OBJECTS FROM INPUT                                      |
    !------------------------------------------------------------------------------|
    USE mod_par
    USE lims
    USE mod_set_time

    IMPLICIT NONE
    LOGICAL, INTENT(IN)  :: P_ON
    INTEGER, INTENT(IN)  :: NP
    CHARACTER(LEN=*), INTENT(IN):: FNM
    
    CHARACTER(LEN=80):: cstr1,cstr2,cstr3
    LOGICAL FEXIST,ISLOCAL
    INTEGER :: I,J,IERR,IOS,STATUS, N_PROBE
    INTEGER :: PROCMAX, IBND, charnum
    CHARACTER(LEN=120) :: pathnfile
    CHARACTER(LEN=4) :: OFLAG
    TYPE(time) :: OTIME
    INTEGER(ITIME) :: OSTEP
    if(dbg_set(dbg_sbr)) &
         & write(ipt,*) "START: SET_PROBES;"

 
    probe_on=p_on
    global_probes=np
    local_probes=0
    input_fname=fnm

    IF (.not. probe_on) THEN
       if(dbg_set(dbg_log)) &
            & write(ipt,*) "! Time Series Probes are off"
       return
    ELSE
       if(dbg_set(dbg_log)) then
          write(ipt,*) "! Time Series Probes are on"
          write(ipt,*) "!    Setting up Probes:"
       end if
    END IF



    charnum = index(probes_file,".nml")
    if (charnum /= len_trim(probes_file)-3)&
         & CALL warning("PROBES FILE does not end in .nml", &
         & trim(probes_file))
    ! OPEN FILE - try both with appending input dir and without!
    pathnfile = trim(input_dir)//trim(probes_file)
    INQUIRE(file=pathnfile,exist=fexist)
    IF(fexist) THEN
       Call fopen(probeunit,trim(pathnfile),'cfr')
    ELSE
       pathnfile = trim(probes_file)
       Call fopen(probeunit,trim(pathnfile),'cfr')
       ! LET FOPEN CALL ERROR IF FILES DOES NOT EXIST
    END IF


    CALL alloc_probe(glb_probe,global_probes)

    !------------------------------------------------------------------------------|
    !  READ TIME SERIES NAME LIST                                                  |
    !------------------------------------------------------------------------------|
    n_probe = 0
    DO 

       CALL init_nml_probe

       islocal = .false.

       READ(unit=probeunit, nml=nml_probe,iostat=ios)
       if (ios /= 0 ) exit

       n_probe = n_probe +1
       if  (n_probe > global_probes) exit ! To prevent sigsev...


       !------------------------------------------------------------------------------|
       ! SET FUNDEMENTAL DATA
       !------------------------------------------------------------------------------|
       glb_probe(n_probe)%K_ONE    = probe_levels(1)
       glb_probe(n_probe)%K_TWO    = probe_levels(2)
       glb_probe(n_probe)%D_LOC_GL = probe_location

       glb_probe(n_probe)%D_TIT    =probe_title 
       glb_probe(n_probe)%D_DES    =probe_description
       glb_probe(n_probe)%VAR      =probe_variable
       glb_probe(n_probe)%VNAME    =probe_var_name

       !------------------------------------------------------------------------------|
       ! SET TIME FOR PROBES
       !------------------------------------------------------------------------------|
       glb_probe(n_probe)%O_NEXT = starttime
       CALL ideal_time_string2time(probe_interval,oflag,otime,ostep)
       IF (oflag == 'time') THEN ! IF OUTPUT TIME INTERVAL WAS SPECIFIED
          glb_probe(n_probe)%O_INT = otime
          
       ELSE IF(oflag == 'step') THEN ! IF OUTPUT CYCLE INTERVAL WAS SPECIFIED          
          glb_probe(n_probe)%O_INT = imdti * ostep
          
       END IF
       
       IF (glb_probe(n_probe)%O_INT <= zerotime) CALL fatal_error&
            &('ERROR IN PROBE SETUP: Time series output interval is less than or equal to zero!')
       
       !------------------------------------------------------------------------------|
       !  POINT STORAGE DATA AND LOCATION TYPE                                        |
       !------------------------------------------------------------------------------|
       CALL probe_store(glb_probe(n_probe))

       IF (glb_probe(n_probe)%MINE) THEN
          local_probes=local_probes+1
          
          glb_probe(n_probe)%O_NUM    =n_probe
          
          
       END IF

    END DO

    IF(global_probes .ne. n_probe) THEN
       
       if(dbg_set(dbg_log))  then
          write(ipt,*)"Bad NML_PROBE in the Name List!"
          write(ipt,*)"Specified number of PROBES=",global_probes
          write(ipt,*)"But Found",n_probe, "; Valid PROBE name list objects.(Printing Last)"
          write(unit=ipt,nml=nml_probe)
       end if

       CALL fatal_error&
         &('THE NUMBER OF PROBES SPECIFIED IN THE RUN FILE CAN',&
         &'NOT BE FOUND IN THE PROBE FILE:'//trim(probes_file))
    END IF

    CLOSE(probeunit)

    
    CALL alloc_probe(lcl_probe,local_probes)

    n_probe=0
    DO i = 1,global_probes
       IF (glb_probe(i)%O_NUM .NE. 0) THEN
          n_probe=n_probe+1
          lcl_probe(n_probe)=glb_probe(i)
       END IF
    END DO
    IF(n_probe .NE. local_probes) CALL fatal_error("mod_probe: this should not happen?")


    DEALLOCATE(glb_probe)

    !------------------------------------------------------------------------------|
    !  PRINT STATISTICS ON TIME SERIES OBJECTS TO OUTPUT                           |
    !------------------------------------------------------------------------------|
    IF(global_probes > 0)THEN

       if(dbg_set(dbg_sbrio)) write(ipt,*) "GLobal probes"&
            &,global_probes,"Local_probes",local_probes,size(lcl_probe)

       IF(dbg_set(dbg_log))THEN
          WRITE(ipt,*)
          WRITE(ipt,*)'!         TIME SERIES OBJECT DATA               '
          WRITE(ipt,*)" OBJ#  PROC GLOBAL  LOCAL  VAR  FILENAME"
       END  IF


       ! THIS IS VERY SLOW - DO NOT USE THIS METHOD INSIDE THE MAIN LOOP!
       DO j=1,nprocs

          IF(myid == j) THEN
             DO i=1,local_probes  
                WRITE(ipt,101)lcl_probe(i)%O_NUM,myid,lcl_probe(i)%D_LOC_GL,lcl_probe(i)%D_LOC, &
                     & trim(lcl_probe(i)%VAR),trim(lcl_probe(i)%D_TIT)
             END DO
          END IF
       END DO

    END IF

    !------------------------------------------------------------------------------|
    !  OPEN UP OUTPUT FILES AND WRITE HEADER INFORMATION                           |
    !------------------------------------------------------------------------------|
    CALL open_probes

    CALL dump_probe_data

      if(dbg_set(dbg_sbr)) write(ipt,*) "END: SET_PROBES"

101 FORMAT(i5,i5,i8,i8,3x,a6,1x,a30)
  END SUBROUTINE set_probes

    !==============================================================================|

    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

    !==============================================================================|

    SUBROUTINE open_probes   

      !------------------------------------------------------------------------------|
      !  CREATE FILE NAMES AND WRITE HEADER INFORMATION FOR EACH TS OBJECT           |
      !------------------------------------------------------------------------------|

      USE mod_prec
      USE all_vars
      IMPLICIT NONE
      INTEGER I,IUNIT,ICNT
      CHARACTER(LEN=120) :: FNAME
      CHARACTER(LEN=2  ) :: NAC 
      CHARACTER(LEN=3  ) :: APPEND
      LOGICAL FEXIST

      if(dbg_set(dbg_sbr)) write(ipt,*) "START: OPEN_PROBES"
      !
      !--Open Up Files -> If File Exists Create Secondary File (-01,-02, etc)
      !

      DO i=1,local_probes 

         icnt  = 0
         fname = trim(output_dir)//trim(lcl_probe(i)%D_TIT)
         INQUIRE(file=fname,exist=fexist)
         DO WHILE(fexist)
            icnt = icnt + 1
            IF(icnt .GE. 100) CALL fatal_error&
                 &("Please clean old time seris output in your results directory!")
            WRITE(nac,'(I2.2)')icnt
            append = "-"//nac
            fname = trim(output_dir)//trim(lcl_probe(i)%D_TIT)//trim(append)
            INQUIRE(file=fname,exist=fexist)
         END DO

         iunit = lcl_probe(i)%O_NUM + 100
         CALL fopen(iunit,fname,'ofr')
         WRITE(iunit,*)trim(lcl_probe(i)%D_DES)
         WRITE(iunit,*)trim(lcl_probe(i)%VNAME)
         WRITE(iunit,*)
         CALL print_real_time(get_now(),iunit,"MODEL START DATE")
         WRITE(iunit,*)
         WRITE(iunit,*)'         K1            K2           '
         WRITE(iunit,'(2(I12,3X))')lcl_probe(i)%K_ONE,lcl_probe(i)%K_TWO
         WRITE(iunit,*)'     X(M)          Y(M)            DEPTH(M)'
         WRITE(iunit,'(3(F12.3,3X))')lcl_probe(i)%XLOC,lcl_probe(i)%YLOC,lcl_probe(i)%DPTH
         WRITE(iunit,*)'     LON           LAT               DEPTH(M)'
         WRITE(iunit,'(3(F12.3,3X))')lcl_probe(i)%LONLOC,lcl_probe(i)%LATLOC,lcl_probe(i)%DPTH
         WRITE(iunit,*)
         WRITE(iunit,*)'DATA FOLLOWS:'
         WRITE(iunit,*)'Time(days)    Data...'
         CLOSE(iunit)
         lcl_probe(i)%FILENAME = fname
      END DO

      if(dbg_set(dbg_sbr)) write(ipt,*) "END: OPEN_PROBES"

    END SUBROUTINE open_probes
!==============================================================================|

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

!==============================================================================|

    SUBROUTINE dump_probe_data

!------------------------------------------------------------------------------|
!  WRITE TIME SERIES DATA TO TIME SERIES DATA FILES                            |
!------------------------------------------------------------------------------|

      USE mod_prec
      USE all_vars
      IMPLICIT NONE
      INTEGER I,K,K1,K2,IUNIT
      TYPE(time) :: OTIME

       if(dbg_set(dbg_sbr)) write(ipt,*) "START: DUMP_PROBE_DATA"

!==============================================================================!
!  MAIN LOOP OVER TIME SERIES OUTPUT                                           !
!==============================================================================!
      DO i=1,local_probes

         !----Return if not on Time Series Write Interval-----------------------------
         IF( lcl_probe(i)%O_NEXT .GT. inttime) cycle 

         lcl_probe(i)%O_NEXT = inttime + lcl_probe(i)%O_INT
         !----Open File For Write-----------------------------------------------------
         iunit = lcl_probe(i)%O_NUM + 100
         OPEN(unit=iunit,file=lcl_probe(i)%FILENAME,form='FORMATTED',position='APPEND')

         !----Write Data to File------------------------------------------------------
         IF(ASSOCIATED(lcl_probe(i)%VEC))THEN
            k1=lcl_probe(i)%K_one
            k2=lcl_probe(i)%K_two
!            WRITE(IUNIT,*) DAYS(IntTime),(LCL_PROBE(I)%VEC(K),K=K1,K2)
            WRITE(iunit,'(f15.5,50f9.3)') days(inttime),(lcl_probe(i)%VEC)
         ELSE IF(ASSOCIATED(lcl_probe(i)%SCL))THEN
            WRITE(iunit,'(f15.5,50f9.3)') days(inttime),(lcl_probe(i)%SCL)
         END IF

      END DO

      if(dbg_set(dbg_sbr)) write(ipt,*) "END: DUMP_PROBE_DATA"
      RETURN
    END SUBROUTINE dump_probe_data

!==============================================================================!
!  END MAIN LOOP OVER TIME SERIES OUTPUT                                       !
!==============================================================================!

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

!==============================================================================|

    SUBROUTINE probe_store(PROBE)

      !------------------------------------------------------------------------------|
      !  PUT TIME SERIES DATA IN TEMPORARY ARRAY                                     |
      !------------------------------------------------------------------------------|

      USE mod_prec
      USE all_vars
      IMPLICIT NONE
      TYPE(probe_obj) :: PROBE

      if(dbg_set(dbg_sbr)) write(ipt,*) "START: PROBE_STORE"

      !--Store Data In Temporary Array-------------------------------------------
      SELECT CASE(trim(probe%VAR))

      CASE("u")
         CALL myprobe(probe,u)
      CASE("v")
         CALL myprobe(probe,v)
      CASE("w")
         CALL myprobe(probe,w)
      CASE("ww")
         CALL myprobe(probe,ww)
      CASE("q2")
         CALL myprobe(probe,q2)
      CASE("q2l")
         CALL myprobe(probe,q2l)
      CASE("l")
         CALL myprobe(probe,l)
      CASE("km")
         CALL myprobe(probe,km)
      CASE("kq")
         CALL myprobe(probe,kq)
      CASE("kh")
         CALL myprobe(probe,kh)
      CASE("t1")
         CALL myprobe(probe,t1)
      CASE("s1")
         CALL myprobe(probe,s1)
      CASE("rho1")
         CALL myprobe(probe,rho1)
      CASE("ua")
         CALL myprobe(probe,ua)
      CASE("va")
         CALL myprobe(probe,va)
      CASE("el")
         CALL myprobe(probe,el)
      CASE DEFAULT
         CALL fatal_error&
              &('VARIABLE: '//trim(probe%VAR)//' HAS NOT BEEN SET UP',&
              & 'FOR TIME SERIES OUTPUT (Did you use CAPITALS by mistake?)',&
              & 'MODIFY MOD_PROBE TO ADD IT!')

      END SELECT

      if(dbg_set(dbg_sbr)) write(ipt,*) "END: PROBE_STORE"

    END SUBROUTINE probe_store
!==============================================================================|

  END MODULE probes 
!==============================================================================|