/[MITgcm]/MITgcm_contrib/PRM/multi_comp_setup/cg/code/set_ddtvars.F
ViewVC logotype

Annotation of /MITgcm_contrib/PRM/multi_comp_setup/cg/code/set_ddtvars.F

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


Revision 1.3 - (hide annotations) (download)
Tue Feb 5 00:34:13 2008 UTC (17 years, 5 months ago) by jmc
Branch: MAIN
Changes since 1.2: +24 -14 lines
use "mypackage" to apply forcing from FG-components

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm_contrib/PRM/multi_comp_setup/cg/code/set_ddtvars.F,v 1.2 2007/12/11 00:42:40 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5 jmc 1.3 #ifdef ALLOW_MYPACKAGE
6     # include "MYPACKAGE_OPTIONS.h"
7     #else
8     # include "CPP_OPTIONS.h"
9     #endif
10 jmc 1.1
11     CBOP
12     C !ROUTINE: SET_DDTVARS
13     C !INTERFACE:
14     SUBROUTINE SET_DDTVARS( gUVelC, gVVelC, gThetaC,
15     I cnx, cny, cnr,
16     I myTime, myIter, myThid )
17     C !DESCRIPTION: \bv
18     C *==========================================================*
19     C | S/R SET_DDTVARS
20     C | o Set tendencies to be used as additional forcing
21     C *==========================================================*
22     C *==========================================================*
23     C \ev
24    
25     C !USES:
26     IMPLICIT NONE
27    
28     C == Global data ==
29     #include "SIZE.h"
30     #include "EEPARAMS.h"
31     #include "PARAMS.h"
32     #include "ORIENTATION.h"
33 jmc 1.3 #ifdef ALLOW_MYPACKAGE
34     # include "MYPACKAGE.h"
35     #endif
36 jmc 1.1
37     C !INPUT/OUTPUT PARAMETERS:
38     C == Routine arguments ==
39     C myTime :: Current time in simulation
40     C myIter :: Current iteration number
41     C myThid :: Thread Id number
42     INTEGER cnx, cny, cnr
43     REAL*8 gUVelC( cnx, cny, cnr)
44     REAL*8 gVVelC( cnx, cny, cnr)
45     REAL*8 gThetaC(cnx, cny, cnr)
46     _RL myTime
47     INTEGER myIter
48     INTEGER myThid
49    
50     C !FUNCTIONS:
51     LOGICAL DIFFERENT_MULTIPLE
52     EXTERNAL DIFFERENT_MULTIPLE
53    
54     C !LOCAL VARIABLES:
55     C == Local variables ==
56     C i,j,k :: Loop counters
57     INTEGER i,j,k
58     C Variables used for I/O
59     CHARACTER*(10) suff
60     CEOP
61    
62     IF ( cnx .NE. sNx ) THEN
63     STOP 'SET_DTTVARS cnx NE sNx'
64     ENDIF
65     IF ( cny .NE. sNy ) THEN
66     STOP 'SET_DTTVARS cny NE sNy'
67     ENDIF
68     IF ( cnr .NE. Nr ) THEN
69     STOP 'SET_DTTVARS cnr NE Nr'
70     ENDIF
71    
72     DO k=1,Nr
73     DO j=1,sNy
74     DO i=1,sNx
75     IF ( velDvRMS(i,j,1,1).GT.0. _d 0 ) THEN
76 jmc 1.3 myPa_TendVelU(i,j,k,1,1) = gUVelC(i,j,k)*cAngleFG(i,j,1,1)
77     & - gVVelC(i,j,k)*sAngleFG(i,j,1,1)
78     myPa_TendVelV(i,j,k,1,1) = gVVelC(i,j,k)*cAngleFG(i,j,1,1)
79     & + gUVelC(i,j,k)*sAngleFG(i,j,1,1)
80 jmc 1.1 ELSE
81 jmc 1.3 myPa_TendVelU(i,j,k,1,1) = 0. _d 0
82     myPa_TendVelV(i,j,k,1,1) = 0. _d 0
83 jmc 1.1 ENDIF
84     ENDDO
85     ENDDO
86     ENDDO
87    
88     DO k=1,Nr
89     DO j=1,sNy
90     DO i=1,sNx
91 jmc 1.3 myPa_TendScal1(i,j,k,1,1) = gThetaC(i,j,k)
92 jmc 1.1 ENDDO
93     ENDDO
94     ENDDO
95     C-- po_gu & po_gv are both on A-grid
96 jmc 1.3 CALL EXCH_UV_AGRID_3D_RL( myPa_TendVelU, myPa_TendVelV,
97     & .TRUE., Nr, myThid )
98 jmc 1.1
99     C- Write snap-shot output:
100     IF ( DIFFERENT_MULTIPLE(dumpFreq,myTime,deltaTClock)
101     & .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
102     & myTime.EQ.startTime )
103     & ) THEN
104     WRITE(suff,'(I10.10)') myIter
105 jmc 1.3 CALL WRITE_FLD_XYZ_RL( 'po_gU.', suff, myPa_TendVelU,
106     & myIter, myThid )
107     CALL WRITE_FLD_XYZ_RL( 'po_gV.', suff, myPa_TendVelV,
108     & myIter, myThid )
109     CALL WRITE_FLD_XYZ_RL( 'po_gT.', suff, myPa_TendScal1,
110     & myIter, myThid )
111 jmc 1.1 ENDIF
112    
113     RETURN
114     END

  ViewVC Help
Powered by ViewVC 1.1.22