mod_meanflow.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 mod_meanflow
   USE all_vars
   USE mod_prec
   USE mod_types
   IMPLICIT NONE
   SAVE
   INTEGER              :: mf_rst_stcnt
   INTEGER              :: inmf,intcell,intnode,intelel,intuv
   INTEGER              :: nmfcell_gl, nmfcell, nmfcell_i
   INTEGER, ALLOCATABLE :: mf_gl2loc(:)
   INTEGER, ALLOCATABLE :: i_mfcell_gl(:),i_mfcell_n(:)
   REAL(sp),ALLOCATABLE :: dmfqdis(:,:),mfqdis(:),mfdist(:,:)
   REAL(sp),ALLOCATABLE :: anglemf(:),mfarea(:),vlctymf(:)
   TYPE(bc)             :: mf_tm           !!TIME MAP FOR MEAN FLOW DATA
   REAL(sp),ALLOCATABLE :: rdismf(:,:)
   INTEGER ,ALLOCATABLE :: node_mfcell(:,:)

   CONTAINS

! we still need to consider the case in which MEAN FLOW bring in/take out T & S
!==============================================================================|
!  READ IN MEAN FLOW OPEN BOUNDARY FLUX (m^3/s^1) TIME SERIES                  |
!==============================================================================|

   SUBROUTINE read_meanflow

!------------------------------------------------------------------------------!
     INTEGER              :: k,i,j,i1,i2,i3,ii,NCNT,itemp,IERR
     INTEGER, ALLOCATABLE :: temp1(:),temp2(:)
     REAL(SP),ALLOCATABLE :: RTEMP1(:,:),RTEMP2(:,:)
     REAL(SP)             :: ttemp

     rewind(inmf)
     READ(inmf,*) nmfcell_gl

     nmfcell_i = 0
     nmfcell   = 0
  IF (nmfcell_gl > 0) THEN

     ALLOCATE(i_mfcell_gl(nmfcell_gl))
     DO i=1,nmfcell_gl
        READ(inmf,*)i_mfcell_gl(i)
     ENDDO

!----Read in Mean Flow Flux Vertical Distribution---------------------
     ALLOCATE(rtemp1(nmfcell_gl,kbm1))
     DO i = 1, nmfcell_gl
       READ(inmf,*) j,(rtemp1(i,k),k = 1,kbm1)
     END DO

!----Read in Time Dependent DataSets ---------------------------------
       READ(inmf,*) itemp
       mf_tm%NTIMES = itemp
       mf_tm%LABEL  = "open boundary mean flow flux"
       ALLOCATE(mf_tm%TIMES(itemp))
       ALLOCATE(rtemp2(nmfcell_gl,itemp))
       DO i = 1, itemp
         READ(inmf,*) ttemp
         mf_tm%TIMES(i) = ttemp
         READ(inmf,*) (rtemp2(j,i),j = 1,nmfcell_gl)
!--------------------------------Jianzhong----------------------------
         IF(msr)WRITE(ipt,*)maxval(rtemp2(1:nmfcell_gl,i))&
              &,maxloc(rtemp2(1:nmfcell_gl,i)) ,minval(rtemp2(1:nmfcell_gl,i))&
              &,minloc(rtemp2(1:nmfcell_gl,i)) 
!---------------------------------------------------------------------
 !        WRITE(IOPRT,*) ttemp
 !        WRITE(IOPRT,*) (RTEMP2(J,I),J = 1,nmfcell_GL)
       END DO
       CLOSE(inmf)

!
!---Map to Local Domain----------------------------------------

     IF(serial)THEN
       nmfcell_i = nmfcell_gl
       nmfcell   = nmfcell_gl
       ALLOCATE(i_mfcell_n(nmfcell))
       i_mfcell_n = i_mfcell_gl
       ALLOCATE(mfdist(nmfcell,kbm1))
       mfdist = rtemp1
       ALLOCATE(dmfqdis(nmfcell,mf_tm%NTIMES))
       dmfqdis = rtemp2
     END IF


     DEALLOCATE(rtemp1,rtemp2)

  ELSE  ! if statement end for nmfcell_GL > 0
    close(inmf)
  END IF

!--------------------------------------Jianzhong----------------------
   WRITE(ipt,*)'NMFCELL_I=',nmfcell_i,'NMFCELL=',nmfcell,'IN THREAD:',myid
!---------------------------------------------------------------------

   RETURN
   END SUBROUTINE read_meanflow
!==============================================================================|


!==============================================================================|
!  SET METRICS FOR MEAN FLOW BOUNDARY CONDITIONS                       |
!==============================================================================|

   SUBROUTINE set_bndry_meanflow     

!------------------------------------------------------------------------------!

   USE bcs
   USE mod_obcs

   IMPLICIT NONE
   REAL(DP)  DX12,DY12,ATMP1,HTMP
   INTEGER I,J,I1,I2,J1,J2,II,ITMP,JTMP
!------------------------------------------------------------------------------!

   IF(nmfcell > 0)THEN

     ALLOCATE(anglemf(nmfcell),mfarea(nmfcell),vlctymf(nmfcell),mfqdis(nmfcell))
     ALLOCATE(node_mfcell(nmfcell,2),rdismf(nmfcell,2))

     DO i=1,nmfcell
       ii=i_mfcell_n(i)
       IF(i <= nmfcell_i .and. isbce(ii) /= 2) THEN
          print*, 'NO.',i,'MEAN FLOW CELL'
          print*, 'IS NOT A OPEN BOUNDARY ONE'
          CALL pstop
       END IF
       itmp=0
       DO j=1,3
         IF(nbe(ii,j) == 0 .and. isonb(nv(ii,j)) /= 2) THEN
           jtmp=j
           itmp=itmp+1
         END IF
       END DO
       IF(itmp /= 1) THEN
         print*, 'NO OPEN BOUNDARY OR MORE THAN ONE OPEN BOUNDARY'
         print*, 'IN NO.',i,'MEAN FLOW CELL'
         CALL pstop
       END IF
       j1=jtmp+1-int((jtmp+1)/4)*3
       j2=jtmp+2-int((jtmp+2)/4)*3
       i1=nv(ii,j1)
       i2=nv(ii,j2)
         
       node_mfcell(i,1)=i1
       node_mfcell(i,2)=i2

       htmp=0.5_sp*(h(i1)+h(i2))     ! may be a problem here, should be replaced dy D
       dy12=vy(i1)-vy(i2)
       dx12=vx(i1)-vx(i2)
       atmp1=atan2(dy12,dx12)
       mfarea(i)=sqrt(dx12**2+dy12**2)*htmp    ! for spherical coordinates is Phthagolean Theorem still valid?
       anglemf(i)=atmp1+3.1415927/2.0
       rdismf(i,1)=art1(i1)/(art1(i1)+art1(i2))
       rdismf(i,2)=art1(i2)/(art1(i1)+art1(i2))
     END DO
   END IF

   RETURN
   END SUBROUTINE set_bndry_meanflow
!==============================================================================|

!==============================================================================|
!  INTERPOLATION MEAN FLOW OPEN BOUNDARY FLUX (m^3/s^1) TIME SERIES            |
!==============================================================================|

   SUBROUTINE bcond_meanflow
!
!------------------------------------------------------------------------------!
   USE all_vars
   USE bcs
   USE mod_obcs
   
   INTEGER  L1,L2,IERR,II
   REAL(SP) :: FACT,UFACT
   REAL(SP) :: THOUR

   thour = dti*float(iint)/3600.0
   IF(nmfcell > 0)THEN
     CALL bracket(mf_tm,thour,l1,l2,fact,ufact,ierr)
     mfqdis(:) = ufact*dmfqdis(:,l1) + fact*dmfqdis(:,l2)
     mfqdis    = mfqdis*ramp
   END IF

   RETURN
   END SUBROUTINE bcond_meanflow

   SUBROUTINE bracket(TMAP,STIME,L1,L2,FACT,BACT,IERR)             
!==============================================================================|
!  DETERMINE DATA INTERVAL IN WHICH CURRENT TIME LIES                          |
!                                          | 
!  L1:  DATA INTERVAL PROCEEDING TIME                              |
!  L2:  DATA INTERVAL AFTER TIME                                               |
!  FACT: LINEAR INTERPOLATION COEFFICIENT (0->1)                               |
!     FACT = .5  : STIME LIES EXACTLY BETWEEN TWO DATA TIMES                   |
!     FACT = 1.  : STIME OCCURS AT SECOND DATA TIME                            |
!  BACT  = 1.-FACT
!  IERR: RETURNS INTEGER ERROR                                                 |
!     IERR = 0   : NO ERROR, TIME IS BRACKETED BY DATA TIMES                   |
!     IERR =-1   : STIME PROCEEDS ALL DATA TIMES                               |
!     IERR = 1   : STIME IS GREATER THAN ALL DATA TIMES                        |
!                                                                              |
!  IF STIME PROCEEDS DATA, IERR IS SET TO -1, L1 TO 1, AND FACT TO 0.          !
!  IF STIME SUPERCEEDS DATA, IERR IS SET TO -1, L2 TO LMAX, AND FACT TO 1.     !
!==============================================================================|
   USE mod_types 
   IMPLICIT NONE
!------------------------------------------------------------------------------!
   TYPE(bc), INTENT(IN)  :: TMAP
   REAL(SP), INTENT(IN)  :: STIME
   INTEGER,  INTENT(OUT) :: L1,L2
   REAL(SP), INTENT(OUT) :: FACT,BACT
   INTEGER,  INTENT(OUT) :: IERR
!------------------------------------------------------------------------------!
   REAL(SP)  T1,T2
   INTEGER I,NTMAX
!==============================================================================|

   ntmax = tmap%NTIMES
   IF(stime < tmap%TIMES(1))THEN
     fact = 0.0_sp
     bact = 1.0_sp
     l1   = 1
     l2   = 1
     ierr = -1
     RETURN
   END IF

   IF(stime > tmap%TIMES(ntmax))THEN
     fact = 1.0_sp
     bact = 0.0_sp
     l1   = ntmax
     l2   = ntmax
     ierr = 1
     RETURN
   END IF

   IF(ntmax == 1)THEN
     fact = 1.0_sp
     bact = 0.0_sp
     l1   = 1
     l2   = 1
     ierr = 0
     RETURN
   END IF
   

   DO i=2,tmap%NTIMES
     t1 = tmap%TIMES(i-1)
     t2 = tmap%TIMES(i)
     IF(stime >= t1 .AND. stime <= t2)THEN  
       l1   = i-1
       l2   = i
       ierr = 0
       fact = (stime-t1)/(t2-t1)
       bact = 1.0_sp-fact
     END IF
   END DO
   
     
   RETURN
   END SUBROUTINE bracket
!==============================================================================|


END MODULE mod_meanflow