tutorial_global_oce_latlon/code/ptracers_forcing_surf.F

C $Header: /u/gcmpack/MITgcm/verification/tutorial_global_oce_latlon/code/ptracers_forcing_surf.F,v 1.2 2007/05/14 19:48:36 dfer Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

CBOP
C !ROUTINE: PTRACERS_FORCING_SURF

C !INTERFACE: ==========================================================
      SUBROUTINE PTRACERS_FORCING_SURF(
     I                            bi, bj, iMin, iMax, jMin, jMax,
     I                            myTime,myIter,myThid )

C !DESCRIPTION:
C     Precomputes surface forcing term for pkg/ptracers.
C     Precomputation is needed because of non-local KPP transport term,
C     routine KPP_TRANSPORT_PTR.

C !USES: ===============================================================
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"
#include "FFIELDS.h"
c #include "DYNVARS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS.h"

C !INPUT PARAMETERS: ===================================================
C  bi,bj                :: tile indices
C  myTime               :: model time
C  myIter               :: time-step number
C  myThid               :: thread number
      INTEGER bi, bj, iMin, iMax, jMin, jMax
      _RL myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_PTRACERS

C !LOCAL VARIABLES: ====================================================
C  i,j                  :: loop indices
C  iTrc                 :: tracer index
C  ks                   :: surface level index
      INTEGER i, j
      INTEGER iTrc, ks
CEOP

      IF ( usingPCoords ) THEN
        ks = Nr
      ELSE
        ks = 1
      ENDIF

C Example of how to add forcing at the surface
      DO iTrc=1,PTRACERS_numInUse
          DO j = jMin, jMax
           DO i = iMin, iMax
C     Restoring to zero at the surface on a 10-day timescale
             surfaceForcingPtr(i,j,bi,bj,iTrc) =
     &        + 1. _d 0 / (10. _d 0 * 86400. _d 0)
     &                  * ( 0. _d 0 - pTracer(i,j,ks,bi,bj,iTrc) )
     &                  * drF(ks) * _hFacC(i,j,ks,bi,bj)
           ENDDO
          ENDDO
      ENDDO

#ifdef EXACT_CONSERV
      IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
     &     .AND. useRealFreshWaterFlux ) THEN

       DO iTrc=1,PTRACERS_numInUse

c-  NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes
c   the water column height ; temp., salt, (tracer) flux associated
c   with this input/output of water is added here to the surface tendency.
c
         IF (PtRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN
          DO j = jMin, jMax
           DO i = iMin, iMax
             surfaceForcingPtr(i,j,bi,bj,iTrc) =
     &          surfaceForcingPtr(i,j,bi,bj,iTrc)
     &        + PmEpR(i,j,bi,bj)
     &          *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )
     &          *mass2rUnit
           ENDDO
          ENDDO
         ENDIF

       ENDDO
      ENDIF
#endif /* EXACT_CONSERV */

#endif /* ALLOW_PTRACERS */

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/verification/tutorial_global_oce_latlon/code/ptracers_forcing_surf.F,v 1.2 2007/05/14 19:48:36 dfer Exp $
2	C $Name: $
3
4	#include "PTRACERS_OPTIONS.h"
5
6	CBOP
7	C !ROUTINE: PTRACERS_FORCING_SURF
8
9	C !INTERFACE: ==========================================================
10	SUBROUTINE PTRACERS_FORCING_SURF(
11	I bi, bj, iMin, iMax, jMin, jMax,
12	I myTime,myIter,myThid )
13
14	C !DESCRIPTION:
15	C Precomputes surface forcing term for pkg/ptracers.
16	C Precomputation is needed because of non-local KPP transport term,
17	C routine KPP_TRANSPORT_PTR.
18
19	C !USES: ===============================================================
20	IMPLICIT NONE
21	#include "SIZE.h"
22	#include "EEPARAMS.h"
23	#include "PARAMS.h"
24	#include "GRID.h"
25	#include "SURFACE.h"
26	#include "FFIELDS.h"
27	c #include "DYNVARS.h"
28	#include "PTRACERS_SIZE.h"
29	#include "PTRACERS.h"
30
31	C !INPUT PARAMETERS: ===================================================
32	C bi,bj :: tile indices
33	C myTime :: model time
34	C myIter :: time-step number
35	C myThid :: thread number
36	INTEGER bi, bj, iMin, iMax, jMin, jMax
37	_RL myTime
38	INTEGER myIter
39	INTEGER myThid
40
41	#ifdef ALLOW_PTRACERS
42
43	C !LOCAL VARIABLES: ====================================================
44	C i,j :: loop indices
45	C iTrc :: tracer index
46	C ks :: surface level index
47	INTEGER i, j
48	INTEGER iTrc, ks
49	CEOP
50
51	IF ( usingPCoords ) THEN
52	ks = Nr
53	ELSE
54	ks = 1
55	ENDIF
56
57	C Example of how to add forcing at the surface
58	DO iTrc=1,PTRACERS_numInUse
59	DO j = jMin, jMax
60	DO i = iMin, iMax
61	C Restoring to zero at the surface on a 10-day timescale
62	surfaceForcingPtr(i,j,bi,bj,iTrc) =
63	& + 1. _d 0 / (10. _d 0 * 86400. _d 0)
64	& * ( 0. _d 0 - pTracer(i,j,ks,bi,bj,iTrc) )
65	& * drF(ks) * _hFacC(i,j,ks,bi,bj)
66	ENDDO
67	ENDDO
68	ENDDO
69
70	#ifdef EXACT_CONSERV
71	IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
72	& .AND. useRealFreshWaterFlux ) THEN
73
74	DO iTrc=1,PTRACERS_numInUse
75
76	c- NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes
77	c the water column height ; temp., salt, (tracer) flux associated
78	c with this input/output of water is added here to the surface tendency.
79	c
80	IF (PtRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN
81	DO j = jMin, jMax
82	DO i = iMin, iMax
83	surfaceForcingPtr(i,j,bi,bj,iTrc) =
84	& surfaceForcingPtr(i,j,bi,bj,iTrc)
85	& + PmEpR(i,j,bi,bj)
86	& *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )
87	& *mass2rUnit
88	ENDDO
89	ENDDO
90	ENDIF
91
92	ENDDO
93	ENDIF
94	#endif /* EXACT_CONSERV */
95
96	#endif /* ALLOW_PTRACERS */
97
98	RETURN
99	END