/[MITgcm]/MITgcm/verification/tutorial_global_oce_latlon/code/ptracers_forcing_surf.F
ViewVC logotype

Diff of /MITgcm/verification/tutorial_global_oce_latlon/code/ptracers_forcing_surf.F

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

revision 1.4 by dfer, Thu Oct 25 20:00:22 2007 UTC revision 1.6 by jmc, Sun Sep 5 22:32:48 2010 UTC
# Line 8  C !ROUTINE: PTRACERS_FORCING_SURF Line 8  C !ROUTINE: PTRACERS_FORCING_SURF
8    
9  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
10        SUBROUTINE PTRACERS_FORCING_SURF(        SUBROUTINE PTRACERS_FORCING_SURF(
11         I                            relaxForcingS,
12       I                            bi, bj, iMin, iMax, jMin, jMax,       I                            bi, bj, iMin, iMax, jMin, jMax,
13       I                            myTime,myIter,myThid )       I                            myTime,myIter,myThid )
14    
# Line 23  C !USES: =============================== Line 24  C !USES: ===============================
24  #include "PARAMS.h"  #include "PARAMS.h"
25  #include "GRID.h"  #include "GRID.h"
26  #include "SURFACE.h"  #include "SURFACE.h"
27    #include "DYNVARS.h"
28  #include "FFIELDS.h"  #include "FFIELDS.h"
 c #include "DYNVARS.h"  
29  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
30  #include "PTRACERS.h"  #include "PTRACERS_PARAMS.h"
31    #include "PTRACERS_FIELDS.h"
32    
33  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
34    C  relaxForcingS        :: Salt forcing due to surface relaxation
35  C  bi,bj                :: tile indices  C  bi,bj                :: tile indices
36  C  myTime               :: model time  C  myTime               :: model time
37  C  myIter               :: time-step number  C  myIter               :: time-step number
38  C  myThid               :: thread number  C  myThid               :: thread number
39          _RL relaxForcingS(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40        INTEGER bi, bj, iMin, iMax, jMin, jMax        INTEGER bi, bj, iMin, iMax, jMin, jMax
41        _RL myTime        _RL myTime
42        INTEGER myIter        INTEGER myIter
# Line 46  C  iTrc                 :: tracer index Line 50  C  iTrc                 :: tracer index
50  C  ks                   :: surface level index  C  ks                   :: surface level index
51        INTEGER i, j        INTEGER i, j
52        INTEGER iTrc, ks        INTEGER iTrc, ks
53          _RL add2EmP(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54          _RL epsil, cutoff, tmpVar
55  CEOP  CEOP
56    
57        IF ( usingPCoords ) THEN        IF ( usingPCoords ) THEN
# Line 58  C Example of how to add forcing at the s Line 64  C Example of how to add forcing at the s
64        DO iTrc=1,PTRACERS_numInUse        DO iTrc=1,PTRACERS_numInUse
65            DO j = jMin, jMax            DO j = jMin, jMax
66             DO i = iMin, iMax             DO i = iMin, iMax
67               surfaceForcingPtr(i,j,bi,bj,iTrc) =               surfaceForcingPTr(i,j,bi,bj,iTrc) =
68       &        + 1. _d 0 / (10. _d 0 * 86400. _d 0)       &        + 1. _d 0 / (10. _d 0 * 86400. _d 0)
69       &                  * ( 0. _d 0 - pTracer(i,j,ks,bi,bj,iTrc) )       &                  * ( 0. _d 0 - pTracer(i,j,ks,bi,bj,iTrc) )
70       &                  * drF(ks) * _hFacC(i,j,ks,bi,bj)       &                  * drF(ks) * _hFacC(i,j,ks,bi,bj)
# Line 66  C Example of how to add forcing at the s Line 72  C Example of how to add forcing at the s
72            ENDDO            ENDDO
73        ENDDO        ENDDO
74    
75    C--   Option to convert Salt-relaxation into additional EmP contribution
76          IF ( PTRACERS_addSrelax2EmP ) THEN
77    C-    here we assume that salt_EvPrRn = 0
78    C     set cutoff value to prevent too large additional EmP:
79    C       current limit is set to 0.1 CFL
80            epsil = 1. _d -10
81            cutoff = 0.1 _d 0 *drF(ks)/PTRACERS_dTLev(ks)
82            IF ( ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
83         &         .AND. useRealFreshWaterFlux )
84         &     .OR.convertFW2Salt .EQ. -1. ) THEN
85             DO j = jMin, jMax
86              DO i = iMin, iMax
87                tmpVar = MAX( salt(i,j,ks,bi,bj), epsil )
88                add2EmP(i,j) = relaxForcingS(i,j)/tmpVar
89                add2EmP(i,j) = rUnit2mass
90         &                  *MAX( -cutoff, MIN( add2EmP(i,j), cutoff ) )
91              ENDDO
92             ENDDO
93            ELSE
94             DO j = jMin, jMax
95              DO i = iMin, iMax
96                add2EmP(i,j) = relaxForcingS(i,j)/convertFW2Salt
97                add2EmP(i,j) = rUnit2mass
98         &                  *MAX( -cutoff, MIN( add2EmP(i,j), cutoff ) )
99              ENDDO
100             ENDDO
101            ENDIF
102    #ifdef ALLOW_DIAGNOSTICS
103            IF ( useDiagnostics ) THEN
104             CALL DIAGNOSTICS_FILL(add2EmP,'Add2EmP ',0,1,2,bi,bj,myThid)
105            ENDIF
106    #endif /* ALLOW_DIAGNOSTICS */
107          ELSE
108            DO j = jMin, jMax
109              DO i = iMin, iMax
110                add2EmP(i,j) = 0. _d 0
111              ENDDO
112            ENDDO
113          ENDIF
114    C-- end of "addEmP" setting
115    
116  #ifdef EXACT_CONSERV  #ifdef EXACT_CONSERV
117        IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)        IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
118       &     .AND. useRealFreshWaterFlux ) THEN       &     .AND. useRealFreshWaterFlux ) THEN
# Line 76  c-  NonLin_FrSurf and RealFreshWaterFlux Line 123  c-  NonLin_FrSurf and RealFreshWaterFlux
123  c   the water column height ; temp., salt, (tracer) flux associated  c   the water column height ; temp., salt, (tracer) flux associated
124  c   with this input/output of water is added here to the surface tendency.  c   with this input/output of water is added here to the surface tendency.
125  c  c
126           IF (PtRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN           IF (PTRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN
127            DO j = jMin, jMax            DO j = jMin, jMax
128             DO i = iMin, iMax             DO i = iMin, iMax
129               surfaceForcingPtr(i,j,bi,bj,iTrc) =               surfaceForcingPTr(i,j,bi,bj,iTrc) =
130       &          surfaceForcingPtr(i,j,bi,bj,iTrc)       &          surfaceForcingPTr(i,j,bi,bj,iTrc)
131       &        + PmEpR(i,j,bi,bj)       &        + ( PmEpR(i,j,bi,bj) - add2EmP(i,j) )
132       &          *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )       &          *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )
133       &          *mass2rUnit       &          *mass2rUnit
134             ENDDO             ENDDO
# Line 104  C-    use local surface tracer field to Line 151  C-    use local surface tracer field to
151    
152          DO iTrc=1,PTRACERS_numInUse          DO iTrc=1,PTRACERS_numInUse
153    
154           IF (PtRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN           IF (PTRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN
155  C        account for Rain/Evap tracer content (PtRACERS_EvPrRn) using  C        account for Rain/Evap tracer content (PTRACERS_EvPrRn) using
156  C        local surface tracer  C        local surface tracer
157            DO j = jMin, jMax            DO j = jMin, jMax
158             DO i = iMin, iMax             DO i = iMin, iMax
159              surfaceForcingPtr(i,j,bi,bj,iTrc) =              surfaceForcingPTr(i,j,bi,bj,iTrc) =
160       &          surfaceForcingPtr(i,j,bi,bj,iTrc)       &          surfaceForcingPTr(i,j,bi,bj,iTrc)
161       &        + EmPmR(i,j,bi,bj)       &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
162       &          *( pTracer(i,j,ks,bi,bj,iTrc) - PtRACERS_EvPrRn(iTrc) )       &          *( pTracer(i,j,ks,bi,bj,iTrc) - PTRACERS_EvPrRn(iTrc) )
163       &          *mass2rUnit       &          *mass2rUnit
164             ENDDO             ENDDO
165            ENDDO            ENDDO
# Line 125  C-    use uniform tracer value to calcul Line 172  C-    use uniform tracer value to calcul
172    
173          DO iTrc=1,PTRACERS_numInUse          DO iTrc=1,PTRACERS_numInUse
174    
175           IF (PtRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN           IF (PTRACERS_EvPrRn(iTrc).NE.UNSET_RL) THEN
176  C     account for Rain/Evap tracer content (PtRACERS_EvPrRn) assuming uniform  C     account for Rain/Evap tracer content (PTRACERS_EvPrRn) assuming uniform
177  C     surface tracer (=PTRACERS_ref)  C     surface tracer (=PTRACERS_ref)
178            DO j = jMin, jMax            DO j = jMin, jMax
179             DO i = iMin, iMax             DO i = iMin, iMax
180              surfaceForcingPtr(i,j,bi,bj,iTrc) =              surfaceForcingPTr(i,j,bi,bj,iTrc) =
181       &          surfaceForcingPtr(i,j,bi,bj,iTrc)       &          surfaceForcingPTr(i,j,bi,bj,iTrc)
182       &        + EmPmR(i,j,bi,bj)       &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
183       &            *( PTRACERS_ref(ks,iTrc) - PtRACERS_EvPrRn(iTrc) )       &            *( PTRACERS_ref(ks,iTrc) - PTRACERS_EvPrRn(iTrc) )
184       &            *mass2rUnit       &            *mass2rUnit
185             ENDDO             ENDDO
186            ENDDO            ENDDO
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22