C $Header: /u/gcmpack/MITgcm/pkg/smooth/smooth_correl2dw.F,v 1.12 2015/01/23 18:58:26 gforget Exp $
C $Name: $
#include "SMOOTH_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif
#ifdef ALLOW_ECCO
# include "ECCO_OPTIONS.h"
#endif
subroutine SMOOTH_CORREL2DW (
U fld_in,mask_in,xx_gen_file,mythid)
C *==========================================================*
C | SUBROUTINE smooth_correl2Dw
C | o Routine that maps a 2D control field to physical units
C | by mutliplying it with 1/sqrt(weight)
C | after smooth_correl2D has been applied
C *==========================================================*
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "GRID.h"
#include "PARAMS.h"
#include "SMOOTH.h"
#if (defined (ALLOW_CTRL) defined (ECCO_CTRL_DEPRECATED))
# include "ctrl.h"
# include "CTRL_SIZE.h"
# include "CTRL_GENARR.h"
#endif
#if (defined (ALLOW_ECCO) defined (ECCO_CTRL_DEPRECATED))
# include "ecco_cost.h"
#endif
_RL mask_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR,nSx,nSy)
_RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
character*(MAX_LEN_FNAM) xx_gen_file
integer myThid
#ifdef ECCO_CTRL_DEPRECATED
# if (defined ALLOW_CTRL) (defined ALLOW_ECCO)
integer i,j,bi,bj
integer itlo,ithi
integer jtlo,jthi
_RL tmpW
LOGICAL weightWasFound
#if (defined (ALLOW_GENARR2D_CONTROL) defined (ALLOW_GENARR3D_CONTROL) defined (ALLOW_GENTIM2D_CONTROL))
INTEGER iarr
#endif
jtlo = mybylo(mythid)
jthi = mybyhi(mythid)
itlo = mybxlo(mythid)
ithi = mybxhi(mythid)
DO bj = jtlo,jthi
DO bi = itlo,ithi
DO j = 1,sNy
DO i = 1,sNx
weightWasFound=.TRUE.
if ( xx_gen_file .EQ. xx_hflux_file ) then
tmpW=whflux(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_sflux_file ) then
tmpW=wsflux(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_tauu_file ) then
tmpW=wtauu(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_tauv_file ) then
tmpW=wtauv(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_atemp_file ) then
tmpW=watemp(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_aqh_file ) then
tmpW=waqh(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_precip_file ) then
tmpW=wprecip(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_snowprecip_file ) then
tmpW=wsnowprecip(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_swflux_file ) then
tmpW=wswflux(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_swdown_file ) then
tmpW=wswdown(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_lwflux_file ) then
tmpW=wlwflux(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_lwdown_file ) then
tmpW=wlwdown(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_evap_file ) then
tmpW=wevap(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_apressure_file ) then
tmpW=wapressure(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_uwind_file ) then
tmpW=wuwind(i,j,bi,bj)
elseif ( xx_gen_file .EQ. xx_vwind_file ) then
tmpW=wvwind(i,j,bi,bj)
else
tmpW=0.
weightWasFound=.FALSE.
endif
#ifdef ALLOW_CTRL
#ifdef ALLOW_GENTIM2D_CONTROL
do iarr = 1, maxCtrlTim2D
if ( xx_gen_file .EQ. xx_gentim2d_file(iarr) ) then
tmpW=wgentim2d(i,j,bi,bj,iarr)
weightWasFound=.TRUE.
endif
enddo
#endif
#endif
if ((mask_in(i,j,1,bi,bj).NE.0.).AND.(tmpW.NE.0.)) then
fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)/sqrt(tmpW)
else
fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)*0.
endif
ENDDO
ENDDO
ENDDO
ENDDO
CALL EXCH_XY_RL ( fld_in , myThid )
if (.NOT.weightWasFound) WRITE(errorMessageUnit,'(2A)' )
& 'WARNING: no weights found for ',xx_gen_file
#endif /* ALLOW_ECCO or ALLOW_CTRL */
#endif /* ECCO_CTRL_DEPRECATED */
end