/[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.1 - (hide annotations) (download)
Wed Oct 21 00:00:29 2009 UTC (16 years, 2 months ago) by heimbach
Branch: MAIN
Initial checkin of two-way nesting code by
Sannino et al., Ocean Modeling, 2009

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     C !ROUTINE: WRITE_STATE
12    
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     INTEGER iG,jG,bi,bj,i,j,k,ii,ierr
42     INTEGER iIndex(6)
43     !TIMING-------------
44     _RL t(0:30),timef
45    
46     integer indiceF,indice1F
47     parameter(indiceF=sNx*sNy*Nr*15)
48     parameter(indice1F=sNx*sNy*4)
49    
50     c
51     _RL global3D(sNx,sNy,Nr,15)
52     c |____________________________ 15 fields
53     c
54     _RL global2D(sNx,sNy,4)
55     c |_________________________________ 4 fields
56     c
57    
58     c----------------------------------------------------
59     c************** DEFINE INDEX ********************
60     c----------------------------------------------------
61     t(1)=timef()
62     iIndex(1) = 20 !5 !2
63     iIndex(2) = 21 !6 !3
64     iIndex(3) = 22 !7 !4
65    
66     iIndex(4) = Nx-6 !3
67     iIndex(5) = Nx-5 !2
68     iIndex(6) = Nx-4 !1
69     c---------------------------------------------------
70     c goto 9999
71    
72     cgmPROVA(
73     IF (mpiMyId.eq.0) THEN
74    
75     TRANSPORT_OVEST = TRANSPORT_OVEST/3.
76     call MPI_SEND (TRANSPORT_OVEST, 1, MPI_REAL8,
77     & MSTR_DRV_S(NST_LEV_S), 3000,
78     & MPI_Comm_World,ierr)
79    
80     TRANSPORT_EST = TRANSPORT_EST/3.
81     call MPI_SEND (TRANSPORT_EST, 1, MPI_REAL8,
82     & MSTR_DRV_S(NST_LEV_S), 3000,
83     & MPI_Comm_World,ierr)
84    
85     ENDIF
86     cgmPROVA)
87    
88     c=====================================================================
89     c 3D VAR
90     c -------
91    
92     c
93     DO k=1,Nr
94     DO bj = myByLo(myThid), myByHi(myThid)
95     DO bi = myBxLo(myThid), myBxHi(myThid)
96     DO J=1,sNy
97     DO I=1,sNx
98     c
99     global3D(I,J,K,1) = uvel(I,J,k,bi,bj)
100     global3D(I,J,K,2) = vvel(I,J,k,bi,bj)
101     global3D(I,J,K,3) = theta(I,J,k,bi,bj)
102     global3D(I,J,K,4) = salt(I,J,k,bi,bj)
103    
104     global3D(I,J,K,5) = gU(I,J,k,bi,bj)
105     global3D(I,J,K,6) = gV(I,J,k,bi,bj)
106     global3D(I,J,K,7) = gT(I,J,k,bi,bj)
107     global3D(I,J,K,8) = gS(I,J,k,bi,bj)
108    
109     global3D(I,J,K,9) = guNm1_MEMO(I,J,k,bi,bj)
110     global3D(I,J,K,10) = gvNm1_MEMO(I,J,k,bi,bj)
111     global3D(I,J,K,11) = gtNm1_MEMO(I,J,k,bi,bj)
112     global3D(I,J,K,12) = gsNm1_MEMO(I,J,k,bi,bj)
113    
114     global3D(I,J,K,13) = totPhiHyd(I,J,k,bi,bj)
115     global3D(I,J,K,14) = IVDConvCount(I,J,k,bi,bj)
116     global3D(I,J,K,15) = wvel(I,J,k,bi,bj)
117     ENDDO
118     ENDDO
119     ENDDO
120     ENDDO
121     ENDDO
122    
123     c 2D VAR
124     c---------
125     c
126     DO bj = myByLo(myThid), myByHi(myThid)
127     DO bi = myBxLo(myThid), myBxHi(myThid)
128     DO J=1,sNy
129     DO I=1,sNx
130     global2D(I,J,1) = etaN(I,J,bi,bj)
131     global2D(I,J,2) = etaH(I,J,bi,bj)
132     global2D(I,J,3) = phiHydLow(I,J,bi,bj)
133     global2D(I,J,4) = dEtaHdt_MEMO(I,J,bi,bj)
134     c global2D(I,J,5) = etaHnm1(I,J,bi,bj)
135     ENDDO
136     ENDDO
137     ENDDO
138     ENDDO
139    
140     ! _BARRIER
141     C---------------------------------------------------
142     c Send the signal of OK to the COARSE model
143     c---------------------------------------------------
144     !VIC
145     c write(*,*) 'VIC: HO SCRITTO nesting_F2C'
146     c write(*,*) 'VIC: MANDO SEGNALE DI OK AL DRIVER'
147     t(2)=timef()
148     c write(*,*) 'tempo di calcolo', t(2)-t(1)
149    
150     call MPI_SEND (global3D, indiceF, MPI_REAL8,
151     & MSTR_DRV_S(NST_LEV_S), 3000,
152     & MPI_Comm_World,ierr)
153    
154     call MPI_BARRIER(MPI_COMM_MODEL,ierr)
155    
156     call MPI_SEND (global2D, indice1F, MPI_REAL8,
157     & MSTR_DRV_S(NST_LEV_S), 3000,
158     & MPI_Comm_World,ierr)
159     c------------------------------------------------------
160    
161     t(3)=timef()
162     c write(*,*) 'tempo di invio dati al DRIVER', t(3)-t(2)
163    
164     RETURN
165     END

  ViewVC Help
Powered by ViewVC 1.1.22