mod_report.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_report
  IMPLICIT NONE
  
  CONTAINS

  FUNCTION report_now(IINT,IREPORT)
    USE mod_time
    IMPLICIT NONE
    LOGICAL :: report_now
    INTEGER(ITIME) :: iint
    INTEGER :: ireport
    INTEGER(ITIME) :: ireport_db

    report_now = .false.
    IF(ireport == 0) return
    ireport_db = ireport
    IF(mod(iint,ireport_db) /= 0)  return

    report_now = .true.

  END FUNCTION report_now
  !==============================================================================|
  SUBROUTINE report(INFO_STRING)
    !==============================================================================|
    !     REPORT INITIAL INFORMATION                                               |
    !==============================================================================|
    USE all_vars
    USE mod_wd
    USE mod_ice
    IMPLICIT NONE
    CHARACTER(LEN=*) :: INFO_STRING     !!INFORMATION STRING
    INTEGER :: E3TOT,ESTOT,IERR
    REAL(DP), DIMENSION(22) :: SBUF,RBUF1,RBUF2,RBUF3

    REAL(SP), ALLOCATABLE :: AICE1(:), VICE1(:)
    REAL(SP), ALLOCATABLE :: Q21(:,:),Q2L1(:,:),L1(:,:)
    REAL(SP), ALLOCATABLE :: KH1(:,:),KQ1(:,:)
    INTEGER :: I,J,K
    !==============================================================================|

    ALLOCATE(q21(1:n,kbm1));   q21   = 0.0_sp
    ALLOCATE(q2l1(1:n,kbm1));  q2l1  = 0.0_sp
    ALLOCATE(l1(1:n,kbm1));    l1    = 0.0_sp
    ALLOCATE(kh1(1:n,kbm1));   kh1   = 0.0_sp
    ALLOCATE(kq1(1:n,kbm1));   kq1   = 0.0_sp






    DO k=1,kbm1
       DO i=1,n
          DO j=1,3
             q21(i,k)  = q21(i,k)+q2(nv(i,j),k)
             q2l1(i,k) = q2l1(i,k)+q2l(nv(i,j),k)
             l1(i,k)   = l1(i,k)+l(nv(i,j),k)
             kh1(i,k)  = kh1(i,k)+kh(nv(i,j),k)
             kq1(i,k)  = kq1(i,k)+kq(nv(i,j),k)
          END DO
          q21(i,k)  = q21(i,k)/3.0_sp
          q2l1(i,k) = q2l1(i,k)/3.0_sp
          l1(i,k)   = l1(i,k)/3.0_sp
          kh1(i,k)  = kh1(i,k)/3.0_sp
          kq1(i,k)  = kq1(i,k)/3.0_sp
       END DO
    END DO

    sbuf = 0.0_dp

    sbuf(1)  = sum(dble(ua(1:n)))
    sbuf(2)  = sum(dble(va(1:n)))
    sbuf(3)  = sum(dble(el1(1:n)))
    sbuf(4)  = sum(dble(h1(1:n)))
    sbuf(5)  = sum(dble(u(1:n,1:kbm1)))
    sbuf(6)  = sum(dble(v(1:n,1:kbm1)))
    sbuf(7)  = sum(dble(s(1:n,1:kbm1)))
    sbuf(8)  = sum(dble(t(1:n,1:kbm1)))
    sbuf(9)  = sum(dble(q21(1:n,2:kbm1)))
    sbuf(10) = sum(dble(q2l1(1:n,2:kbm1)))
    sbuf(11) = sum(dble(l1(1:n,1:kbm1)))
    sbuf(12) = sum(dble(km1(1:n,1:kbm1)))
    sbuf(13) = sum(dble(kq1(1:n,1:kbm1)))
    sbuf(14) = sum(dble(kh1(1:n,1:kbm1)))
    sbuf(15) = sum(dble(rho(1:n,1:kbm1)))
    sbuf(16) = sum(dble(d1(1:n)))
    sbuf(17) = sum(iswetc(1:n))


    rbuf1 = sbuf

    sbuf = 0.0_dp

    sbuf(1)  = maxval(ua(1:n))
    sbuf(2)  = maxval(va(1:n))
    sbuf(3)  = maxval(el(1:m))
    sbuf(4)  = maxval(h(1:m))
    sbuf(5)  = maxval(u(1:n,1:kbm1))
    sbuf(6)  = maxval(v(1:n,1:kbm1))
    sbuf(7)  = maxval(s1(1:m,1:kbm1))
    sbuf(8)  = maxval(t1(1:m,1:kbm1))
    sbuf(9)  = maxval(q2(1:m,1:kbm1))
    sbuf(10) = maxval(q2l(1:m,1:kbm1))
    sbuf(11) = maxval(l(1:m,1:kbm1))
    sbuf(12) = maxval(km(1:m,1:kbm1))
    sbuf(13) = maxval(kq(1:m,1:kbm1))
    sbuf(14) = maxval(kh(1:m,1:kbm1))
    sbuf(15) = maxval(rho1(1:m,1:kbm1))
    sbuf(16) = maxval(d(1:m))



    rbuf2 = sbuf

    sbuf = 0.0_dp

    sbuf(1)  = minval(ua(1:n))
    sbuf(2)  = minval(va(1:n))
    sbuf(3)  = minval(el(1:m))
    sbuf(4)  = minval(h(1:m))
    sbuf(5)  = minval(u(1:n,1:kbm1))
    sbuf(6)  = minval(v(1:n,1:kbm1))
    sbuf(7)  = minval(s1(1:m,1:kbm1))
    sbuf(8)  = minval(t1(1:m,1:kbm1))
    sbuf(9)  = minval(q2(1:m,1:kbm1))
    sbuf(10)  = minval(q2l(1:m,1:kbm1))
    sbuf(11) = minval(l(1:m,1:kbm1))
    sbuf(12) = minval(km(1:m,1:kbm1))
    sbuf(13) = minval(kq(1:m,1:kbm1))
    sbuf(14) = minval(kh(1:m,1:kbm1))
    sbuf(15) = minval(rho1(1:m,1:kbm1))
    sbuf(16) = minval(d(1:m))



    rbuf3 = sbuf

    IF(msr)THEN
       IF(len_trim(info_string) /= 0)THEN
          WRITE(ipt,*  )'!===================',trim(info_string),'======================'
       END IF
       rbuf1(15) = (rbuf1(15)+ngl*kbm1)*1000.
       rbuf2(15) = (rbuf2(15)+1.)*1000.
       rbuf3(15) = (rbuf3(15)+1.)*1000.
       e3tot = dble(ngl*kbm1)
       estot = dble(ngl)
       WRITE(ipt,*  )'!  QUANTITY              :     AVG           MAX         MIN'
       WRITE(ipt,100)'!  EXTERNAL UVEL         :',rbuf1(1)/estot,rbuf2(1),rbuf3(1)
       WRITE(ipt,100)'!  EXTERNAL VVEL         :',rbuf1(2)/estot,rbuf2(2),rbuf3(2)
       WRITE(ipt,100)'!  FREE SURFACE          :',rbuf1(3)/estot,rbuf2(3),rbuf3(3)
       WRITE(ipt,100)'!  BATH DEPTH            :',rbuf1(4)/estot,rbuf2(4),rbuf3(4)
       WRITE(ipt,100)'!  INTERNAL UVEL         :',rbuf1(5)/e3tot,rbuf2(5),rbuf3(5)
       WRITE(ipt,100)'!  INTERNAL VVEL         :',rbuf1(6)/e3tot,rbuf2(6),rbuf3(6)
       WRITE(ipt,100)'!  SALINITY              :',rbuf1(7)/e3tot,rbuf2(7),rbuf3(7)
       WRITE(ipt,100)'!  TEMPERATURE           :',rbuf1(8)/e3tot,rbuf2(8),rbuf3(8)
       WRITE(ipt,100)'!  TURBULENT KE          :',rbuf1(9)/e3tot,rbuf2(9),rbuf3(9)
       WRITE(ipt,100)'!  TURB KE*L             :',rbuf1(10)/e3tot,rbuf2(10),rbuf3(10)
       WRITE(ipt,100)'!  TURB LENGTH SCALE     :',rbuf1(11)/e3tot,rbuf2(11),rbuf3(11)
       WRITE(ipt,100)'!  KM                    :',rbuf1(12)/e3tot,rbuf2(12),rbuf3(12)
       WRITE(ipt,100)'!  KQ                    :',rbuf1(13)/e3tot,rbuf2(13),rbuf3(13)
       WRITE(ipt,100)'!  KH                    :',rbuf1(14)/e3tot,rbuf2(14),rbuf3(14)
       WRITE(ipt,100)'!  DENSITY               :',rbuf1(15)/e3tot,rbuf2(15),rbuf3(15)
       WRITE(ipt,100)'!  DEPTH                 :',rbuf1(16)/estot,rbuf2(16),rbuf3(16)

       WRITE(ipt,*  )'!  WET/DRY INFO          :   #WET       #DRY             %WET'
       IF(rbuf1(17) == float(ngl))THEN
          WRITE(ipt,*)'!  NO DRY POINTS          '
       ELSE
          WRITE(ipt,101)'!  WET/DRY DATA          :',int(rbuf1(17)),ngl-int(rbuf1(17)),100.*rbuf1(17)/float(ngl)
       END IF

    END IF


    DEALLOCATE(q21,q2l1,l1)
    DEALLOCATE(kh1,kq1)

    RETURN
100 FORMAT(1x,a26,3f12.6)
101 FORMAT(1x,a26,2i12,f12.6)
  END SUBROUTINE report
  !==============================================================================|

END MODULE mod_report