/[MITgcm]/MITgcm/pkg/smooth/smooth_correl2dw.F
ViewVC logotype

Contents of /MITgcm/pkg/smooth/smooth_correl2dw.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.12 - (show annotations) (download)
Fri Jan 23 18:58:26 2015 UTC (9 years, 4 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, HEAD
Changes since 1.11: +2 -2 lines
- replace _EXCH_XY_RL macro with CALL EXCH_XY_RL
- replace _EXCH_XYZ_RL macro with CALL EXCH_XYZ_RL

1 C $Header: /u/gcmpack/MITgcm/pkg/smooth/smooth_correl2dw.F,v 1.11 2014/10/20 03:10:16 gforget Exp $
2 C $Name: $
3
4 #include "SMOOTH_OPTIONS.h"
5 #ifdef ALLOW_CTRL
6 # include "CTRL_OPTIONS.h"
7 #endif
8 #ifdef ALLOW_ECCO
9 # include "ECCO_OPTIONS.h"
10 #endif
11
12 subroutine smooth_correl2Dw (
13 U fld_in,mask_in,xx_gen_file,mythid)
14
15 C *==========================================================*
16 C | SUBROUTINE smooth_correl2Dw
17 C | o Routine that maps a 2D control field to physical units
18 C | by mutliplying it with 1/sqrt(weight)
19 C | after smooth_correl2D has been applied
20 C *==========================================================*
21
22 IMPLICIT NONE
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "GRID.h"
26 #include "PARAMS.h"
27 #include "SMOOTH.h"
28 #if (defined (ALLOW_CTRL) && defined (ECCO_CTRL_DEPRECATED))
29 # include "ctrl.h"
30 # include "CTRL_SIZE.h"
31 # include "CTRL_GENARR.h"
32 #endif
33 #if (defined (ALLOW_ECCO) && defined (ECCO_CTRL_DEPRECATED))
34 # include "ecco_cost.h"
35 #endif
36
37 _RL mask_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR,nSx,nSy)
38 _RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
39 character*(MAX_LEN_FNAM) xx_gen_file
40 integer myThid
41
42 #ifdef ECCO_CTRL_DEPRECATED
43
44 # if (defined ALLOW_CTRL) || (defined ALLOW_ECCO)
45
46 integer i,j,bi,bj
47 integer itlo,ithi
48 integer jtlo,jthi
49 _RL tmpW
50 LOGICAL weightWasFound
51 #if (defined (ALLOW_GENARR2D_CONTROL) || defined (ALLOW_GENARR3D_CONTROL) || defined (ALLOW_GENTIM2D_CONTROL))
52 INTEGER iarr
53 #endif
54
55 jtlo = mybylo(mythid)
56 jthi = mybyhi(mythid)
57 itlo = mybxlo(mythid)
58 ithi = mybxhi(mythid)
59
60
61 DO bj = jtlo,jthi
62 DO bi = itlo,ithi
63 DO j = 1,sNy
64 DO i = 1,sNx
65
66 weightWasFound=.TRUE.
67
68 if ( xx_gen_file .EQ. xx_hflux_file ) then
69 tmpW=whflux(i,j,bi,bj)
70 elseif ( xx_gen_file .EQ. xx_sflux_file ) then
71 tmpW=wsflux(i,j,bi,bj)
72 elseif ( xx_gen_file .EQ. xx_tauu_file ) then
73 tmpW=wtauu(i,j,bi,bj)
74 elseif ( xx_gen_file .EQ. xx_tauv_file ) then
75 tmpW=wtauv(i,j,bi,bj)
76
77 elseif ( xx_gen_file .EQ. xx_atemp_file ) then
78 tmpW=watemp(i,j,bi,bj)
79 elseif ( xx_gen_file .EQ. xx_aqh_file ) then
80 tmpW=waqh(i,j,bi,bj)
81 elseif ( xx_gen_file .EQ. xx_precip_file ) then
82 tmpW=wprecip(i,j,bi,bj)
83 elseif ( xx_gen_file .EQ. xx_snowprecip_file ) then
84 tmpW=wsnowprecip(i,j,bi,bj)
85
86 elseif ( xx_gen_file .EQ. xx_swflux_file ) then
87 tmpW=wswflux(i,j,bi,bj)
88 elseif ( xx_gen_file .EQ. xx_swdown_file ) then
89 tmpW=wswdown(i,j,bi,bj)
90 elseif ( xx_gen_file .EQ. xx_lwflux_file ) then
91 tmpW=wlwflux(i,j,bi,bj)
92 elseif ( xx_gen_file .EQ. xx_lwdown_file ) then
93 tmpW=wlwdown(i,j,bi,bj)
94
95 elseif ( xx_gen_file .EQ. xx_evap_file ) then
96 tmpW=wevap(i,j,bi,bj)
97 elseif ( xx_gen_file .EQ. xx_apressure_file ) then
98 tmpW=wapressure(i,j,bi,bj)
99 elseif ( xx_gen_file .EQ. xx_uwind_file ) then
100 tmpW=wuwind(i,j,bi,bj)
101 elseif ( xx_gen_file .EQ. xx_vwind_file ) then
102 tmpW=wvwind(i,j,bi,bj)
103
104 else
105 tmpW=0.
106 weightWasFound=.FALSE.
107 endif
108
109 #ifdef ALLOW_CTRL
110 #ifdef ALLOW_GENTIM2D_CONTROL
111 do iarr = 1, maxCtrlTim2D
112 if ( xx_gen_file .EQ. xx_gentim2d_file(iarr) ) then
113 tmpW=wgentim2d(i,j,bi,bj,iarr)
114 weightWasFound=.TRUE.
115 endif
116 enddo
117 #endif
118 #endif
119
120 if ((mask_in(i,j,1,bi,bj).NE.0.).AND.(tmpW.NE.0.)) then
121 fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)/sqrt(tmpW)
122 else
123 fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)*0.
124 endif
125
126 ENDDO
127 ENDDO
128 ENDDO
129 ENDDO
130
131 CALL EXCH_XY_RL ( fld_in , myThid )
132
133 if (.NOT.weightWasFound) WRITE(errorMessageUnit,'(2A)' )
134 & 'WARNING: no weights found for ',xx_gen_file
135
136 #endif /* ALLOW_ECCO or ALLOW_CTRL */
137
138 #endif /* ECCO_CTRL_DEPRECATED */
139
140 end

  ViewVC Help
Powered by ViewVC 1.1.22