/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/write_grid.F
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/write_grid.F

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


Revision 1.1 - (hide annotations) (download)
Wed Jan 11 06:34:23 2006 UTC (20 years, 10 months ago) by utke
Branch: MAIN
make private copy because these files are not in the list to be
trasnformed but some activated global variables are being
used and therefore we have to either transform them as well
or here I just manually fixed the few such uses.

1 utke 1.1 C $Header: /u/gcmpack/MITgcm/model/src/write_grid.F,v 1.20 2005/11/08 23:01:10 cnh Exp $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8     CBOP
9     C !ROUTINE: WRITE_GRID
10     C !INTERFACE:
11     SUBROUTINE WRITE_GRID(
12     I myThid )
13    
14     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    
20     C !CALLING SEQUENCE:
21     C INITIALIZE_FIXED
22     C |
23     C |-- WRITE_GRID
24    
25     IMPLICIT NONE
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29     #ifdef ALLOW_MNC
30     #include "MNC_PARAMS.h"
31     #endif
32     #include "GRID.h"
33    
34     C !INPUT/OUTPUT PARAMETERS:
35     C myThid - Number of this instances
36     INTEGER myThid
37    
38     C !LOCAL VARIABLES:
39     C tmpfld - Temporary array used to compute & write Total Depth
40     C has to be in common for multi threading
41     C ?aja: not sure why the COMMON block is necessary - should ask JMC?
42     c COMMON / LOCAL_INI_MASKS_ETC / tmpfld
43     _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
44     INTEGER i,j,bi,bj
45     LOGICAL writegrid_mdsio
46     #ifdef ALLOW_MNC
47     CHARACTER*(4) bfname
48     #endif
49     CEOP
50    
51     C Calculate the fluid thickness in R coordinates as seen by the
52     C model. This may differ from what the user specified due to
53     C partial cells, etc.
54     DO bj = myByLo(myThid), myByHi(myThid)
55     DO bi = myBxLo(myThid), myBxHi(myThid)
56     DO j=1-Oly,sNy+Oly
57     DO i=1-Olx,sNx+Olx
58     C Total fluid column thickness (r_unit) :
59     tmpfld(i,j,bi,bj) = Ro_surf(i,j,bi,bj)%v -
60     &R_low(i,j,bi,bj)%v
61     ENDDO
62     ENDDO
63     ENDDO
64     ENDDO
65    
66     writegrid_mdsio = .TRUE.
67     #ifdef ALLOW_MNC
68     IF ( useMNC ) THEN
69     writegrid_mdsio = outputTypesInclusive .OR. .NOT.writegrid_mnc
70     ENDIF
71     #endif /* ALLOW_MNC */
72    
73     IF ( writegrid_mdsio ) THEN
74    
75     C _BEGIN_MASTER( myThid )
76    
77     C Write horizontal grid arrays
78     CALL WRITE_FLD_XY_RS( 'XC',' ',XC,-1,myThid)
79     CALL WRITE_FLD_XY_RS( 'YC',' ',YC,-1,myThid)
80     CALL WRITE_FLD_XY_RS( 'XG',' ',XG,-1,myThid)
81     CALL WRITE_FLD_XY_RS( 'YG',' ',YG,-1,myThid)
82     CALL WRITE_FLD_XY_RS( 'RAC',' ',rA,-1,myThid)
83     CALL WRITE_FLD_XY_RS( 'RAW',' ',rAw,-1,myThid)
84     CALL WRITE_FLD_XY_RS( 'RAS',' ',rAs,-1,myThid)
85     CALL WRITE_FLD_XY_RS( 'RAZ',' ',rAz,-1,myThid)
86     CALL WRITE_FLD_XY_RS( 'DXG',' ',DXG,-1,myThid)
87     CALL WRITE_FLD_XY_RS( 'DYG',' ',DYG,-1,myThid)
88     CALL WRITE_FLD_XY_RS( 'DXC',' ',DXC,-1,myThid)
89     CALL WRITE_FLD_XY_RS( 'DYC',' ',DYC,-1,myThid)
90     IF ( usingCurvilinearGrid ) THEN
91     CALL WRITE_FLD_XY_RS( 'AngleCS',' ',angleCosC,-1,myThid)
92     CALL WRITE_FLD_XY_RS( 'AngleSN',' ',angleSinC,-1,myThid)
93     ENDIF
94     C Write 3D geometry arrays
95     CALL WRITE_FLD_XY_RS( 'Depth',' ',tmpfld,-1,myThid)
96     CALL WRITE_FLD_XYZ_RS( 'hFacC',' ',hFacC, 0,myThid)
97     CALL WRITE_FLD_XYZ_RS( 'hFacW',' ',hFacW, 0,myThid)
98     CALL WRITE_FLD_XYZ_RS( 'hFacS',' ',hFacS, 0,myThid)
99     IF (buoyancyRelation .EQ. 'ATMOSPHERIC')
100     & CALL WRITE_FLD_XY_RS( 'topo_P',' ',Ro_surf,-1,myThid)
101    
102     #ifdef ALLOW_MDSIO
103     C Write vertical grid arrays
104     CALL MDSWRITEVEC_LOC_RS('RC', writeBinaryPrec, Nr, rC,
105     & 0,0, 1, -1, myThid)
106     CALL MDSWRITEVEC_LOC_RS('RF', writeBinaryPrec,1+Nr, rF,
107     & 0,0, 1, -1, myThid)
108     CALL MDSWRITEVEC_LOC_RS('DRC',writeBinaryPrec, Nr, drC,
109     & 0,0, 1, -1, myThid)
110     CALL MDSWRITEVEC_LOC_RS('DRF',writeBinaryPrec, Nr, drF,
111     & 0,0, 1, -1, myThid)
112     #endif /* ALLOW_MDSIO */
113    
114     C _END_MASTER(myThid)
115    
116     ENDIF
117    
118     #ifdef ALLOW_MNC
119     IF ( useMNC .AND. writegrid_mnc ) THEN
120    
121     _BEGIN_MASTER( myThid )
122     bfname='grid'
123    
124     C Write the GRID.h variables to a file
125     CALL MNC_CW_SET_UDIM(bfname, 0, myThid)
126     CALL MNC_CW_SET_CITER(bfname, 2, -1, -1, -1, myThid)
127     CALL MNC_CW_SET_UDIM(bfname, 1, myThid)
128     CALL MNC_CW_RL_W('D',bfname,0,0,'RC',rC,myThid)
129     CALL MNC_CW_RL_W('D',bfname,0,0,'RF',rF,myThid)
130     CALL MNC_CW_RL_W('D',bfname,0,0,'RU',rF(2),myThid)
131     CALL MNC_CW_RL_W('D',bfname,0,0,'RL',rF,myThid)
132     CALL MNC_CW_RL_W('D',bfname,0,0,'drC',drC,myThid)
133     CALL MNC_CW_RL_W('D',bfname,0,0,'drF',drF,myThid)
134     CALL MNC_CW_RL_W('D',bfname,0,0,'XC',xC,myThid)
135     CALL MNC_CW_RL_W('D',bfname,0,0,'YC',yC,myThid)
136     c CALL MNC_CW_RL_W('D',bfname,0,0,'XU',xG,myThid)
137     c CALL MNC_CW_RL_W('D',bfname,0,0,'YU',yC,myThid)
138     c CALL MNC_CW_RL_W('D',bfname,0,0,'XV',xC,myThid)
139     c CALL MNC_CW_RL_W('D',bfname,0,0,'YV',yG,myThid)
140     CALL MNC_CW_RL_W('D',bfname,0,0,'XG',xG,myThid)
141     CALL MNC_CW_RL_W('D',bfname,0,0,'YG',yG,myThid)
142     CALL MNC_CW_RL_W('D',bfname,0,0,'dxC',dxC,myThid)
143     CALL MNC_CW_RL_W('D',bfname,0,0,'dyC',dyC,myThid)
144     CALL MNC_CW_RL_W('D',bfname,0,0,'dxF',dxF,myThid)
145     CALL MNC_CW_RL_W('D',bfname,0,0,'dyF',dyF,myThid)
146     CALL MNC_CW_RL_W('D',bfname,0,0,'dxG',dxG,myThid)
147     CALL MNC_CW_RL_W('D',bfname,0,0,'dyG',dyG,myThid)
148     CALL MNC_CW_RL_W('D',bfname,0,0,'dxV',dxV,myThid)
149     CALL MNC_CW_RL_W('D',bfname,0,0,'dyU',dyU,myThid)
150     CALL MNC_CW_RL_W('D',bfname,0,0,'rA',rA,myThid)
151     CALL MNC_CW_RL_W('D',bfname,0,0,'rAw',rAw,myThid)
152     CALL MNC_CW_RL_W('D',bfname,0,0,'rAs',rAs,myThid)
153     CALL MNC_CW_RL_W('D',bfname,0,0,'rAz',rAz,myThid)
154     IF ( usingCurvilinearGrid ) THEN
155     CALL MNC_CW_RL_W('D',bfname,0,0,'AngleCS',angleCosC,myThid)
156     CALL MNC_CW_RL_W('D',bfname,0,0,'AngleSN',angleSinC,myThid)
157     ENDIF
158     CALL MNC_CW_RL_W('D',bfname,0,0,'fCori',fCori,myThid)
159     CALL MNC_CW_RL_W('D',bfname,0,0,'fCoriG',fCoriG,myThid)
160     CALL MNC_CW_RL_W('D',bfname,0,0,'R_low',R_low,myThid)
161     CALL MNC_CW_RL_W('D',bfname,0,0,'Ro_surf',Ro_surf,myThid)
162     CALL MNC_CW_RL_W('D',bfname,0,0,'Depth',tmpfld,myThid)
163     CALL MNC_CW_RL_W('D',bfname,0,0,'HFacC',HFacC,myThid)
164     CALL MNC_CW_RL_W('D',bfname,0,0,'HFacW',HFacW,myThid)
165     CALL MNC_CW_RL_W('D',bfname,0,0,'HFacS',HFacS,myThid)
166     _END_MASTER(myThid)
167    
168     ENDIF
169     #endif /* ALLOW_MNC */
170    
171     RETURN
172     END
173    
174     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
175    

  ViewVC Help
Powered by ViewVC 1.1.22