longshore_flow.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$
!/===========================================================================/

subroutine longshore_flow
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SETUP THE METRICS FOR LONGSHORE WIND DRIVEN FLOW
! CALCULATE BOUNDARY ANGLE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  USE mod_utils
  USE all_vars
  USE mod_par
  IMPLICIT NONE
  INTEGER :: I,J,K,nxt, prv, idx, ndx
  real(sp) :: dx, dy
  
  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START longshore_flow"

  ! MAKE SURE THERE ARE ATLEAST TWO NODES IN THE LIST
  IF (nobclsf == 0 .and. par) THEN
     ! DO NOTHING AND RETURN
     RETURN
  ELSE IF (nobclsf < 2 .and. serial) THEN
     CALL fatal_error&
          &('There are less than two long shore flow nodes',&
          &'You must change the _lsf.dat file to contain atleast two nodes!.')
  END IF

  !MAKE SURE THE FIRST NODE IN THIS LIST IS NEXT TO A SOLID BOUNDARY
  ! OR A HALO NODE (IF PAR)
  idx = ibclsf(1)
  i = 0
  DO 
     i = i + 1 
     if(i > ntsn(idx)) CALL fatal_error&
             &("THE FIRST NODE IN THE LSF LIST MUST BE NEXT TO THE SOLID BOUNDARY",&
             &"OR (IN THE PARALLEL CASE) NEXT TO THE HALO?")
     
     ndx = nbsn(idx,i)

     if(isonb(ndx) == 1 .or. (ndx > m .and. ndx <= mt)) THEN
        exit
     end if
  END DO
     

  ! MAKE SURE ALL THE NODES IN THE LIST ARE ON THE OPEN BOUNDARY
  DO i = 1, nobclsf
     j = ibclsf(i)
     if (isonb(j) /= 2) THEN
        
        write(ipt,*) "LONG SHORE FLOW ERROR ON GLOBAL NODE NUMBER: ", ngid_x(j)
        CALL fatal_error&
          &("A LONG SHORE FLOW BOUNDARY NODE IS NOT ON THE OPEN BOUNDARY:", &
          &"CHECK YOUR BOUNDARY FILES!")
     END if

  END DO

  ! MAKE A LIST OF 'NEXT NODES' - used to determine angles and
  ! gradients allong the lsf boundary

  ALLOCATE(nbclsf(nobclsf))
  DO idx = 1, nobclsf-1
     prv= idx
     nxt= idx+1

     if(ibclsf(nxt) == ibclsf(prv)) CALL fatal_error&
          &("Two long shore flow nodes in the file list are the same!")


     i = 0
     DO 
        i = i+ 1
        if(i > ntsn(ibclsf(prv))) CALL fatal_error&
             &("Two long shore flow nodes are not next to eachother!")

        if( ibclsf(nxt) == nbsn(ibclsf(prv),i) ) exit
     END DO

     nbclsf(idx)=ibclsf(nxt)

  END DO


  ! NOW FIND THE NEXT NODE AFTER THE LAST IN THE LIST - THERE ARE ALWAYS TWO!

  idx = ibclsf(nobclsf)
  IF (nobclsf >1) THEN
     prv = ibclsf(nobclsf - 1)
  ELSE
     ! THIS CAN ONLY HAPPEN IN A PARALLEL CASE WHRE THERE IS ONLY ONE
     ! LOCAL NODE IN THE LSF BOUNDARY DUE TO A NASTY DECOMPOSITION

     ! SET PRV TO THE NEIGHBORING HALO NODE!
     i = 0
     DO 
        i = i + 1 
        if(i > ntsn(idx)) CALL fatal_error&
             &("CAN'T FIND ANOTHER OPEN BOUNDARY NODE FOR LONG SHORE FLOW?",&
             &"IF THERE IS ONLY ONE NODE IN THE DOMAIN IT MUST BE NEXT TO THE HALO!")

        ndx = nbsn(idx,i)
     
        if(isonb(ndx) == 2 .and. ndx > m ) THEN
           prv = ndx
           exit
        end if
     END DO
  END IF

  i = 0
  DO 
     i = i + 1 
     if(i > ntsn(idx)) CALL fatal_error&
             &("CAN'T FIND ANOTHER OPEN BOUNDARY NODE FOR LONG SHORE FLOW?",&
             &"The list can't contain the entire open boundary!")

     ndx = nbsn(idx,i)
     
     if(isonb(ndx) == 2 .and. ndx /= prv .and. ndx /= idx ) THEN
        nbclsf(nobclsf)= ndx
        exit
     end if
  END DO

  Allocate(wdf_ang(nobclsf)); wdf_ang = 0.0_sp
  Allocate(wdf_dist(nobclsf)); wdf_dist = 0.0_sp

  DO i = 1,nobclsf
     dx = vx(nbclsf(i)) - vx(ibclsf(i))
     dy = vy(nbclsf(i)) - vy(ibclsf(i))

     wdf_dist(i)= sqrt(dx**2 + dy**2)
     wdf_ang(i) =  atan2(dy,dx)
  END DO


  write(ipt,*) "! LONG SHORE FLOW BOUNDARY CONDITION METRICS"
  WRITE(ipt,*) "!     NodeList,   NextNode,   Angle,        Distance"
  DO i = 1, nobclsf
     
     write(ipt,*)"! ",ngid_x(ibclsf(i)), ngid_x(nbclsf(i)), wdf_ang(i),wdf_dist(i)
     if (nbclsf(i) > m .and. dbg_set(dbg_log)) write(ipt,*)&
          & "! The next node value shown above is in the halo and does not appear co&
          &rrectly in ngid: Don't worry about it ;-)" 

  END DO

  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "END longshore_flow"

end subroutine longshore_flow