Ocean Modeling Discussion

ROMS/TOMS

Search for:
It is currently Fri Sep 22, 2017 9:55 am




Post new topic Reply to topic  [ 6 posts ] 

All times are UTC

Author Message
PostPosted: Wed Jun 07, 2017 4:49 am 
Offline

Joined: Thu May 04, 2017 1:31 pm
Posts: 5
Location: south china sea insitute of oceanography
Hi , every one·
I try to run bio_toy example ,but i got the error message: "analytical.f90(362): error #5082: Syntax error, found END-OF-STATEMENT when expecting one of: ) ,
& real(r8), dimension(8), intent(in) :: r_date"
I can sucessfully run the other examples (i.e. UPWELLING, BASIN, BL_TEST) except the bio_toy example. Should I change somethings in "ana_grd.h"? I attached the original ana_grd.h below. i did not change anything in the file ana_grd.h. It is odd i can run UPWELLING example directly without changing anythin in ana_grd.h, but can not run bio_toy.

the error message:
ar r Build/libMODS.a Build/mod_arrays.o Build/mod_average.o Build/mod_bbl.o Build/mod_behavior.o Build/mod_biology.o Build/mod_boundary.o Build/mod_clima.o Build/mod_coupler.o Build/mod_coupling.o Build/mod_diags.o Build/mod_eclight.o Build/mod_eoscoef.o Build/mod_floats.o Build/mod_forces.o Build/mod_fourdvar.o Build/mod_grid.o Build/mod_iounits.o Build/mod_kinds.o Build/mod_mixing.o Build/mod_ncparam.o Build/mod_nesting.o Build/mod_netcdf.o Build/mod_ocean.o Build/mod_parallel.o Build/mod_param.o Build/mod_scalars.o Build/mod_sedbed.o Build/mod_sediment.o Build/mod_sources.o Build/mod_stepping.o Build/mod_storage.o Build/mod_strings.o Build/mod_tides.o
analytical.f90(362): error #5082: Syntax error, found END-OF-STATEMENT when expecting one of: ) ,
& real(r8), dimension(8), intent(in) :: r_date
--------------------------------------------------------------------^
analytical.f90(364): error #5276: Unbalanced parentheses
cloud)
-------------------^
analytical.f90(364): error #5082: Syntax error, found ')' when expecting one of: ( % [ : . = =>
cloud)
-------------------^
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 posterior_var.f90
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 step2d.f90
ar: creating Build/libMODS.a
analytical.f90(363): error #6236: A specification statement cannot appear in the executable section.
real(r8), dimension(8), intent(in) :: r_date
------^
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 convolve.f90
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 propagator.f90
analytical.f90(362): error #6404: This name does not have a type, and must have an explicit type. [DIMENSION]
& real(r8), dimension(8), intent(in) :: r_date
----------------------------------^
analytical.f90(362): error #6200: A colon (:) is not valid in this context.
& real(r8), dimension(8), intent(in) :: r_date
------------------------------------------------^
analytical.f90(360): error #6784: The number of actual arguments cannot be greater than the number of dummy arguments. [EXCHANGE_R2D_TILE]
CALL exchange_r2d_tile (ng, tile, &
-------------^
analytical.f90(362): error #6633: The type of the actual argument differs from the type of the dummy argument. [REAL]
& real(r8), dimension(8), intent(in) :: r_date
------------------------^
analytical.f90(362): error #6638: An actual argument is an expression or constant; this is not valid since the associated dummy argument has the explicit INTENT(OUT) or INTENT(INOUT) attribute. [REAL]
& real(r8), dimension(8), intent(in) :: r_date
------------------------^
analytical.f90(362): error #6634: The shape matching rules of actual arguments and dummy arguments have been violated. [REAL]
& real(r8), dimension(8), intent(in) :: r_date
------------------------^
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 get_grid.f90
cd Build; /usr/local/mpi3-dynamic/bin/mpif90 -c -heap-arrays -fp-model precise -ip -O3 step3d_t.f90
compilation aborted for analytical.f90 (code 1)
gmake: *** [Build/analytical.o] Error 1
gmake: *** Waiting for unfinished jobs....
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ranlib Build/libMODS.a
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.
ifort: command line warning #10212: -fp-model precise evaluates in source precision with Fortran.




ana_grd.h

SUBROUTINE ana_grid (ng, tile, model)
!
!! svn $Id: ana_grid.h 830 2017-01-24 21:21:11Z arango $
!!======================================================================
!! Copyright (c) 2002-2017 The ROMS/TOMS Group !
!! Licensed under a MIT/X style license !
!! See License_ROMS.txt !
!=======================================================================
! !
! This routine sets model grid using an analytical expressions. !
! !
! On Output: stored in common blocks: !
! !
! "grid" (file grid.h) !
! "scalars" (file scalar.h) !
! !
! el Length (m) of domain box in the ETA-direction. !
! f Coriolis parameter (1/seconds) at RHO-points. !
! h Bathymetry (meters; positive) at RHO-points. !
! hmin Minimum depth of bathymetry (m). !
! hmax Maximum depth of bathymetry (m). !
! pm Coordinate transformation metric "m" (1/meters) !
! associated with the differential distances in XI !
! at RHO-points. !
! pn Coordinate transformation metric "n" (1/meters) !
! associated with the differential distances in ETA. !
! at RHO-points. !
! xl Length (m) of domain box in the XI-direction. !
! xp XI-coordinates (m) at PSI-points. !
! xr XI-coordinates (m) at RHO-points. !
! yp ETA-coordinates (m) at PSI-points. !
! yr ETA-coordinates (m) at RHO-points. !
! !
!=======================================================================
!
USE mod_param
USE mod_grid
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model

#include "tile.h"
!
CALL ana_grid_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& GRID(ng) % angler, &
#if defined CURVGRID && defined UV_ADV
& GRID(ng) % dmde, &
& GRID(ng) % dndx, &
#endif
#ifdef ICESHELF
& GRID(ng) % zice, &
#endif
#ifdef SPHERICAL
& GRID(ng) % lonp, &
& GRID(ng) % lonr, &
& GRID(ng) % lonu, &
& GRID(ng) % lonv, &
& GRID(ng) % latp, &
& GRID(ng) % latr, &
& GRID(ng) % latu, &
& GRID(ng) % latv, &
#else
& GRID(ng) % xp, &
& GRID(ng) % xr, &
& GRID(ng) % xu, &
& GRID(ng) % xv, &
& GRID(ng) % yp, &
& GRID(ng) % yr, &
& GRID(ng) % yu, &
& GRID(ng) % yv, &
#endif
& GRID(ng) % pn, &
& GRID(ng) % pm, &
& GRID(ng) % f, &
& GRID(ng) % h)
!
! Set analytical header file name used.
!
#ifdef DISTRIBUTE
IF (Lanafile) THEN
#else
IF (Lanafile.and.(tile.eq.0)) THEN
#endif
ANANAME( 7)=__FILE__
END IF

RETURN
END SUBROUTINE ana_grid
!
!***********************************************************************
SUBROUTINE ana_grid_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& angler, &
#if defined CURVGRID && defined UV_ADV
& dmde, dndx, &
#endif
#ifdef ICESHELF
& zice, &
#endif
#ifdef SPHERICAL
& lonp, lonr, lonu, lonv, &
& latp, latr, latu, latv, &
#else
& xp, xr, xu, xv, &
& yp, yr, yu, yv, &
#endif
& pn, pm, f, h)
!***********************************************************************
!
USE mod_param
USE mod_parallel
USE mod_scalars
!
#ifdef DISTRIBUTE
USE distribute_mod, ONLY : mp_reduce
#endif
USE exchange_2d_mod, ONLY : exchange_r2d_tile
#ifdef DISTRIBUTE
USE mp_exchange_mod, ONLY : mp_exchange2d
#endif
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
#ifdef ASSUMED_SHAPE
real(r8), intent(out) :: angler(LBi:,LBj:)
# if defined CURVGRID && defined UV_ADV
real(r8), intent(out) :: dmde(LBi:,LBj:)
real(r8), intent(out) :: dndx(LBi:,LBj:)
# endif
# ifdef ICESHELF
real(r8), intent(out) :: zice(LBi:,LBj:)
# endif
# ifdef SPHERICAL
real(r8), intent(out) :: lonp(LBi:,LBj:)
real(r8), intent(out) :: lonr(LBi:,LBj:)
real(r8), intent(out) :: lonu(LBi:,LBj:)
real(r8), intent(out) :: lonv(LBi:,LBj:)
real(r8), intent(out) :: latp(LBi:,LBj:)
real(r8), intent(out) :: latr(LBi:,LBj:)
real(r8), intent(out) :: latu(LBi:,LBj:)
real(r8), intent(out) :: latv(LBi:,LBj:)
# else
real(r8), intent(out) :: xp(LBi:,LBj:)
real(r8), intent(out) :: xr(LBi:,LBj:)
real(r8), intent(out) :: xu(LBi:,LBj:)
real(r8), intent(out) :: xv(LBi:,LBj:)
real(r8), intent(out) :: yp(LBi:,LBj:)
real(r8), intent(out) :: yr(LBi:,LBj:)
real(r8), intent(out) :: yu(LBi:,LBj:)
real(r8), intent(out) :: yv(LBi:,LBj:)
# endif
real(r8), intent(out) :: pn(LBi:,LBj:)
real(r8), intent(out) :: pm(LBi:,LBj:)
real(r8), intent(out) :: f(LBi:,LBj:)
real(r8), intent(out) :: h(LBi:,LBj:)
#else
real(r8), intent(out) :: angler(LBi:UBi,LBj:UBj)
# if defined CURVGRID && defined UV_ADV
real(r8), intent(out) :: dmde(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: dndx(LBi:UBi,LBj:UBj)
# endif
# ifdef ICESHELF
real(r8), intent(out) :: zice(LBi:UBi,LBj:UBj)
# endif
# ifdef SPHERICAL
real(r8), intent(out) :: lonp(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: lonr(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: lonu(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: lonv(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: latp(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: latr(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: latu(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: latv(LBi:UBi,LBj:UBj)
# else
real(r8), intent(out) :: xp(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: xr(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: xu(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: xv(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: yp(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: yr(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: yu(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: yv(LBi:UBi,LBj:UBj)
# endif
real(r8), intent(out) :: pn(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: pm(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: f(LBi:UBi,LBj:UBj)
real(r8), intent(out) :: h(LBi:UBi,LBj:UBj)
#endif
!
! Local variable declarations.
!
integer :: Imin, Imax, Jmin, Jmax
integer :: NSUB, i, ival, j, k

real(r8), parameter :: twopi = 2.0_r8*pi

real(r8) :: Esize, Xsize, beta, cff, depth, dth
real(r8) :: dx, dy, f0, my_min, my_max, r, theta, val1, val2

#ifdef DISTRIBUTE
real(r8), dimension(2) :: buffer
character (len=3), dimension(2) :: op_handle
#endif
#ifdef WEDDELL
real(r8) :: hwrk(-1:235), xwrk(-1:235), zwrk
#endif
real(r8) :: wrkX(IminS:ImaxS,JminS:JmaxS)
real(r8) :: wrkY(IminS:ImaxS,JminS:JmaxS)

#include "set_bounds.h"
!
!-----------------------------------------------------------------------
! Set grid parameters:
!
! Xsize Length (m) of domain box in the XI-direction.
! Esize Length (m) of domain box in the ETA-direction.
! depth Maximum depth of bathymetry (m).
! f0 Coriolis parameter, f-plane constant (1/s).
! beta Coriolis parameter, beta-plane constant (1/s/m).
!-----------------------------------------------------------------------
!
#if defined BASIN
Xsize=3600.0E+03_r8
Esize=2800.0E+03_r8
depth=5000.0_r8
f0=1.0E-04_r8
beta=2.0E-11_r8
#elif defined BENCHMARK
Xsize=360.0_r8 ! degrees of longitude
Esize=20.0_r8 ! degrees of latitude
depth=4000.0_r8
f0=-1.0E-04_r8
beta=2.0E-11_r8
#elif defined BL_TEST
Xsize=100.0E+03_r8
Esize=5.0E+03_r8
depth=47.5_r8
f0=9.25E-04_r8
beta=0.0_r8
#elif defined CHANNEL
Xsize=600.0E+03_r8
Esize=360.0E+03_r8
depth=500.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined CANYON
Xsize=128.0E+03_r8
Esize=96.0E+03_r8
depth=4000.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined COUPLING_TEST
Xsize=6000.0_r8*REAL(Lm(ng),r8)
Esize=6000.0_r8*REAL(Mm(ng),r8)
depth=1500.0_r8
f0=5.0E-05_r8
beta=0.0_r8
#elif defined DOUBLE_GYRE
Xsize=1000.0E+03_r8
Esize=2000.0E+03_r8
depth=500.0_r8
!! depth=5000.0_r8
f0=7.3E-05_r8
beta=2.0E-11_r8
#elif defined ESTUARY_TEST
Xsize=100000.0_r8
Esize=300.0_r8
depth=10.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined KELVIN
Xsize=20000.0_r8*REAL(Lm(ng),r8)
Esize=20000.0_r8*REAL(Mm(ng),r8)
depth=100.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined FLT_TEST
Xsize=1.0E+03_r8*REAL(Lm(ng),r8)
Esize=1.0E+03_r8*REAL(Mm(ng),r8)
depth=10.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined GRAV_ADJ
Xsize=64.0E+03_r8
Esize=2.0E+03_r8
depth=20.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined LAB_CANYON
Xsize=0.55_r8 ! width of annulus
Esize=2.0_r8*pi ! azimuthal length (radians)
f0=4.0_r8*pi/25.0_r8
beta=0.0_r8
#elif defined LAKE_SIGNELL
Xsize=50.0e3_r8
Esize=10.0e3_r8
depth=18.0_r8
f0=0.0E-04_r8
beta=0.0_r8
#elif defined LMD_TEST
Xsize=100.0E+03_r8
Esize=100.0E+03_r8
depth=50.0_r8
f0=1.09E-04_r8
beta=0.0_r8
# elif defined MIXED_LAYER
Xsize=500.0_r8
Esize=400.0_r8
depth=50.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined OVERFLOW
Xsize=4.0E+03_r8
Esize=200.0E+03_r8
depth=4000.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined RIVERPLUME1
Xsize=58.5E+03_r8
Esize=201.0E+03_r8
depth=150.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined RIVERPLUME2
Xsize=100.0E+03_r8
Esize=210.0E+03_r8
depth=190.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined SEAMOUNT
Xsize=320.0E+03_r8
Esize=320.0E+03_r8
depth=5000.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#elif defined SOLITON
!! Xsize=0.5_r8*REAL(Lm(ng),r8)
!! Esize=0.5_r8*REAL(Mm(ng),r8)
Xsize=48.0_r8
Esize=16.0_r8
depth=1.0_r8
f0=0.0_r8
beta=1.0_r8
g=1.0_r8
#elif defined SED_TEST1
Xsize=300.0_r8
Esize=36.0_r8
depth=10.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined SED_TOY
Xsize=40.0_r8
Esize=30.0_r8
depth=0.5_r8
f0=0.0_r8
beta=0.0_r8
# elif defined SHOREFACE
Xsize=1180.0_r8
Esize=140.0_r8
depth=15.0_r8
f0=0.0E-04_r8
beta=0.0_r8
#elif defined TEST_CHAN
Xsize=10000.0_r8
Esize=1000.0_r8
depth=10.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined UPWELLING
Xsize=1000.0_r8*REAL(Lm(ng),r8)
Esize=1000.0_r8*REAL(Mm(ng),r8)
depth=150.0_r8
f0=-8.26E-05_r8
beta=0.0_r8
#elif defined WEDDELL
Xsize=4000.0_r8*REAL(Lm(ng),r8)
Esize=4000.0_r8*REAL(Mm(ng),r8)
depth=4500.0_r8
f0=0.0_r8
beta=0.0_r8
#elif defined WINDBASIN
Xsize=2000.0_r8*REAL(Lm(ng),r8)
Esize=1000.0_r8*REAL(Mm(ng),r8)
depth=50.0_r8
f0=1.0E-04_r8
beta=0.0_r8
#else
ana_grid.h: no values provided for Xsize, Esize, depth, f0, beta.
#endif
!
! Load grid parameters to global storage.
!
IF (DOMAIN(ng)%SouthWest_Test(tile)) THEN
xl(ng)=Xsize
el(ng)=Esize
END IF
!
!-----------------------------------------------------------------------
! Compute the (XI,ETA) coordinates at PSI- and RHO-points.
! Set grid spacing (m).
!-----------------------------------------------------------------------
!
! Determine I- and J-ranges for computing grid data. These ranges
! are special in periodic boundary conditons since periodicity cannot
! be imposed in the grid coordinates.
!
IF (DOMAIN(ng)%Western_Edge(tile)) THEN
Imin=Istr-1
ELSE
Imin=Istr
END IF
IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN
Imax=Iend+1
ELSE
Imax=Iend
END IF
IF (DOMAIN(ng)%Southern_Edge(tile)) THEN
Jmin=Jstr-1
ELSE
Jmin=Jstr
END IF
IF (DOMAIN(ng)%Northern_Edge(tile)) THEN
Jmax=Jend+1
ELSE
Jmax=Jend
END IF

#if defined BENCHMARK
!
! Spherical coordinates set-up.
!
dx=Xsize/REAL(Lm(ng),r8)
dy=Esize/REAL(Mm(ng),r8)
spherical=.TRUE.
DO j=Jmin,Jmax
val1=-70.0_r8+dy*(REAL(j,r8)-0.5_r8)
val2=-70.0_r8+dy*REAL(j,r8)
DO i=Imin,Imax
lonr(i,j)=dx*(REAL(i,r8)-0.5_r8)
latr(i,j)=val1
lonu(i,j)=dx*REAL(i,r8)
lonp(i,j)=lonu(i,j)
latu(i,j)=latr(i,j)
lonv(i,j)=lonr(i,j)
latv(i,j)=val2
latp(i,j)=latv(i,j)
END DO
END DO
#elif defined LAB_CANYON
!
! Polar coordinates set-up.
!
dx=Xsize/REAL(Lm(ng),r8)
dy=Esize/REAL(Mm(ng),r8)
!! dth=twopi/REAL(Mm(ng),r8) ! equal azimultal spacing
dth=0.01_r8 ! azimultal spacing
cff=(4.0_r8*pi/(dth*REAL(Mm(ng),r8)))-1.0_r8 ! F
DO j=Jmin,Jmax
DO i=Imin,Imax
r=0.35_r8+dx*REAL(i-1,r8)
theta=-pi+ &
& 0.5_r8*dth*((cff+1.0_r8)*REAL(j-1,r8)+ &
& (cff-1.0_r8)*(REAL(Mm(ng),r8)/twopi)* &
& SIN(twopi*REAL(j-1,r8)/REAL(Mm(ng),r8)))
xp(i,j)=r*COS(theta)
yp(i,j)=r*SIN(theta)
r=0.35_r8+dx*(REAL(i-1,r8)+0.5_r8)
theta=-pi+ &
& 0.5_r8*dth*((cff+1.0_r8)*(REAL(j-1,r8)+0.5_r8)+ &
& (cff-1.0_r8)*(REAL(Mm(ng),r8)/twopi)* &
& SIN(twopi*(REAL(j-1,r8)+0.5_r8)/ &
& REAL(Mm(ng),r8)))
xr(i,j)=r*COS(theta)
yr(i,j)=r*SIN(theta)
xu(i,j)=xp(i,j)
yu(i,j)=yr(i,j)
xv(i,j)=xr(i,j)
yv(i,j)=yp(i,j)
END DO
END DO
#else
dx=Xsize/REAL(Lm(ng),r8)
dy=Esize/REAL(Mm(ng),r8)
DO j=Jmin,Jmax
DO i=Imin,Imax
# ifdef BL_TEST
dx=0.5_r8*(4000.0_r8/REAL(Lm(ng)+1,r8))*REAL(i,r8)+675.0_r8
# endif
xp(i,j)=dx*REAL(i-1,r8)
xr(i,j)=dx*(REAL(i-1,r8)+0.5_r8)
xu(i,j)=xp(i,j)
xv(i,j)=xr(i,j)
yp(i,j)=dy*REAL(j-1,r8)
yr(i,j)=dy*(REAL(j-1,r8)+0.5_r8)
yu(i,j)=yr(i,j)
yv(i,j)=yp(i,j)
END DO
END DO
#endif

#ifdef DISTRIBUTE
!
! Exchange boundary data.
!
# ifdef SPHERICAL
CALL mp_exchange2d (ng, tile, model, 4, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, .FALSE., .FALSE., &
& lonp, lonr, lonu, lonv)
CALL mp_exchange2d (ng, tile, model, 4, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, .FALSE., .FALSE., &
& latp, latr, latu, latv)
# else
CALL mp_exchange2d (ng, tile, model, 4, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, .FALSE., .FALSE., &
& xp, xr, xu, xv)
CALL mp_exchange2d (ng, tile, model, 4, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, .FALSE., .FALSE., &
& yp, yr, yu, yv)
# endif
#endif
!
!-----------------------------------------------------------------------
! Compute coordinate transformation metrics at RHO-points "pm" and
! "pn" (1/m) associated with the differential distances in XI and
! ETA, respectively.
!-----------------------------------------------------------------------
!
#define J_RANGE MIN(JstrT,Jstr-1),MAX(Jend+1,JendT)
#define I_RANGE MIN(IstrT,Istr-1),MAX(Iend+1,IendT)

#if defined BENCHMARK
!
! Spherical coordinates set-up.
!
val1=REAL(Lm(ng),r8)/(2.0_r8*pi*Eradius)
val2=REAL(Mm(ng),r8)*360.0_r8/(2.0_r8*pi*Eradius*Esize)
DO j=J_RANGE
cff=1.0_r8/COS((-70.0_r8+dy*(REAL(j,r8)-0.5_r8))*deg2rad)
DO i=I_RANGE
wrkX(i,j)=val1*cff
wrkY(i,j)=val2
END DO
END DO
#elif defined LAB_CANYON
!
! Polar coordinates set-up.
!
DO j=J_RANGE
DO i=I_RANGE
r=0.35_r8+dx*(REAL(i-1,r8)+0.5_r8)
theta=0.5_r8*dth*((cff+1.0_r8)+ &
& (cff-1.0_r8)* &
& COS(twopi*REAL(j-1,r8)/REAL(Mm(ng),r8)))
wrkX(i,j)=1.0_r8/dx
wrkY(i,j)=1.0_r8/(r*theta)
END DO
END DO
#else
DO j=J_RANGE
DO i=I_RANGE
# ifdef BL_TEST
dx=0.5_r8*(4000.0_r8/REAL(Lm(ng)+1,r8))*REAL(i,r8)+675.0_r8
# endif
wrkX(i,j)=1.0_r8/dx
wrkY(i,j)=1.0_r8/dy
END DO
END DO
#endif
#undef J_RANGE
#undef I_RANGE
DO j=JstrT,JendT
DO i=IstrT,IendT
pm(i,j)=wrkX(i,j)
pn(i,j)=wrkY(i,j)
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& pm)
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& pn)
END IF

#ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 2, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& pm, pn)
#endif

#if (defined CURVGRID && defined UV_ADV)
!
!-----------------------------------------------------------------------
! Compute d(1/n)/d(xi) and d(1/m)/d(eta) at RHO-points.
!-----------------------------------------------------------------------
!
DO j=Jstr,Jend
DO i=Istr,Iend
dndx(i,j)=0.5_r8*((1.0_r8/wrkY(i+1,j ))- &
& (1.0_r8/wrkY(i-1,j )))
dmde(i,j)=0.5_r8*((1.0_r8/wrkX(i ,j+1))- &
& (1.0_r8/wrkX(i ,j-1)))
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& dndx)
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& dmde)
END IF

# ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 2, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& dndx, dmde)
# endif
#endif
!
!-----------------------------------------------------------------------
! Angle (radians) between XI-axis and true EAST at RHO-points.
!-----------------------------------------------------------------------
!
#if defined LAB_CANYON
DO j=JstrT,JendT
DO i=IstrT,IendT
theta=-pi+ &
& 0.5_r8*dth*((cff+1.0_r8)*(REAL(j-1,r8)+0.5_r8)+ &
& (cff-1.0_r8)*(REAL(Mm(ng),r8)/twopi)* &
& SIN(twopi*(REAL(j-1,r8)+0.5_r8)/ &
& REAL(Mm(ng),r8)))
angler(i,j)=theta
END DO
END DO
#elif defined WEDDELL
val1=90.0_r8*deg2rad
DO j=JstrT,JendT
DO i=IstrT,IendT
angler(i,j)=val1
END DO
END DO
#else
DO j=JstrT,JendT
DO i=IstrT,IendT
angler(i,j)=0.0_r8
END DO
END DO
#endif
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& angler)
END IF

#ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& angler)
#endif
!
!-----------------------------------------------------------------------
! Compute Coriolis parameter (1/s) at RHO-points.
!-----------------------------------------------------------------------
!
#if defined BENCHMARK
val1=2.0_r8*(2.0_r8*pi*366.25_r8/365.25_r8)/86400.0_r8
DO j=JstrT,JendT
DO i=IstrT,IendT
f(i,j)=val1*SIN(latr(i,j)*deg2rad)
END DO
END DO
#elif defined WEDDELL
val1=10.4_r8/REAL(Lm(ng),r8)
DO j=JstrT,JendT
DO i=IstrT,IendT
f(i,j)=2.0_r8*7.2E-05_r8* &
& SIN((-79.0_r8+REAL(i-1,r8)*val1)*deg2rad)
END DO
END DO
#else
val1=0.5_r8*Esize
DO j=JstrT,JendT
DO i=IstrT,IendT
f(i,j)=f0+beta*(yr(i,j)-val1)
END DO
END DO
#endif
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& f)
END IF

#ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& f)
#endif
!
!-----------------------------------------------------------------------
! Set bathymetry (meters; positive) at RHO-points.
!-----------------------------------------------------------------------
!
#if defined BENCHMARK
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=500.0_r8+1750.0_r8*(1.0+TANH((68.0_r8+latr(i,j))/dy))
END DO
END DO
#elif defined BL_TEST
DO j=JstrT,JendT
DO i=IstrT,IendT
val1=(xr(i,j)+500.0_r8)/15000.0_r8
h(i,j)=14.0_r8+ &
& 25.0_r8*(1.0_r8-EXP(-pi*xr(i,j)*1.0E-05_r8))- &
& 8.0_r8*EXP(-val1*val1)
END DO
END DO
#elif defined CANYON
DO j=JstrT,JendT
DO i=IstrT,IendT
val1=32000.0_r8-16000.0_r8*(SIN(pi*xr(i,j)/Xsize))**24
h(i,j)=20.0_r8+0.5_r8*(depth-20.0_r8)* &
& (1.0_r8+TANH((yr(i,j)-val1)/10000.0_r8))
END DO
END DO
#elif defined ESTUARY_TEST
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=5.0_r8+(Xsize-xr(i,j))/Xsize*5.0_r8
END DO
END DO
#elif defined LAB_CANYON
DO j=JstrT,JendT
DO i=IstrT,IendT
r=0.35_r8+dx*(REAL(i-1,r8)+0.5_r8)
theta=-pi+ &
& 0.5_r8*dth*((cff+1.0_r8)*(REAL(j-1,r8)+0.5_r8)+ &
& (cff-1.0_r8)*(REAL(Mm(ng),r8)/twopi)* &
& SIN(dth*(REAL(j-1,r8)+0.5_r8)/ &
& REAL(Mm(ng),r8)))
val1=0.55_r8-0.15_r8*(COS(pi*theta*0.55_r8/0.2_r8)**2) !r_small
val2=0.15_r8+0.15_r8*(COS(pi*theta*0.55_r8/0.2_r8)**2) !lambda
IF (ABS(theta).ge.0.181818181818_r8) THEN
IF (r.le.0.55_r8) THEN
h(i,j)=0.025_r8 ! shelf
ELSE IF (r.ge.0.7_r8) THEN
h(i,j)=0.125_r8 ! deep
ELSE
h(i,j)=0.125_r8-0.1_r8* &
& (COS(0.5_r8*pi*(r-0.55_r8)/0.15_r8)**2)
END IF
ELSE
IF (r.le.val1) THEN
h(i,j)=0.025_r8 ! shelf
ELSE IF (r.ge.0.7_r8) THEN
h(i,j)=0.125_r8 ! deep
ELSE
h(i,j)=0.125_r8-0.1_r8* &
& (COS(0.5_r8*pi*(r-val1)/val2)**2)
END IF
END IF
END DO
END DO
#elif defined LAKE_SIGNELL
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=18.0_r8-16.0_r8*REAL(Mm(ng)-j,r8)/REAL(Mm(ng)-1,r8)
END DO
END DO
# elif defined MIXED_LAYER
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=50.0_r8
END DO
END DO
#elif defined OVERFLOW
val1=200.0_r8
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=val1+0.5_r8*(depth-val1)* &
& (1.0_r8+TANH((yr(i,j)-100000.0_r8)/20000.0_r8))
END DO
END DO
#elif defined RIVERPLUME1
DO j=JstrT,JendT
DO i=IstrT,MIN(5,IendT)
h(i,j)=15.0_r8
END DO
DO i=MAX(6,IstrT),IendT
h(i,j)=depth+REAL(Lm(ng)-i,r8)*(15.0_r8-depth)/ &
& REAL(Lm(ng)-6,r8)
END DO
END DO
#elif defined RIVERPLUME2
DO j=JstrT,JendT
DO i=IstrT,MIN(5,IendT)
h(i,j)=15.0_r8
END DO
DO i=MAX(6,IstrT),IendT
h(i,j)=depth+REAL(Lm(ng)-i,r8)*(15.0_r8-depth)/ &
& REAL(Lm(ng)-6,r8)
END DO
END DO
#elif defined SEAMOUNT
DO j=JstrT,JendT
DO i=IstrT,IendT
val1=(xr(i,j)-0.5_r8*Xsize)/40000.0_r8
val2=(yr(i,j)-0.5_r8*Esize)/40000.0_r8
h(i,j)=depth-4500.0_r8*EXP(-(val1*val1+val2*val2))
END DO
END DO
#elif defined SED_TOY
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=20.0_r8
END DO
END DO
#elif defined SHOREFACE
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=11.75_r8-0.0125_r8*Xsize/REAL(Lm(ng)+1,r8)*REAL(i,r8)
END DO
END DO
#elif defined TEST_CHAN
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=10.0_r8+0.4040_r8*REAL(i,r8)/REAL(Lm(ng)+1,r8)
END DO
END DO
#elif defined UPWELLING
IF (NSperiodic(ng)) THEN
DO i=IstrT,IendT
IF (i.le.Lm(ng)/2) THEN
val1=REAL(i,r8)
ELSE
val1=REAL(Lm(ng)+1-i,r8)
END IF
val2=MIN(depth,84.5_r8+66.526_r8*TANH((val1-10.0_r8)/7.0_r8))
DO j=JstrT,JendT
h(i,j)=val2
END DO
END DO
ELSE IF (EWperiodic(ng)) THEN
DO j=JstrT,JendT
IF (j.le.Mm(ng)/2) THEN
val1=REAL(j,r8)
ELSE
val1=REAL(Mm(ng)+1-j,r8)
END IF
val2=MIN(depth,84.5_r8+66.526_r8*TANH((val1-10.0_r8)/7.0_r8))
DO i=IstrT,IendT
h(i,j)=val2
END DO
END DO
END IF
#elif defined WEDDELL
val1=98.80_r8
val2=0.8270_r8
DO k=-1,26
xwrk(k)=REAL(k-1,r8)*15.0_r8*1000.0_r8
hwrk(k)=375.0_r8
END DO
DO k=27,232
zwrk=-2.0_r8+REAL(k-1,r8)*0.020_r8
xwrk(k)=(520.0_r8+val1+zwrk*val1+ &
& val1*val2*LOG(COSH(zwrk)))*1000.0_r8
hwrk(k)=-75.0_r8+2198.0_r8*(1.0_r8+val2*TANH(zwrk))
END DO
DO k=233,235
xwrk(k)=(850.0_r8+REAL(k-228,r8)*50.0_r8)*1000.0_r8
hwrk(k)=4000.0_r8
END DO
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=375.0_r8
DO k=1,234
IF ((xwrk(k).le.xr(i,1)).and.(xr(i,1).lt.xwrk(k+1))) THEN
cff=1.0_r8/(xwrk(k+1)-xwrk(k))
h(i,j)=cff*(xwrk(k+1)-xr(i,j))*hwrk(k )+ &
& cff*(xr(i,j)-xwrk(k ))*hwrk(k+1)
END IF
END DO
END DO
END DO
#elif defined WINDBASIN
DO i=IstrT,IendT
ival=INT(0.03_r8*REAL(Lm(ng)+1,r8))
IF (i.lt.ival) THEN
val1=1.0_r8-(REAL((i+1)-ival,r8)/REAL(ival,r8))**2
ELSE IF ((Lm(ng)+1-i).lt.ival) THEN
val1=1.0_r8-(REAL((Lm(ng)+1-i)-ival,r8)/REAL(ival,r8))**2
ELSE
val1=1.0_r8
END IF
DO j=JstrT,JendT
val2=2.0_r8*REAL(j-(Mm(ng)+1)/2,r8)/REAL(Mm(ng)+1,r8)
h(i,j)=depth*(0.08_r8+0.92_r8*val1*(1.0_r8-val2*val2))
END DO
END DO
#else
DO j=JstrT,JendT
DO i=IstrT,IendT
h(i,j)=depth
END DO
END DO
#endif
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& h)
END IF

#ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& h)
#endif
!
! Determine minimum depth: first, determine minimum values of depth
! within each subdomain, then determine global minimum by comparing
! these subdomain minima.
!
my_min=h(IstrT,JstrT)
my_max=h(IstrT,JstrT)
DO j=JstrT,JendT
DO i=IstrT,IendT
my_min=MIN(my_min,h(i,j))
my_max=MAX(my_max,h(i,j))
END DO
END DO
#ifdef DISTRIBUTE
NSUB=1 ! distributed-memory
#else
IF (DOMAIN(ng)%SouthWest_Corner(tile).and. &
& DOMAIN(ng)%NorthEast_Corner(tile)) THEN
NSUB=1 ! non-tiled application
ELSE
NSUB=NtileX(ng)*NtileE(ng) ! tiled application
END IF
#endif
!$OMP CRITICAL (H_RANGE)
IF (tile_count.eq.0) THEN
hmin(ng)=my_min
hmax(ng)=my_max
ELSE
hmin(ng)=MIN(hmin(ng),my_min)
hmax(ng)=MAX(hmax(ng),my_max)
END IF
tile_count=tile_count+1
IF (tile_count.eq.NSUB) THEN
tile_count=0
#ifdef DISTRIBUTE
buffer(1)=hmin(ng)
buffer(2)=hmax(ng)
op_handle(1)='MIN'
op_handle(2)='MAX'
CALL mp_reduce (ng, model, 2, buffer, op_handle)
hmin(ng)=buffer(1)
hmax(ng)=buffer(2)
#endif
END IF
!$OMP END CRITICAL (H_RANGE)
#ifdef ICESHELF
!
!-----------------------------------------------------------------------
! Set depth of ice shelf (meters; negative) at RHO-points.
!-----------------------------------------------------------------------
!
# ifdef WEDDELL
val1=340.0_r8
val2=val1/16.0_r8
DO j=JstrT,JendT
DO i=IstrT,IendT
IF (i.gt.20) THEN
zice(i,j)=0.0_r8
ELSE IF (i.gt.4) THEN
zice(i,j)=-val1+REAL(i-1,r8)*val2
ELSE
zice(i,j)=-val1
END IF
END DO
END DO
# else
DO j=JstrT,JendT
DO i=IstrT,IendT
zice(i,j)=0.0_r8
END DO
END DO
# endif
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& zice)
END IF

# ifdef DISTRIBUTE
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& zice)
# endif
#endif

RETURN
END SUBROUTINE ana_grid_tile


Last edited by chevyyang on Wed Jun 07, 2017 4:52 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
PostPosted: Wed Jun 07, 2017 4:51 am 
Offline

Joined: Thu May 04, 2017 1:31 pm
Posts: 5
Location: south china sea insitute of oceanography
the two files attached again


Attachments:
ana_grid.h [34.6 KiB]
Downloaded 3 times
error_message.pdf [78.18 KiB]
Downloaded 4 times
Top
 Profile  
Reply with quote  
PostPosted: Wed Jun 07, 2017 5:29 am 
Offline
User avatar

Joined: Wed Jul 02, 2003 5:29 pm
Posts: 3219
Location: IMS/UAF, USA
Hmm, I'm not getting an error when compiling BIO_TOY. Also, the r_date from the error message is not in ana_grid.h. You need to hunt down analytical.f90 from the build directory and see which subroutine you are in at line 362. Mine is in ana_cloud_tile which has some date stuff, but not r_date. Do you have the latest ROMS version? Hernan changed the clock stuff recently.


Top
 Profile  
Reply with quote  
PostPosted: Fri Jun 09, 2017 7:04 am 
Offline

Joined: Thu May 04, 2017 1:31 pm
Posts: 5
Location: south china sea insitute of oceanography
kate wrote:
Hmm, I'm not getting an error when compiling BIO_TOY. Also, the r_date from the error message is not in ana_grid.h. You need to hunt down analytical.f90 from the build directory and see which subroutine you are in at line 362. Mine is in ana_cloud_tile which has some date stuff, but not r_date. Do you have the latest ROMS version? Hernan changed the clock stuff recently.

thank you so much for your help and time!
Could you help me to check the analytical.f90 ? I attached the file here.


MODULE analytical_mod
!
!svn $Id: analytical.F 830 2017-01-24 21:21:11Z arango $
!================================================== Hernan G. Arango ===
! Copyright (c) 2002-2017 The ROMS/TOMS Group !
! Licensed under a MIT/X style license !
! See License_ROMS.txt !
!=======================================================================
! !
! PACKAGE: !
! !
! This package is used to provide various analytical fields to the !
! model when appropriate. !
! !
!=======================================================================
!
implicit none
!
CONTAINS
!
SUBROUTINE ana_btflux (ng, tile, model, itrc)
!
!=======================================================================
! !
! This routine sets kinematic bottom flux of tracer type variables !
! (tracer units m/s). !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_btflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % btflx)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME( 3)="ROMS/Functionals/ana_btflux.h"
END IF
RETURN
END SUBROUTINE ana_btflux
!
!***********************************************************************
SUBROUTINE ana_btflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& btflx)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(inout) :: btflx(LBi:,LBj:,:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set kinematic bottom heat flux (degC m/s) at horizontal RHO-points.
!-----------------------------------------------------------------------
!
IF (itrc.eq.itemp) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic bottom salt flux (m/s) at horizontal RHO-points,
! scaling by bottom salinity is done elsewhere.
!-----------------------------------------------------------------------
!
ELSE IF (itrc.eq.isalt) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic bottom flux (T m/s) of passive tracers, if any.
!-----------------------------------------------------------------------
!
ELSE
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
END IF
RETURN
END SUBROUTINE ana_btflux_tile
SUBROUTINE ana_cloud (ng, tile, model)
!
!=======================================================================
! !
! This routine sets cloud fraction using an analytical expression. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_cloud_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % cloud)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME( 4)="ROMS/Functionals/ana_cloud.h"
END IF
RETURN
END SUBROUTINE ana_cloud
!
!***********************************************************************
SUBROUTINE ana_cloud_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& cloud)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
USE dateclock_mod, ONLY : caldate
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(out) :: cloud(LBi:,LBj:)
!
! Local variable declarations.
!
integer :: i, j
real(r8) :: Cval, yday
real(r8), dimension(14) :: Coktas = &
& (/ 6.29_r8, 6.26_r8, 6.31_r8, 6.31_r8, 6.32_r8, &
& 6.70_r8, 7.12_r8, 7.26_r8, 6.93_r8, 6.25_r8, &
& 6.19_r8, 6.23_r8, 6.31_r8, 6.29_r8 /)
real(r8), dimension(14) :: Cyday = &
& (/ 0.0_r8, 16.0_r8, 46.0_r8, 75.0_r8, 105.0_r8, &
& 136.0_r8, 166.0_r8, 197.0_r8, 228.0_r8, 258.0_r8, &
& 289.0_r8, 319.0_r8, 350.0_r8, 365.0_r8 /)
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set analytical cloud fraction (%/100): 0=clear sky, 1:overcast sky.
!-----------------------------------------------------------------------
!
! OWS Papa cloud climatology.
!
CALL caldate (tdays(ng), yd_r8=yday)
DO i=1,13
IF ((yday.ge.Cyday(i)).and.(yday.le.Cyday(i+1))) THEN
Cval=0.125_r8*(Coktas(i )*(Cyday(i+1)-yday)+ &
& Coktas(i+1)*(yday-Cyday(i)))/ &
& (Cyday(i+1)-Cyday(i))
END IF
END DO
DO j=JstrT,JendT
DO i=IstrT,IendT
cloud(i,j)=Cval
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& real(r8), dimension(8), intent(in) :: r_date
real(r8), dimension(8), intent(in) :: r_date
cloud)
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& cloud)
RETURN
END SUBROUTINE ana_cloud_tile
SUBROUTINE ana_rain (ng, tile, model)
!
!=======================================================================
! !
! This routine sets precipitation rate (kg/m2/s) using an !
! analytical expression. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_rain_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % rain)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME(21)="ROMS/Functionals/ana_rain.h"
END IF
RETURN
END SUBROUTINE ana_rain
!
!***********************************************************************
SUBROUTINE ana_rain_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& rain)
!***********************************************************************
!
USE mod_param
USE mod_ncparam
USE mod_scalars
!
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(out) :: rain(LBi:,LBj:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set analytical precipitation rate (kg/m2/s).
!-----------------------------------------------------------------------
!
DO j=JstrT,JendT
DO i=IstrT,IendT
rain(i,j)=0.0_r8
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& rain)
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& rain)
RETURN
END SUBROUTINE ana_rain_tile
SUBROUTINE ana_stflux (ng, tile, model, itrc)
!
!=======================================================================
! !
! This routine sets kinematic surface flux of tracer type variables !
! "stflx" (tracer units m/s) using analytical expressions. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_stflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % srflx, &
& FORCES(ng) % stflx)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME(31)="ROMS/Functionals/ana_stflux.h"
END IF
RETURN
END SUBROUTINE ana_stflux
!
!***********************************************************************
SUBROUTINE ana_stflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& srflx, &
& stflx)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(in) :: srflx(LBi:,LBj:)
real(r8), intent(inout) :: stflx(LBi:,LBj:,:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set kinematic surface heat flux (degC m/s) at horizontal
! RHO-points.
!-----------------------------------------------------------------------
!
IF (itrc.eq.itemp) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic surface freshwater flux (m/s) at horizontal
! RHO-points, scaling by surface salinity is done in STEP3D.
!-----------------------------------------------------------------------
!
ELSE IF (itrc.eq.isalt) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic surface flux (T m/s) of passive tracers, if any.
!-----------------------------------------------------------------------
!
ELSE
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
END IF
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& stflx(:,:,itrc))
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& stflx(:,:,itrc))
RETURN
END SUBROUTINE ana_stflux_tile
END MODULE analytical_mod


Attachments:
analytical.f90 [28.46 KiB]
Downloaded 4 times
Top
 Profile  
Reply with quote  
PostPosted: Fri Jun 09, 2017 7:08 am 
Offline

Joined: Thu May 04, 2017 1:31 pm
Posts: 5
Location: south china sea insitute of oceanography
kate wrote:
Hmm, I'm not getting an error when compiling BIO_TOY. Also, the r_date from the error message is not in ana_grid.h. You need to hunt down analytical.f90 from the build directory and see which subroutine you are in at line 362. Mine is in ana_cloud_tile which has some date stuff, but not r_date. Do you have the latest ROMS version? Hernan changed the clock stuff recently.


thank you so much for your help and time!
Could you help me to check the analytical.f90 ? I attached the file here.


MODULE analytical_mod
!
!svn $Id: analytical.F 830 2017-01-24 21:21:11Z arango $
!================================================== Hernan G. Arango ===
! Copyright (c) 2002-2017 The ROMS/TOMS Group !
! Licensed under a MIT/X style license !
! See License_ROMS.txt !
!=======================================================================
! !
! PACKAGE: !
! !
! This package is used to provide various analytical fields to the !
! model when appropriate. !
! !
!=======================================================================
!
implicit none
!
CONTAINS
!
SUBROUTINE ana_btflux (ng, tile, model, itrc)
!
!=======================================================================
! !
! This routine sets kinematic bottom flux of tracer type variables !
! (tracer units m/s). !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_btflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % btflx)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME( 3)="ROMS/Functionals/ana_btflux.h"
END IF
RETURN
END SUBROUTINE ana_btflux
!
!***********************************************************************
SUBROUTINE ana_btflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& btflx)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(inout) :: btflx(LBi:,LBj:,:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set kinematic bottom heat flux (degC m/s) at horizontal RHO-points.
!-----------------------------------------------------------------------
!
IF (itrc.eq.itemp) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic bottom salt flux (m/s) at horizontal RHO-points,
! scaling by bottom salinity is done elsewhere.
!-----------------------------------------------------------------------
!
ELSE IF (itrc.eq.isalt) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic bottom flux (T m/s) of passive tracers, if any.
!-----------------------------------------------------------------------
!
ELSE
DO j=JstrT,JendT
DO i=IstrT,IendT
btflx(i,j,itrc)=0.0_r8
END DO
END DO
END IF
RETURN
END SUBROUTINE ana_btflux_tile
SUBROUTINE ana_cloud (ng, tile, model)
!
!=======================================================================
! !
! This routine sets cloud fraction using an analytical expression. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_cloud_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % cloud)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME( 4)="ROMS/Functionals/ana_cloud.h"
END IF
RETURN
END SUBROUTINE ana_cloud
!
!***********************************************************************
SUBROUTINE ana_cloud_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& cloud)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
USE dateclock_mod, ONLY : caldate
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(out) :: cloud(LBi:,LBj:)
!
! Local variable declarations.
!
integer :: i, j
real(r8) :: Cval, yday
real(r8), dimension(14) :: Coktas = &
& (/ 6.29_r8, 6.26_r8, 6.31_r8, 6.31_r8, 6.32_r8, &
& 6.70_r8, 7.12_r8, 7.26_r8, 6.93_r8, 6.25_r8, &
& 6.19_r8, 6.23_r8, 6.31_r8, 6.29_r8 /)
real(r8), dimension(14) :: Cyday = &
& (/ 0.0_r8, 16.0_r8, 46.0_r8, 75.0_r8, 105.0_r8, &
& 136.0_r8, 166.0_r8, 197.0_r8, 228.0_r8, 258.0_r8, &
& 289.0_r8, 319.0_r8, 350.0_r8, 365.0_r8 /)
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set analytical cloud fraction (%/100): 0=clear sky, 1:overcast sky.
!-----------------------------------------------------------------------
!
! OWS Papa cloud climatology.
!
CALL caldate (tdays(ng), yd_r8=yday)
DO i=1,13
IF ((yday.ge.Cyday(i)).and.(yday.le.Cyday(i+1))) THEN
Cval=0.125_r8*(Coktas(i )*(Cyday(i+1)-yday)+ &
& Coktas(i+1)*(yday-Cyday(i)))/ &
& (Cyday(i+1)-Cyday(i))
END IF
END DO
DO j=JstrT,JendT
DO i=IstrT,IendT
cloud(i,j)=Cval
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& real(r8), dimension(8), intent(in) :: r_date
real(r8), dimension(8), intent(in) :: r_date
cloud)
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& cloud)
RETURN
END SUBROUTINE ana_cloud_tile
SUBROUTINE ana_rain (ng, tile, model)
!
!=======================================================================
! !
! This routine sets precipitation rate (kg/m2/s) using an !
! analytical expression. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_rain_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % rain)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME(21)="ROMS/Functionals/ana_rain.h"
END IF
RETURN
END SUBROUTINE ana_rain
!
!***********************************************************************
SUBROUTINE ana_rain_tile (ng, tile, model, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& rain)
!***********************************************************************
!
USE mod_param
USE mod_ncparam
USE mod_scalars
!
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(out) :: rain(LBi:,LBj:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set analytical precipitation rate (kg/m2/s).
!-----------------------------------------------------------------------
!
DO j=JstrT,JendT
DO i=IstrT,IendT
rain(i,j)=0.0_r8
END DO
END DO
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& rain)
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& rain)
RETURN
END SUBROUTINE ana_rain_tile
SUBROUTINE ana_stflux (ng, tile, model, itrc)
!
!=======================================================================
! !
! This routine sets kinematic surface flux of tracer type variables !
! "stflx" (tracer units m/s) using analytical expressions. !
! !
!=======================================================================
!
USE mod_param
USE mod_forces
USE mod_ncparam
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer :: IminS, ImaxS, JminS, JmaxS
integer :: LBi, UBi, LBj, UBj, LBij, UBij
!
! Set horizontal starting and ending indices for automatic private
! storage arrays.
!
IminS=BOUNDS(ng)%Istr(tile)-3
ImaxS=BOUNDS(ng)%Iend(tile)+3
JminS=BOUNDS(ng)%Jstr(tile)-3
JmaxS=BOUNDS(ng)%Jend(tile)+3
!
! Determine array lower and upper bounds in the I- and J-directions.
!
LBi=BOUNDS(ng)%LBi(tile)
UBi=BOUNDS(ng)%UBi(tile)
LBj=BOUNDS(ng)%LBj(tile)
UBj=BOUNDS(ng)%UBj(tile)
!
! Set array lower and upper bounds for MIN(I,J) directions and
! MAX(I,J) directions.
!
LBij=BOUNDS(ng)%LBij
UBij=BOUNDS(ng)%UBij
!
CALL ana_stflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& FORCES(ng) % srflx, &
& FORCES(ng) % stflx)
!
! Set analytical header file name used.
!
IF (Lanafile) THEN
ANANAME(31)="ROMS/Functionals/ana_stflux.h"
END IF
RETURN
END SUBROUTINE ana_stflux
!
!***********************************************************************
SUBROUTINE ana_stflux_tile (ng, tile, model, itrc, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& srflx, &
& stflx)
!***********************************************************************
!
USE mod_param
USE mod_scalars
!
USE exchange_2d_mod, ONLY : exchange_r2d_tile
USE mp_exchange_mod, ONLY : mp_exchange2d
!
! Imported variable declarations.
!
integer, intent(in) :: ng, tile, model, itrc
integer, intent(in) :: LBi, UBi, LBj, UBj
integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
real(r8), intent(in) :: srflx(LBi:,LBj:)
real(r8), intent(inout) :: stflx(LBi:,LBj:,:)
!
! Local variable declarations.
!
integer :: i, j
!
!-----------------------------------------------------------------------
! Set lower and upper tile bounds and staggered variables bounds for
! this horizontal domain partition. Notice that if tile=-1, it will
! set the values for the global grid.
!-----------------------------------------------------------------------
!
integer :: Istr, IstrB, IstrP, IstrR, IstrT, IstrM, IstrU
integer :: Iend, IendB, IendP, IendR, IendT
integer :: Jstr, JstrB, JstrP, JstrR, JstrT, JstrM, JstrV
integer :: Jend, JendB, JendP, JendR, JendT
integer :: Istrm3, Istrm2, Istrm1, IstrUm2, IstrUm1
integer :: Iendp1, Iendp2, Iendp2i, Iendp3
integer :: Jstrm3, Jstrm2, Jstrm1, JstrVm2, JstrVm1
integer :: Jendp1, Jendp2, Jendp2i, Jendp3
!
Istr =BOUNDS(ng) % Istr (tile)
IstrB =BOUNDS(ng) % IstrB (tile)
IstrM =BOUNDS(ng) % IstrM (tile)
IstrP =BOUNDS(ng) % IstrP (tile)
IstrR =BOUNDS(ng) % IstrR (tile)
IstrT =BOUNDS(ng) % IstrT (tile)
IstrU =BOUNDS(ng) % IstrU (tile)
Iend =BOUNDS(ng) % Iend (tile)
IendB =BOUNDS(ng) % IendB (tile)
IendP =BOUNDS(ng) % IendP (tile)
IendR =BOUNDS(ng) % IendR (tile)
IendT =BOUNDS(ng) % IendT (tile)
Jstr =BOUNDS(ng) % Jstr (tile)
JstrB =BOUNDS(ng) % JstrB (tile)
JstrM =BOUNDS(ng) % JstrM (tile)
JstrP =BOUNDS(ng) % JstrP (tile)
JstrR =BOUNDS(ng) % JstrR (tile)
JstrT =BOUNDS(ng) % JstrT (tile)
JstrV =BOUNDS(ng) % JstrV (tile)
Jend =BOUNDS(ng) % Jend (tile)
JendB =BOUNDS(ng) % JendB (tile)
JendP =BOUNDS(ng) % JendP (tile)
JendR =BOUNDS(ng) % JendR (tile)
JendT =BOUNDS(ng) % JendT (tile)
!
Istrm3 =BOUNDS(ng) % Istrm3 (tile) ! Istr-3
Istrm2 =BOUNDS(ng) % Istrm2 (tile) ! Istr-2
Istrm1 =BOUNDS(ng) % Istrm1 (tile) ! Istr-1
IstrUm2=BOUNDS(ng) % IstrUm2(tile) ! IstrU-2
IstrUm1=BOUNDS(ng) % IstrUm1(tile) ! IstrU-1
Iendp1 =BOUNDS(ng) % Iendp1 (tile) ! Iend+1
Iendp2 =BOUNDS(ng) % Iendp2 (tile) ! Iend+2
Iendp2i=BOUNDS(ng) % Iendp2i(tile) ! Iend+2 interior
Iendp3 =BOUNDS(ng) % Iendp3 (tile) ! Iend+3
Jstrm3 =BOUNDS(ng) % Jstrm3 (tile) ! Jstr-3
Jstrm2 =BOUNDS(ng) % Jstrm2 (tile) ! Jstr-2
Jstrm1 =BOUNDS(ng) % Jstrm1 (tile) ! Jstr-1
JstrVm2=BOUNDS(ng) % JstrVm2(tile) ! JstrV-2
JstrVm1=BOUNDS(ng) % JstrVm1(tile) ! JstrV-1
Jendp1 =BOUNDS(ng) % Jendp1 (tile) ! Jend+1
Jendp2 =BOUNDS(ng) % Jendp2 (tile) ! Jend+2
Jendp2i=BOUNDS(ng) % Jendp2i(tile) ! Jend+2 interior
Jendp3 =BOUNDS(ng) % Jendp3 (tile) ! Jend+3
!
!-----------------------------------------------------------------------
! Set kinematic surface heat flux (degC m/s) at horizontal
! RHO-points.
!-----------------------------------------------------------------------
!
IF (itrc.eq.itemp) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic surface freshwater flux (m/s) at horizontal
! RHO-points, scaling by surface salinity is done in STEP3D.
!-----------------------------------------------------------------------
!
ELSE IF (itrc.eq.isalt) THEN
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
!
!-----------------------------------------------------------------------
! Set kinematic surface flux (T m/s) of passive tracers, if any.
!-----------------------------------------------------------------------
!
ELSE
DO j=JstrT,JendT
DO i=IstrT,IendT
stflx(i,j,itrc)=0.0_r8
END DO
END DO
END IF
!
! Exchange boundary data.
!
IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
CALL exchange_r2d_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& stflx(:,:,itrc))
END IF
CALL mp_exchange2d (ng, tile, model, 1, &
& LBi, UBi, LBj, UBj, &
& NghostPoints, &
& EWperiodic(ng), NSperiodic(ng), &
& stflx(:,:,itrc))
RETURN
END SUBROUTINE ana_stflux_tile
END MODULE analytical_mod


Top
 Profile  
Reply with quote  
PostPosted: Fri Jun 09, 2017 4:27 pm 
Offline
User avatar

Joined: Wed Jul 02, 2003 5:29 pm
Posts: 3219
Location: IMS/UAF, USA
Please don't double-post here!

Cutting and pasting the entire file is too much when you know the relevant section based on line numbers. The relevant section:
Code:
!
!  Exchange boundary data.
!
      IF (EWperiodic(ng).or.NSperiodic(ng)) THEN
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          LBi, UBi, LBj, UBj,                     &
     &                  real(r8), dimension(8), intent(in) :: r_date
      real(r8), dimension(8), intent(in) :: r_date
              cloud)
      END IF
      CALL mp_exchange2d (ng, tile, model, 1,                           &
     &                    LBi, UBi, LBj, UBj,                           &
     &                    NghostPoints,                                 &
     &                    EWperiodic(ng), NSperiodic(ng),               &
     &                    cloud)
      RETURN
      END SUBROUTINE ana_cloud_tile
There's stray code (real(r8), dimension(8)...) in the middle of a subroutine call. You need to check your ana_cloud.h to see if it's there or if it got there somehow during the C preprocessor phase. Maybe you should start with a clean download if all else fails.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 

All times are UTC


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
Powered by phpBB® Forum Software © phpBB Group