BIO_TOY: analytical.f90 error

Discussion about coupled ecosystem models

Moderators: arango, robertson

Post Reply
Message
Author
chevyyang
Posts: 5
Joined: Thu May 04, 2017 1:31 pm
Location: south china sea insitute of oceanography

BIO_TOY: analytical.f90 error

#1 Unread post by chevyyang »

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
chevyyang
Posts: 5
Joined: Thu May 04, 2017 1:31 pm
Location: south china sea insitute of oceanography

Re: BIO_TO: Yanalytical.f90 error

#2 Unread post by chevyyang »

the two files attached again
Attachments
ana_grid.h
(34.6 KiB) Downloaded 592 times
error_message.pdf
(78.18 KiB) Downloaded 549 times
Top
User avatar
kate
Posts: 4091
Joined: Wed Jul 02, 2003 5:29 pm
Location: CFOS/UAF, USA

Re: BIO_TOY: analytical.f90 error

#3 Unread post by kate »

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
chevyyang
Posts: 5
Joined: Thu May 04, 2017 1:31 pm
Location: south china sea insitute of oceanography

Re: BIO_TOY: analytical.f90 error

#4 Unread post by chevyyang »

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 528 times
Top
chevyyang
Posts: 5
Joined: Thu May 04, 2017 1:31 pm
Location: south china sea insitute of oceanography

Re: BIO_TOY: analytical.f90 error

#5 Unread post by chevyyang »

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
User avatar
kate
Posts: 4091
Joined: Wed Jul 02, 2003 5:29 pm
Location: CFOS/UAF, USA

Re: BIO_TOY: analytical.f90 error

#6 Unread post by kate »

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: Select all

!
!  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
Post Reply

Return to “ROMS Ecosystem”