/[MITgcm]/MITgcm_contrib/nesting_sannino/nest_child/nest_child_write_state.F
ViewVC logotype

Annotation of /MITgcm_contrib/nesting_sannino/nest_child/nest_child_write_state.F

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


Revision 1.2 - (hide annotations) (download)
Fri Oct 23 19:44:03 2009 UTC (16 years, 1 month ago) by sannino
Branch: MAIN
Changes since 1.1: +18 -49 lines
commit updated files (bug-fixes plus clean-ups)

1 heimbach 1.1 C $Header: /u/gcmpack/MITgcm/model/src/write_state_x_nest_child.F,v 1.54 2006/05/22 04:03:09 gianmaria sannino $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     #undef MULTIPLE_RECORD_STATE_FILES
8    
9     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
10     CBOP
11 sannino 1.2 C !ROUTINE: NEST_CHILD_WRITE_STATE
12 heimbach 1.1
13     C !INTERFACE:
14     SUBROUTINE NEST_CHILD_WRITE_STATE ( myTime, myIter, myThid )
15    
16     C !USES:
17     IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #ifdef ALLOW_MNC
22     #include "MNC_PARAMS.h"
23     #endif
24     #include "DYNVARS.h"
25     #include "GRID.h"
26     #include "EESUPPORT.h"
27     #include "NEST_CHILD_PARAMS.h"
28     #include "NEST_CHILD.h"
29     #ifdef EXACT_CONSERV
30     # include "SURFACE.h"
31     #endif
32    
33     C !INPUT/OUTPUT PARAMETERS:
34     C myThid - Thread number for this instance of the routine.
35     C myIter - Iteration number
36     C myTime - Current time of simulation ( s )
37     _RL myTime
38     INTEGER myThid
39     INTEGER myIter
40    
41 sannino 1.2 INTEGER bi,bj
42     INTEGER i,j,k
43     INTEGER ierr
44     INTEGER indexF,index1F
45     PARAMETER(indexF=sNx*sNy*Nr*15)
46     PARAMETER(index1F=sNx*sNy*4)
47 heimbach 1.1
48     c
49     _RL global3D(sNx,sNy,Nr,15)
50     c |____________________________ 15 fields
51     c
52     _RL global2D(sNx,sNy,4)
53     c |_________________________________ 4 fields
54     c
55 sannino 1.2 IF (mpiMyId.eq.0) THEN
56 heimbach 1.1
57 sannino 1.2 TRANSPORT_OVEST = TRANSPORT_OVEST/3.
58 heimbach 1.1 call MPI_SEND (TRANSPORT_OVEST, 1, MPI_REAL8,
59 sannino 1.2 & MSTR_DRV_C(NST_LEV_C), 3000,
60 heimbach 1.1 & MPI_Comm_World,ierr)
61    
62     TRANSPORT_EST = TRANSPORT_EST/3.
63     call MPI_SEND (TRANSPORT_EST, 1, MPI_REAL8,
64 sannino 1.2 & MSTR_DRV_C(NST_LEV_C), 3000,
65 heimbach 1.1 & MPI_Comm_World,ierr)
66    
67     ENDIF
68    
69 sannino 1.2
70 heimbach 1.1 c 3D VAR
71     c -------
72    
73     c
74     DO k=1,Nr
75     DO bj = myByLo(myThid), myByHi(myThid)
76     DO bi = myBxLo(myThid), myBxHi(myThid)
77     DO J=1,sNy
78     DO I=1,sNx
79     c
80     global3D(I,J,K,1) = uvel(I,J,k,bi,bj)
81     global3D(I,J,K,2) = vvel(I,J,k,bi,bj)
82     global3D(I,J,K,3) = theta(I,J,k,bi,bj)
83     global3D(I,J,K,4) = salt(I,J,k,bi,bj)
84    
85     global3D(I,J,K,5) = gU(I,J,k,bi,bj)
86     global3D(I,J,K,6) = gV(I,J,k,bi,bj)
87     global3D(I,J,K,7) = gT(I,J,k,bi,bj)
88     global3D(I,J,K,8) = gS(I,J,k,bi,bj)
89    
90     global3D(I,J,K,9) = guNm1_MEMO(I,J,k,bi,bj)
91     global3D(I,J,K,10) = gvNm1_MEMO(I,J,k,bi,bj)
92     global3D(I,J,K,11) = gtNm1_MEMO(I,J,k,bi,bj)
93     global3D(I,J,K,12) = gsNm1_MEMO(I,J,k,bi,bj)
94    
95     global3D(I,J,K,13) = totPhiHyd(I,J,k,bi,bj)
96     global3D(I,J,K,14) = IVDConvCount(I,J,k,bi,bj)
97     global3D(I,J,K,15) = wvel(I,J,k,bi,bj)
98     ENDDO
99     ENDDO
100     ENDDO
101     ENDDO
102     ENDDO
103    
104     c 2D VAR
105     c---------
106     c
107     DO bj = myByLo(myThid), myByHi(myThid)
108     DO bi = myBxLo(myThid), myBxHi(myThid)
109     DO J=1,sNy
110     DO I=1,sNx
111     global2D(I,J,1) = etaN(I,J,bi,bj)
112     global2D(I,J,2) = etaH(I,J,bi,bj)
113     global2D(I,J,3) = phiHydLow(I,J,bi,bj)
114     global2D(I,J,4) = dEtaHdt_MEMO(I,J,bi,bj)
115     c global2D(I,J,5) = etaHnm1(I,J,bi,bj)
116     ENDDO
117     ENDDO
118     ENDDO
119     ENDDO
120     C---------------------------------------------------
121     c Send the signal of OK to the COARSE model
122     c---------------------------------------------------
123 sannino 1.2 call MPI_SEND (global3D, indexF, MPI_REAL8,
124     & MSTR_DRV_C(NST_LEV_C), 3000,
125 heimbach 1.1 & MPI_Comm_World,ierr)
126    
127     call MPI_BARRIER(MPI_COMM_MODEL,ierr)
128    
129 sannino 1.2 call MPI_SEND (global2D, index1F, MPI_REAL8,
130     & MSTR_DRV_C(NST_LEV_C), 3000,
131 heimbach 1.1 & MPI_Comm_World,ierr)
132    
133 sannino 1.2 RETURN
134     END

  ViewVC Help
Powered by ViewVC 1.1.22