/[MITgcm]/MITgcm/model/src/write_grid.F
ViewVC logotype

Annotation of /MITgcm/model/src/write_grid.F

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


Revision 1.32 - (hide annotations) (download)
Sat Sep 11 21:24:52 2010 UTC (13 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62k, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62u, checkpoint62t
Changes since 1.31: +11 -1 lines
first check-in of sigma (and hybrid-sigma) coordinate code

1 jmc 1.32 C $Header: /u/gcmpack/MITgcm/model/src/write_grid.F,v 1.31 2009/12/17 23:48:26 jmc Exp $
2 edhill 1.2 C $Name: $
3 jmc 1.23
4 adcroft 1.1 #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6 jmc 1.23
7 adcroft 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8     CBOP
9     C !ROUTINE: WRITE_GRID
10     C !INTERFACE:
11     SUBROUTINE WRITE_GRID(
12 jmc 1.23 I myThid )
13 adcroft 1.1
14 edhill 1.2 C !DESCRIPTION:
15     C Writes the model geometry and grid arrays to file(s) using which
16     C ever I/O package is available/active. This includes horizontal
17     C and vertical grid and finite volume modulating factors (hFacs).
18     C Essentailly, it dumps the contents of GRID.h to disk.
19 adcroft 1.1
20     C !CALLING SEQUENCE:
21     C INITIALIZE_FIXED
22     C |
23     C |-- WRITE_GRID
24    
25 jmc 1.27 C !USES:
26 adcroft 1.1 IMPLICIT NONE
27 jmc 1.27
28 adcroft 1.1 #include "SIZE.h"
29     #include "EEPARAMS.h"
30     #include "PARAMS.h"
31 edhill 1.6 #ifdef ALLOW_MNC
32     #include "MNC_PARAMS.h"
33     #endif
34 adcroft 1.1 #include "GRID.h"
35    
36     C !INPUT/OUTPUT PARAMETERS:
37     C myThid - Number of this instances
38     INTEGER myThid
39    
40     C !LOCAL VARIABLES:
41 jmc 1.21 C tmpfld :: Temporary array used to compute & write Total Depth ;
42     C loaded in multi-threaded way but written by single (master)
43     C thread => needs to be in common to be shared by all threads
44 jmc 1.28 C no longer needed since MDSIO now allows (2009/06/07) to write local arrays
45     c COMMON / LOCAL_WRITE_GRID / tmpfld
46 adcroft 1.1 _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
47 jmc 1.27 _RS tmpVar(Nr+1)
48     INTEGER i,j,k,bi,bj
49 jmc 1.18 LOGICAL writegrid_mdsio
50     #ifdef ALLOW_MNC
51     CHARACTER*(4) bfname
52     #endif
53 adcroft 1.1 CEOP
54    
55 edhill 1.2 C Calculate the fluid thickness in R coordinates as seen by the
56     C model. This may differ from what the user specified due to
57     C partial cells, etc.
58 adcroft 1.1 DO bj = myByLo(myThid), myByHi(myThid)
59 jmc 1.21 DO bi = myBxLo(myThid), myBxHi(myThid)
60     DO j=1-Oly,sNy+Oly
61     DO i=1-Olx,sNx+Olx
62     C Total fluid column thickness (r_unit) :
63     tmpfld(i,j,bi,bj) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj)
64 edhill 1.2 ENDDO
65 jmc 1.21 ENDDO
66     ENDDO
67 adcroft 1.1 ENDDO
68 jmc 1.28 c _BARRIER
69 adcroft 1.1
70 jmc 1.18 writegrid_mdsio = .TRUE.
71 edhill 1.17 #ifdef ALLOW_MNC
72 jmc 1.18 IF ( useMNC ) THEN
73     writegrid_mdsio = outputTypesInclusive .OR. .NOT.writegrid_mnc
74     ENDIF
75 edhill 1.17 #endif /* ALLOW_MNC */
76    
77 jmc 1.18 IF ( writegrid_mdsio ) THEN
78    
79 edhill 1.8 C Write horizontal grid arrays
80 jmc 1.21 CALL WRITE_FLD_XY_RS( 'XC',' ',xC,-1,myThid)
81     CALL WRITE_FLD_XY_RS( 'YC',' ',yC,-1,myThid)
82     CALL WRITE_FLD_XY_RS( 'XG',' ',xG,-1,myThid)
83     CALL WRITE_FLD_XY_RS( 'YG',' ',yG,-1,myThid)
84 jmc 1.19 CALL WRITE_FLD_XY_RS( 'RAC',' ',rA,-1,myThid)
85     CALL WRITE_FLD_XY_RS( 'RAW',' ',rAw,-1,myThid)
86     CALL WRITE_FLD_XY_RS( 'RAS',' ',rAs,-1,myThid)
87     CALL WRITE_FLD_XY_RS( 'RAZ',' ',rAz,-1,myThid)
88 jmc 1.21 CALL WRITE_FLD_XY_RS( 'DXG',' ',dxG,-1,myThid)
89     CALL WRITE_FLD_XY_RS( 'DYG',' ',dyG,-1,myThid)
90     CALL WRITE_FLD_XY_RS( 'DXC',' ',dxC,-1,myThid)
91     CALL WRITE_FLD_XY_RS( 'DYC',' ',dyC,-1,myThid)
92 mlosch 1.22 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
93 jmc 1.19 CALL WRITE_FLD_XY_RS( 'AngleCS',' ',angleCosC,-1,myThid)
94     CALL WRITE_FLD_XY_RS( 'AngleSN',' ',angleSinC,-1,myThid)
95 jmc 1.18 ENDIF
96 edhill 1.8 C Write 3D geometry arrays
97 jmc 1.19 CALL WRITE_FLD_XY_RS( 'Depth',' ',tmpfld,-1,myThid)
98     CALL WRITE_FLD_XYZ_RS( 'hFacC',' ',hFacC, 0,myThid)
99     CALL WRITE_FLD_XYZ_RS( 'hFacW',' ',hFacW, 0,myThid)
100     CALL WRITE_FLD_XYZ_RS( 'hFacS',' ',hFacS, 0,myThid)
101 jmc 1.18 IF (buoyancyRelation .EQ. 'ATMOSPHERIC')
102 jmc 1.19 & CALL WRITE_FLD_XY_RS( 'topo_P',' ',Ro_surf,-1,myThid)
103 jmc 1.31 IF ( useOBCS ) THEN
104     CALL WRITE_FLD_XY_RS( 'maskInC',' ', maskInC, -1, myThid )
105     CALL WRITE_FLD_XY_RS( 'maskInW',' ', maskInW, -1, myThid )
106     CALL WRITE_FLD_XY_RS( 'maskInS',' ', maskInS, -1, myThid )
107     ENDIF
108 jmc 1.19
109     C Write vertical grid arrays
110 jmc 1.27 CALL WRITE_GLVEC_RS( 'RC', ' ', rC, Nr, -1, myThid )
111     CALL WRITE_GLVEC_RS( 'RF', ' ', rF, 1+Nr,-1, myThid )
112     CALL WRITE_GLVEC_RS( 'DRC',' ', drC, Nr, -1, myThid )
113     CALL WRITE_GLVEC_RS( 'DRF',' ', drF, Nr, -1, myThid )
114 jmc 1.32 IF ( selectSigmaCoord.NE.0 ) THEN
115     CALL WRITE_GLVEC_RS( 'AHybSigF',' ',aHybSigmF,1+Nr,-1,myThid )
116     CALL WRITE_GLVEC_RS( 'BHybSigF',' ',bHybSigmF,1+Nr,-1,myThid )
117     CALL WRITE_GLVEC_RS( 'AHybSigC',' ',aHybSigmC, Nr, -1,myThid )
118     CALL WRITE_GLVEC_RS( 'BHybSigC',' ',bHybSigmC, Nr, -1,myThid )
119     CALL WRITE_GLVEC_RS('DAHybSigF',' ',dAHybSigF, Nr, -1,myThid )
120     CALL WRITE_GLVEC_RS('DBHybSigF',' ',dBHybSigF, Nr, -1,myThid )
121     CALL WRITE_GLVEC_RS('DAHybSigC',' ',dAHybSigC,1+Nr,-1,myThid )
122     CALL WRITE_GLVEC_RS('DBHybSigC',' ',dBHybSigC,1+Nr,-1,myThid )
123     ENDIF
124 jmc 1.23 C-- comment out the "if": also usefull for the Ocean (to get the full Presure)
125     c IF (buoyancyRelation .EQ. 'ATMOSPHERIC') THEN
126     DO k=1,Nr+1
127     tmpVar(k) = phiRef(2*k-1)
128     ENDDO
129 jmc 1.27 CALL WRITE_GLVEC_RS( 'PHrefF',' ',tmpVar,1+Nr,-1, myThid )
130 jmc 1.23 DO k=1,Nr
131     tmpVar(k) = phiRef(2*k)
132     ENDDO
133 jmc 1.27 CALL WRITE_GLVEC_RS( 'PHrefC',' ',tmpVar, Nr, -1, myThid )
134 jmc 1.23 c ENDIF
135 edhill 1.2
136 jmc 1.21 ENDIF
137 jmc 1.18
138 jmc 1.21 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
139 adcroft 1.1
140     #ifdef ALLOW_MNC
141 jmc 1.18 IF ( useMNC .AND. writegrid_mnc ) THEN
142 edhill 1.17
143     _BEGIN_MASTER( myThid )
144 edhill 1.7 bfname='grid'
145 jmc 1.23
146 edhill 1.2 C Write the GRID.h variables to a file
147     CALL MNC_CW_SET_UDIM(bfname, 0, myThid)
148 edhill 1.15 CALL MNC_CW_SET_CITER(bfname, 2, -1, -1, -1, myThid)
149 edhill 1.16 CALL MNC_CW_SET_UDIM(bfname, 1, myThid)
150 mlosch 1.24 CALL MNC_CW_RS_W('D',bfname,0,0,'RC',rC,myThid)
151     CALL MNC_CW_RS_W('D',bfname,0,0,'RF',rF,myThid)
152     CALL MNC_CW_RS_W('D',bfname,0,0,'RU',rF(2),myThid)
153     CALL MNC_CW_RS_W('D',bfname,0,0,'RL',rF,myThid)
154     CALL MNC_CW_RS_W('D',bfname,0,0,'drC',drC,myThid)
155     CALL MNC_CW_RS_W('D',bfname,0,0,'drF',drF,myThid)
156     CALL MNC_CW_RS_W('D',bfname,0,0,'XC',xC,myThid)
157     CALL MNC_CW_RS_W('D',bfname,0,0,'YC',yC,myThid)
158     c CALL MNC_CW_RS_W('D',bfname,0,0,'XU',xG,myThid)
159     c CALL MNC_CW_RS_W('D',bfname,0,0,'YU',yC,myThid)
160     c CALL MNC_CW_RS_W('D',bfname,0,0,'XV',xC,myThid)
161     c CALL MNC_CW_RS_W('D',bfname,0,0,'YV',yG,myThid)
162     CALL MNC_CW_RS_W('D',bfname,0,0,'XG',xG,myThid)
163     CALL MNC_CW_RS_W('D',bfname,0,0,'YG',yG,myThid)
164     CALL MNC_CW_RS_W('D',bfname,0,0,'dxC',dxC,myThid)
165     CALL MNC_CW_RS_W('D',bfname,0,0,'dyC',dyC,myThid)
166     CALL MNC_CW_RS_W('D',bfname,0,0,'dxF',dxF,myThid)
167     CALL MNC_CW_RS_W('D',bfname,0,0,'dyF',dyF,myThid)
168     CALL MNC_CW_RS_W('D',bfname,0,0,'dxG',dxG,myThid)
169     CALL MNC_CW_RS_W('D',bfname,0,0,'dyG',dyG,myThid)
170     CALL MNC_CW_RS_W('D',bfname,0,0,'dxV',dxV,myThid)
171     CALL MNC_CW_RS_W('D',bfname,0,0,'dyU',dyU,myThid)
172     CALL MNC_CW_RS_W('D',bfname,0,0,'rA',rA,myThid)
173     CALL MNC_CW_RS_W('D',bfname,0,0,'rAw',rAw,myThid)
174     CALL MNC_CW_RS_W('D',bfname,0,0,'rAs',rAs,myThid)
175     CALL MNC_CW_RS_W('D',bfname,0,0,'rAz',rAz,myThid)
176     IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
177     CALL MNC_CW_RS_W('D',bfname,0,0,'AngleCS',angleCosC,myThid)
178     CALL MNC_CW_RS_W('D',bfname,0,0,'AngleSN',angleSinC,myThid)
179     ENDIF
180     CALL MNC_CW_RS_W('D',bfname,0,0,'fCori',fCori,myThid)
181     CALL MNC_CW_RS_W('D',bfname,0,0,'fCoriG',fCoriG,myThid)
182     CALL MNC_CW_RS_W('D',bfname,0,0,'R_low',R_low,myThid)
183     CALL MNC_CW_RS_W('D',bfname,0,0,'Ro_surf',Ro_surf,myThid)
184     CALL MNC_CW_RS_W('D',bfname,0,0,'Depth',tmpfld,myThid)
185     CALL MNC_CW_RS_W('D',bfname,0,0,'HFacC',HFacC,myThid)
186     CALL MNC_CW_RS_W('D',bfname,0,0,'HFacW',HFacW,myThid)
187     CALL MNC_CW_RS_W('D',bfname,0,0,'HFacS',HFacS,myThid)
188 jmc 1.21
189 edhill 1.17 _END_MASTER(myThid)
190 edhill 1.2
191 adcroft 1.1 ENDIF
192 mlosch 1.29
193     IF ( useMNC .AND. (usingCurvilinearGrid .OR. rotateGrid) ) THEN
194     C If the grid is not simply cartesian, cylindrical or spherical,
195 jmc 1.31 C include additional coordinate information to the following files
196     IF ( snapshot_mnc .AND.
197 mlosch 1.30 & ( dumpFreq .GT. 0. .OR. dumpInitAndLast ) )
198 mlosch 1.29 & CALL MNC_CW_WRITE_GRID_COORD('state', myThid)
199     #if (defined ALLOW_AUTODIFF) && \
200     (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM)) && \
201     (defined ALLOW_AUTODIFF_MONITOR)
202 mlosch 1.30 IF ( autodiff_mnc .AND. adjDumpFreq .GT. 0. ) THEN
203 mlosch 1.29 CALL MNC_CW_WRITE_GRID_COORD('adstate', myThid)
204     #ifdef ALLOW_EXF
205     IF (useEXF) CALL MNC_CW_WRITE_GRID_COORD('adexf',myThid)
206     #endif /* ALLOW_EXF */
207 jmc 1.31 #ifdef ALLOW_SEAICE
208 mlosch 1.29 IF (useSEAICE) CALL MNC_CW_WRITE_GRID_COORD('adseaice',myThid)
209     #endif /* ALLOW_SEAICE */
210     ENDIF
211     #endif /* ALLOW_AUTODIFF */
212     ENDIF
213    
214 adcroft 1.1 #endif /* ALLOW_MNC */
215    
216     RETURN
217     END

  ViewVC Help
Powered by ViewVC 1.1.22