1 | SUBROUTINE ana_diag (ng, tile, model)
|
---|
2 | !
|
---|
3 | !! svn $Id: ana_diag.h 34 2007-04-27 04:40:21Z arango $
|
---|
4 | !!======================================================================
|
---|
5 | !! Copyright (c) 2002-2007 The ROMS/TOMS Group !
|
---|
6 | !! Licensed under a MIT/X style license !
|
---|
7 | !! See License_ROMS.txt !
|
---|
8 | !! !
|
---|
9 | !=======================================================================
|
---|
10 | ! !
|
---|
11 | ! This routine is provided so the USER can compute any specialized !
|
---|
12 | ! diagnostics. If activated, this routine is call at end of every !
|
---|
13 | ! 3D-equations timestep. !
|
---|
14 | ! !
|
---|
15 | !=======================================================================
|
---|
16 | !
|
---|
17 | USE mod_param
|
---|
18 | USE mod_ncparam
|
---|
19 | USE mod_ocean
|
---|
20 | !
|
---|
21 | ! Imported variable declarations.
|
---|
22 | !
|
---|
23 | integer, intent(in) :: ng, tile, model
|
---|
24 |
|
---|
25 | #include "tile.h"
|
---|
26 | !
|
---|
27 | CALL ana_diag_tile (ng, model, Istr, Iend, Jstr, Jend, &
|
---|
28 | & LBi, UBi, LBj, UBj, &
|
---|
29 | #ifdef SOLVE3D
|
---|
30 | & OCEAN(ng) % u, &
|
---|
31 | & OCEAN(ng) % v, &
|
---|
32 | #endif
|
---|
33 | & OCEAN(ng) % ubar, &
|
---|
34 | & OCEAN(ng) % vbar)
|
---|
35 | !
|
---|
36 | ! Set analytical header file name used.
|
---|
37 | !
|
---|
38 | IF (Lanafile) THEN
|
---|
39 | ANANAME( 5)='ROMS/Functionals/ana_diag.h'
|
---|
40 | END IF
|
---|
41 |
|
---|
42 | RETURN
|
---|
43 | END SUBROUTINE ana_diag
|
---|
44 | !
|
---|
45 | !***********************************************************************
|
---|
46 | SUBROUTINE ana_diag_tile (ng, model, Istr, Iend, Jstr, Jend, &
|
---|
47 | & LBi, UBi, LBj, UBj, &
|
---|
48 | #ifdef SOLVE3D
|
---|
49 | & u, v, &
|
---|
50 | #endif
|
---|
51 | & ubar, vbar)
|
---|
52 | !***********************************************************************
|
---|
53 | !
|
---|
54 | USE mod_param
|
---|
55 | USE mod_iounits
|
---|
56 | USE mod_scalars
|
---|
57 | #ifdef SEAMOUNT
|
---|
58 | USE mod_stepping
|
---|
59 | #endif
|
---|
60 | !
|
---|
61 | ! Imported variable declarations.
|
---|
62 | !
|
---|
63 | integer, intent(in) :: ng, model, Iend, Istr, Jend, Jstr
|
---|
64 | integer, intent(in) :: LBi, UBi, LBj, UBj
|
---|
65 | !
|
---|
66 | #ifdef ASSUMED_SHAPE
|
---|
67 | # ifdef SOLVE3D
|
---|
68 | real(r8), intent(in) :: u(LBi:,LBj:,:,:)
|
---|
69 | real(r8), intent(in) :: v(LBi:,LBj:,:,:)
|
---|
70 | # endif
|
---|
71 | real(r8), intent(in) :: ubar(LBi:,LBj:,:)
|
---|
72 | real(r8), intent(in) :: vbar(LBi:,LBj:,:)
|
---|
73 | #else
|
---|
74 | # ifdef SOLVE3D
|
---|
75 | real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
|
---|
76 | real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
|
---|
77 | # endif
|
---|
78 | real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,3)
|
---|
79 | real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,3)
|
---|
80 | #endif
|
---|
81 | !
|
---|
82 | ! Local variable declarations.
|
---|
83 | !
|
---|
84 | integer :: i, j, k
|
---|
85 | real(r8) :: umax, ubarmax, vmax, vbarmax
|
---|
86 |
|
---|
87 | #ifdef SEAMOUNT
|
---|
88 | !
|
---|
89 | ! Open USER file.
|
---|
90 | !
|
---|
91 | IF (iic(ng).eq.ntstart(ng)) THEN
|
---|
92 | OPEN (usrout,file=USRname,form='formatted',status='unknown', &
|
---|
93 | & err=40)
|
---|
94 | GO TO 60
|
---|
95 | 40 WRITE (stdout,50) USRname
|
---|
96 | 50 FORMAT (' ANA_DIAG - unable to open output file: ',a)
|
---|
97 | exit_flag=2
|
---|
98 | 60 CONTINUE
|
---|
99 | END IF
|
---|
100 | !
|
---|
101 | ! Write out maximum values of velocity.
|
---|
102 | !
|
---|
103 | umax=0.0_r8
|
---|
104 | vmax=0.0_r8
|
---|
105 | ubarmax=0.0_r8
|
---|
106 | vbarmax=0.0_r8
|
---|
107 | DO k=1,N(ng)
|
---|
108 | DO j=0,Mm(ng)+1
|
---|
109 | DO i=1,Lm(ng)+1
|
---|
110 | umax=MAX(umax,u(i,j,k,nnew(ng)))
|
---|
111 | END DO
|
---|
112 | END DO
|
---|
113 | DO j=1,Mm(ng)+1
|
---|
114 | DO i=0,Lm(ng)+1
|
---|
115 | vmax=MAX(vmax,v(i,j,k,nnew(ng)))
|
---|
116 | END DO
|
---|
117 | END DO
|
---|
118 | END DO
|
---|
119 | DO j=0,Mm(ng)+1
|
---|
120 | DO i=1,Lm(ng)+1
|
---|
121 | ubarmax=MAX(ubarmax,ubar(i,j,knew(ng)))
|
---|
122 | END DO
|
---|
123 | END DO
|
---|
124 | DO j=1,Mm(ng)+1
|
---|
125 | DO i=0,Lm(ng)+1
|
---|
126 | vbarmax=MAX(vbarmax,vbar(i,j,knew(ng)))
|
---|
127 | END DO
|
---|
128 | END DO
|
---|
129 | !
|
---|
130 | ! Write out maximum values on velocity.
|
---|
131 | !
|
---|
132 | WRITE (usrout,70) tdays(ng), ubarmax, vbarmax, umax, vmax
|
---|
133 | 70 FORMAT (2x,f13.6,2x,1pe13.6,2x,1pe13.6,2x,1pe13.6,2x,1pe13.6)
|
---|
134 | #endif
|
---|
135 | RETURN
|
---|
136 | END SUBROUTINE ana_diag_tile
|
---|