probes Module Reference

Data Types
interface	assignment(=)
interface	myprobe
type	probe_obj

Functions/Subroutines
subroutine	init_nml_probe
subroutine	alloc_probe (PROBE, N)
subroutine	assign_probe (A, B)
subroutine	myprobe_vec (PROBE, VEC)
subroutine	myprobe_arr (PROBE, ARR)
subroutine	set_probes (P_ON, NP, FNM)
subroutine	open_probes
subroutine	dump_probe_data
subroutine	probe_store (PROBE)

Variables
character(len=80)	probe_interval
integer	probe_location
integer, dimension(2)	probe_levels
character(len=80)	probe_title
character(len=80)	probe_description
character(len=80)	probe_variable
character(len=80)	probe_var_name
type(probe_obj), dimension(:), allocatable	glb_probe
type(probe_obj), dimension(:), allocatable	lcl_probe
logical	probe_on
integer	global_probes
integer	local_probes
character	input_fname

Function/Subroutine Documentation

alloc_probe()

subroutine probes::alloc_probe	(	type(probe_obj), dimension(:), allocatable	PROBE,
		integer, intent(in)	N
	)

Definition at line 174 of file mod_probe.f90.

    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

Here is the call graph for this function:

Here is the caller graph for this function:

assign_probe()

subroutine probes::assign_probe	(	type(probe_obj), intent(out)	A,
		type(probe_obj), intent(in)	B
	)

Definition at line 210 of file mod_probe.f90.

     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

dump_probe_data()

subroutine probes::dump_probe_data

(

)

Definition at line 761 of file mod_probe.f90.

!------------------------------------------------------------------------------|
!  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

Here is the call graph for this function:

Here is the caller graph for this function:

init_nml_probe()

subroutine probes::init_nml_probe

(

)

Definition at line 161 of file mod_probe.f90.

    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 

Here is the caller graph for this function:

myprobe_arr()

subroutine probes::myprobe_arr	(	type(probe_obj)	PROBE,
		real(sp), dimension(:,:), allocatable, target	ARR
	)

Definition at line 359 of file mod_probe.f90.

     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"

Here is the call graph for this function:

myprobe_vec()

subroutine probes::myprobe_vec	(	type(probe_obj)	PROBE,
		real(sp), dimension(:), allocatable, target	VEC
	)

Definition at line 239 of file mod_probe.f90.

     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"

Here is the call graph for this function:

open_probes()

subroutine probes::open_probes

(

)

Definition at line 696 of file mod_probe.f90.

      !------------------------------------------------------------------------------|
      !  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"

Here is the call graph for this function:

Here is the caller graph for this function:

probe_store()

subroutine probes::probe_store

(

type(probe_obj)

PROBE

)

Definition at line 813 of file mod_probe.f90.

      !------------------------------------------------------------------------------|
      !  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"

Here is the call graph for this function:

Here is the caller graph for this function:

set_probes()

subroutine probes::set_probes	(	logical, intent(in)	P_ON,
		integer, intent(in)	NP,
		character(len=*), intent(in)	FNM
	)

Definition at line 497 of file mod_probe.f90.

    !------------------------------------------------------------------------------|
    !  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)

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

glb_probe

type(probe_obj), dimension(:), allocatable probes::glb_probe

Definition at line 143 of file mod_probe.f90.

  TYPE(PROBE_OBJ), Allocatable  :: GLB_PROBE(:) !!GLOBAL PROBE OBJECTS

global_probes

integer probes::global_probes

Definition at line 147 of file mod_probe.f90.

  INTEGER :: GLOBAL_PROBES, LOCAL_PROBES

input_fname

character probes::input_fname

Definition at line 148 of file mod_probe.f90.

  CHARACTER :: INPUT_FNAME

lcl_probe

type(probe_obj), dimension(:), allocatable probes::lcl_probe

Definition at line 144 of file mod_probe.f90.

  TYPE(PROBE_OBJ), Allocatable  :: LCL_PROBE(:) !!LOCAL PROBE OBJECTS

local_probes

integer probes::local_probes

Definition at line 147 of file mod_probe.f90.

probe_description

character(len=80) probes::probe_description

Definition at line 127 of file mod_probe.f90.

  CHARACTER(LEN=80) :: PROBE_DESCRIPTION    !!OBJECT DESCRIPTION

probe_interval

character(len=80) probes::probe_interval

Definition at line 123 of file mod_probe.f90.

  CHARACTER(LEN=80) :: PROBE_INTERVAL

probe_levels

integer, dimension(2) probes::probe_levels

Definition at line 125 of file mod_probe.f90.

  INTEGER           :: PROBE_LEVELS(2)                                        !!FINAL SIGMA LEVEL

probe_location

integer probes::probe_location

Definition at line 124 of file mod_probe.f90.

  INTEGER           :: PROBE_LOCATION                                        !!LOCAL ELEMENT/NODE LOCATION

probe_on

logical probes::probe_on

Definition at line 146 of file mod_probe.f90.

  LOGICAL :: PROBE_ON

probe_title

character(len=80) probes::probe_title

Definition at line 126 of file mod_probe.f90.

  CHARACTER(LEN=80) :: PROBE_TITLE    !!OBJECT TITLE (FOR FILENAMING) 

probe_var_name

character(len=80) probes::probe_var_name

Definition at line 129 of file mod_probe.f90.

  CHARACTER(LEN=80) :: PROBE_VAR_NAME  !!VARIABLE NAMES 

probe_variable

character(len=80) probes::probe_variable

Definition at line 128 of file mod_probe.f90.

  CHARACTER(LEN=80) :: PROBE_VARIABLE      !!VARIABLE TO DUMP