1 |
subroutine getdiag (lev,ipoint,bi,bj,undef,qtmp) |
subroutine getdiag (myThid,lev,ipoint,undef,qtmp) |
2 |
C*********************************************************************** |
C*********************************************************************** |
3 |
C PURPOSE |
C PURPOSE |
4 |
C Retrieve averaged model diagnostic |
C Retrieve averaged model diagnostic |
15 |
C*********************************************************************** |
C*********************************************************************** |
16 |
implicit none |
implicit none |
17 |
|
|
18 |
|
#include "EEPARAMS.h" |
19 |
#include "CPP_OPTIONS.h" |
#include "CPP_OPTIONS.h" |
20 |
#include "SIZE.h" |
#include "SIZE.h" |
21 |
|
|
22 |
|
#ifdef ALLOW_FIZHI |
23 |
#include "fizhi_SIZE.h" |
#include "fizhi_SIZE.h" |
24 |
|
#else |
25 |
|
integer Nrphys |
26 |
|
parameter (Nrphys=1) |
27 |
|
#endif |
28 |
|
|
29 |
#include "diagnostics_SIZE.h" |
#include "diagnostics_SIZE.h" |
30 |
#include "diagnostics.h" |
#include "diagnostics.h" |
31 |
|
|
32 |
integer bi,bj |
integer myThid,lev,ipoint |
33 |
integer lev,ipoint |
_RL undef |
34 |
|
_RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy) |
35 |
|
|
36 |
|
_RL factor |
37 |
integer i,j,ipnt,klev |
integer i,j,ipnt,klev |
38 |
_RL undef, factor |
integer bi,bj |
39 |
_RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy) |
|
40 |
|
if (ipoint.lt.1) go to 999 |
41 |
|
|
42 |
|
klev = kdiag(ipoint) |
43 |
|
if(klev.ge.lev) then |
44 |
|
ipnt = idiag(ipoint) + lev - 1 |
45 |
|
factor = 1.0 |
46 |
|
if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint) |
47 |
|
|
48 |
|
do bj=myByLo(myThid), myByHi(myThid) |
49 |
|
do bi=myBxLo(myThid), myBxHi(myThid) |
50 |
|
|
51 |
do j = 1,sNy |
do j = 1,sNy |
52 |
do i = 1,sNx |
do i = 1,sNx |
53 |
qtmp(i,j,bi,bj) = undef |
if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then |
54 |
|
qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor |
55 |
|
else |
56 |
|
qtmp(i,j,lev,bi,bj) = undef |
57 |
|
endif |
58 |
enddo |
enddo |
59 |
enddo |
enddo |
60 |
|
|
|
IF (IPOINT.LT.1) GO TO 999 |
|
|
|
|
|
KLEV = KDIAG(IPOINT) |
|
|
IF(KLEV.GE.LEV) THEN |
|
|
IPNT = IDIAG(IPOINT) + LEV - 1 |
|
|
FACTOR = 1.0 |
|
|
IF( NDIAG(IPOINT).NE.0 ) FACTOR = 1.0 / NDIAG(IPOINT) |
|
|
do j = 1,sNy |
|
|
do i = 1,sNx |
|
|
if( qdiag(i,j,ipnt,bi,bj).ne.undef ) |
|
|
. qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor |
|
61 |
enddo |
enddo |
62 |
enddo |
enddo |
|
ENDIF |
|
63 |
|
|
64 |
999 RETURN |
endif |
|
END |
|
65 |
|
|
66 |
subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp) |
999 return |
67 |
|
end |
68 |
|
|
69 |
|
subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp) |
70 |
C*********************************************************************** |
C*********************************************************************** |
|
C |
|
71 |
C PURPOSE |
C PURPOSE |
72 |
C Retrieve model diagnostic (No Averaging) |
C Retrieve averaged model diagnostic |
73 |
C INPUT: |
C INPUT: |
74 |
C lev ..... Model LEVEL |
C lev ..... Diagnostic LEVEL |
75 |
C ipoint ..... DIAGNOSTIC NUMBER FROM MENU |
C ipoint ..... DIAGNOSTIC NUMBER FROM MENU |
76 |
C undef ..... UNDEFINED VALUE |
C undef ..... UNDEFINED VALUE |
|
C im ..... X-DIMENSION |
|
|
C jm ..... Y-DIMENSION |
|
|
C nd ..... Number of 2-D Diagnostics |
|
77 |
C |
C |
78 |
C OUTPUT: |
C OUTPUT: |
79 |
C qtmp ..... DIAGNOSTIC QUANTITY |
C qtmp ..... AVERAGED DIAGNOSTIC QUANTITY |
80 |
C |
C |
81 |
C*********************************************************************** |
C*********************************************************************** |
82 |
implicit none |
implicit none |
83 |
|
|
84 |
|
#include "EEPARAMS.h" |
85 |
#include "CPP_OPTIONS.h" |
#include "CPP_OPTIONS.h" |
86 |
#include "SIZE.h" |
#include "SIZE.h" |
87 |
|
|
88 |
|
#ifdef ALLOW_FIZHI |
89 |
#include "fizhi_SIZE.h" |
#include "fizhi_SIZE.h" |
90 |
|
#else |
91 |
|
integer Nrphys |
92 |
|
parameter (Nrphys=1) |
93 |
|
#endif |
94 |
|
|
95 |
#include "diagnostics_SIZE.h" |
#include "diagnostics_SIZE.h" |
96 |
#include "diagnostics.h" |
#include "diagnostics.h" |
97 |
|
|
98 |
integer bi,bj |
integer myThid,lev,ipoint |
99 |
|
_RL undef |
100 |
|
_RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy) |
101 |
|
|
|
integer lev,ipoint |
|
102 |
integer i,j,ipnt,klev |
integer i,j,ipnt,klev |
103 |
_RL undef |
integer bi,bj |
104 |
_RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy) |
|
105 |
|
if (ipoint.lt.1) go to 999 |
106 |
|
|
107 |
|
klev = kdiag(ipoint) |
108 |
|
if(klev.ge.lev) then |
109 |
|
ipnt = idiag(ipoint) + lev - 1 |
110 |
|
|
111 |
|
do bj=myByLo(myThid), myByHi(myThid) |
112 |
|
do bi=myBxLo(myThid), myBxHi(myThid) |
113 |
|
|
114 |
do j = 1,sNy |
do j = 1,sNy |
115 |
do i = 1,sNx |
do i = 1,sNx |
116 |
qtmp(i,j,bi,bj) = undef |
if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then |
117 |
|
qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj) |
118 |
|
else |
119 |
|
qtmp(i,j,lev,bi,bj) = undef |
120 |
|
endif |
121 |
enddo |
enddo |
122 |
enddo |
enddo |
123 |
|
|
|
IF (IPOINT.LT.1) GO TO 999 |
|
|
|
|
|
KLEV = KDIAG(IPOINT) |
|
|
IF(KLEV.GE.LEV) THEN |
|
|
IPNT = IDIAG(IPOINT) + LEV - 1 |
|
|
do j = 1,sNy |
|
|
do i = 1,sNx |
|
|
qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj) |
|
124 |
enddo |
enddo |
125 |
enddo |
enddo |
|
ENDIF |
|
126 |
|
|
127 |
999 RETURN |
endif |
128 |
END |
|
129 |
|
999 return |
130 |
|
end |
131 |
subroutine clrindx (myThid,listnum) |
subroutine clrindx (myThid,listnum) |
132 |
C*********************************************************************** |
C*********************************************************************** |
133 |
C |
C |