File indexing completed on 2021-02-24 06:10:58 UTC
view on githubraw file Latest commit 714c41fa on 2021-02-16 12:47:13 UTC
f4a7634227 Alis*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_OPTIONS.h"
341366d590 Jean*0003 #include "AD_CONFIG.h"
14e0496834 Jean*0004 #ifdef ALLOW_AUTODIFF
0005 # include "AUTODIFF_OPTIONS.h"
0006 #endif
7634fc94b4 Jean*0007
f4a7634227 Alis*0008
0009
0010
0011
0012 SUBROUTINE WRITE_GRID(
7634fc94b4 Jean*0013 I myThid )
f4a7634227 Alis*0014
a30418b6b9 Ed H*0015
0016
0017
0018
0019
f4a7634227 Alis*0020
0021
0022
0023
0024
0025
d0b8d6d9c3 Jean*0026
f4a7634227 Alis*0027 IMPLICIT NONE
d0b8d6d9c3 Jean*0028
f4a7634227 Alis*0029 #include "SIZE.h"
0030 #include "EEPARAMS.h"
0031 #include "PARAMS.h"
f31930e56f Ed H*0032 #ifdef ALLOW_MNC
0033 #include "MNC_PARAMS.h"
0034 #endif
f4a7634227 Alis*0035 #include "GRID.h"
0036
0037
0038
0039 INTEGER myThid
0040
0041
115f70d8c8 Jean*0042
0043
0044
7e2457fc25 Jean*0045
0046
f4a7634227 Alis*0047 _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
7634fc94b4 Jean*0048 _RS tmpVar(Nr+1)
d0b8d6d9c3 Jean*0049 INTEGER i,j,k,bi,bj
0050 LOGICAL writegrid_mdsio
d306386a6d Jean*0051 #ifdef ALLOW_MNC
0052 CHARACTER*(4) bfname
0053 #endif
f4a7634227 Alis*0054
0055
a30418b6b9 Ed H*0056
0057
0058
f4a7634227 Alis*0059 DO bj = myByLo(myThid), myByHi(myThid)
115f70d8c8 Jean*0060 DO bi = myBxLo(myThid), myBxHi(myThid)
633b1f5c22 Jean*0061 DO j=1-OLy,sNy+OLy
0062 DO i=1-OLx,sNx+OLx
115f70d8c8 Jean*0063
0064 tmpfld(i,j,bi,bj) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj)
a30418b6b9 Ed H*0065 ENDDO
115f70d8c8 Jean*0066 ENDDO
0067 ENDDO
f4a7634227 Alis*0068 ENDDO
7e2457fc25 Jean*0069
f4a7634227 Alis*0070
d306386a6d Jean*0071 writegrid_mdsio = .TRUE.
fef0093425 Ed H*0072 #ifdef ALLOW_MNC
d306386a6d Jean*0073 IF ( useMNC ) THEN
0074 writegrid_mdsio = outputTypesInclusive .OR. .NOT.writegrid_mnc
0075 ENDIF
fef0093425 Ed H*0076 #endif /* ALLOW_MNC */
0077
d306386a6d Jean*0078 IF ( writegrid_mdsio ) THEN
0079
7af35f0733 Ed H*0080
115f70d8c8 Jean*0081 CALL WRITE_FLD_XY_RS( 'XC',' ',xC,-1,myThid)
0082 CALL WRITE_FLD_XY_RS( 'YC',' ',yC,-1,myThid)
0083 CALL WRITE_FLD_XY_RS( 'XG',' ',xG,-1,myThid)
0084 CALL WRITE_FLD_XY_RS( 'YG',' ',yG,-1,myThid)
8f24437970 Jean*0085 CALL WRITE_FLD_XY_RS( 'RAC',' ',rA,-1,myThid)
0086 CALL WRITE_FLD_XY_RS( 'RAW',' ',rAw,-1,myThid)
0087 CALL WRITE_FLD_XY_RS( 'RAS',' ',rAs,-1,myThid)
0088 CALL WRITE_FLD_XY_RS( 'RAZ',' ',rAz,-1,myThid)
115f70d8c8 Jean*0089 CALL WRITE_FLD_XY_RS( 'DXG',' ',dxG,-1,myThid)
0090 CALL WRITE_FLD_XY_RS( 'DYG',' ',dyG,-1,myThid)
0091 CALL WRITE_FLD_XY_RS( 'DXC',' ',dxC,-1,myThid)
0092 CALL WRITE_FLD_XY_RS( 'DYC',' ',dyC,-1,myThid)
714c41fa91 Nils 0093 CALL WRITE_FLD_XY_RS( 'DXF',' ',dxF,-1,myThid)
0094 CALL WRITE_FLD_XY_RS( 'DYF',' ',dyF,-1,myThid)
0095 CALL WRITE_FLD_XY_RS( 'DXV',' ',dxV,-1,myThid)
0096 CALL WRITE_FLD_XY_RS( 'DYU',' ',dyU,-1,myThid)
66314ec55a Mart*0097 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8f24437970 Jean*0098 CALL WRITE_FLD_XY_RS( 'AngleCS',' ',angleCosC,-1,myThid)
0099 CALL WRITE_FLD_XY_RS( 'AngleSN',' ',angleSinC,-1,myThid)
a4ade06ee0 Jean*0100 CALL WRITE_FLD_XY_RS( 'U2zonDir',' ',u2zonDir,-1,myThid)
0101 CALL WRITE_FLD_XY_RS( 'V2zonDir',' ',v2zonDir,-1,myThid)
d306386a6d Jean*0102 ENDIF
7af35f0733 Ed H*0103
8f24437970 Jean*0104 CALL WRITE_FLD_XY_RS( 'Depth',' ',tmpfld,-1,myThid)
633b1f5c22 Jean*0105 IF ( debugLevel.GE.debLevC ) THEN
0106 CALL WRITE_FLD_XY_RS( 'rLowC', ' ', R_low, -1,myThid)
0107 CALL WRITE_FLD_XY_RS( 'rLowW', ' ', rLowW, -1,myThid)
0108 CALL WRITE_FLD_XY_RS( 'rLowS', ' ', rLowS, -1,myThid)
0109 CALL WRITE_FLD_XY_RS( 'rSurfC',' ',Ro_surf,-1,myThid)
0110 CALL WRITE_FLD_XY_RS( 'rSurfW',' ',rSurfW, -1,myThid)
0111 CALL WRITE_FLD_XY_RS( 'rSurfS',' ',rSurfS, -1,myThid)
0112 ENDIF
8f24437970 Jean*0113 CALL WRITE_FLD_XYZ_RS( 'hFacC',' ',hFacC, 0,myThid)
0114 CALL WRITE_FLD_XYZ_RS( 'hFacW',' ',hFacW, 0,myThid)
0115 CALL WRITE_FLD_XYZ_RS( 'hFacS',' ',hFacS, 0,myThid)
633b1f5c22 Jean*0116 IF ( fluidIsAir )
0117 & CALL WRITE_FLD_XY_RS( 'topo_P',' ',Ro_surf,-1,myThid)
300ac09bf1 Jean*0118 IF ( useOBCS ) THEN
0119 CALL WRITE_FLD_XY_RS( 'maskInC',' ', maskInC, -1, myThid )
0120 CALL WRITE_FLD_XY_RS( 'maskInW',' ', maskInW, -1, myThid )
0121 CALL WRITE_FLD_XY_RS( 'maskInS',' ', maskInS, -1, myThid )
719636ecfb Jean*0122
0123
0124
300ac09bf1 Jean*0125 ENDIF
8f24437970 Jean*0126
0127
d0b8d6d9c3 Jean*0128 CALL WRITE_GLVEC_RS( 'RC', ' ', rC, Nr, -1, myThid )
0129 CALL WRITE_GLVEC_RS( 'RF', ' ', rF, 1+Nr,-1, myThid )
700c03e4bf Jean*0130 CALL WRITE_GLVEC_RS( 'DRC',' ', drC,1+Nr,-1, myThid )
d0b8d6d9c3 Jean*0131 CALL WRITE_GLVEC_RS( 'DRF',' ', drF, Nr, -1, myThid )
f15994caab Jean*0132 IF ( selectSigmaCoord.NE.0 ) THEN
0133 CALL WRITE_GLVEC_RS( 'AHybSigF',' ',aHybSigmF,1+Nr,-1,myThid )
0134 CALL WRITE_GLVEC_RS( 'BHybSigF',' ',bHybSigmF,1+Nr,-1,myThid )
0135 CALL WRITE_GLVEC_RS( 'AHybSigC',' ',aHybSigmC, Nr, -1,myThid )
0136 CALL WRITE_GLVEC_RS( 'BHybSigC',' ',bHybSigmC, Nr, -1,myThid )
0137 CALL WRITE_GLVEC_RS('DAHybSigF',' ',dAHybSigF, Nr, -1,myThid )
0138 CALL WRITE_GLVEC_RS('DBHybSigF',' ',dBHybSigF, Nr, -1,myThid )
0139 CALL WRITE_GLVEC_RS('DAHybSigC',' ',dAHybSigC,1+Nr,-1,myThid )
0140 CALL WRITE_GLVEC_RS('DBHybSigC',' ',dBHybSigC,1+Nr,-1,myThid )
0141 ENDIF
a7e5607392 Jean*0142
0143 ENDIF
0144
0145
0146
0147
0148
7634fc94b4 Jean*0149 DO k=1,Nr+1
0150 tmpVar(k) = phiRef(2*k-1)
0151 ENDDO
d0b8d6d9c3 Jean*0152 CALL WRITE_GLVEC_RS( 'PHrefF',' ',tmpVar,1+Nr,-1, myThid )
7634fc94b4 Jean*0153 DO k=1,Nr
0154 tmpVar(k) = phiRef(2*k)
0155 ENDDO
d0b8d6d9c3 Jean*0156 CALL WRITE_GLVEC_RS( 'PHrefC',' ',tmpVar, Nr, -1, myThid )
a7e5607392 Jean*0157
f4a7634227 Alis*0158
115f70d8c8 Jean*0159
0160
f4a7634227 Alis*0161 #ifdef ALLOW_MNC
d306386a6d Jean*0162 IF ( useMNC .AND. writegrid_mnc ) THEN
fef0093425 Ed H*0163
0164 _BEGIN_MASTER( myThid )
bdad0a740f Ed H*0165 bfname='grid'
7634fc94b4 Jean*0166
a30418b6b9 Ed H*0167
0168 CALL MNC_CW_SET_UDIM(bfname, 0, myThid)
5bc9611487 Ed H*0169 CALL MNC_CW_SET_CITER(bfname, 2, -1, -1, -1, myThid)
c29c5d093c Ed H*0170 CALL MNC_CW_SET_UDIM(bfname, 1, myThid)
6679e38417 Mart*0171 CALL MNC_CW_RS_W('D',bfname,0,0,'RC',rC,myThid)
0172 CALL MNC_CW_RS_W('D',bfname,0,0,'RF',rF,myThid)
0173 CALL MNC_CW_RS_W('D',bfname,0,0,'RU',rF(2),myThid)
0174 CALL MNC_CW_RS_W('D',bfname,0,0,'RL',rF,myThid)
0175 CALL MNC_CW_RS_W('D',bfname,0,0,'drC',drC,myThid)
0176 CALL MNC_CW_RS_W('D',bfname,0,0,'drF',drF,myThid)
0177 CALL MNC_CW_RS_W('D',bfname,0,0,'XC',xC,myThid)
0178 CALL MNC_CW_RS_W('D',bfname,0,0,'YC',yC,myThid)
0179
0180
0181
0182
0183 CALL MNC_CW_RS_W('D',bfname,0,0,'XG',xG,myThid)
0184 CALL MNC_CW_RS_W('D',bfname,0,0,'YG',yG,myThid)
0185 CALL MNC_CW_RS_W('D',bfname,0,0,'dxC',dxC,myThid)
0186 CALL MNC_CW_RS_W('D',bfname,0,0,'dyC',dyC,myThid)
0187 CALL MNC_CW_RS_W('D',bfname,0,0,'dxF',dxF,myThid)
0188 CALL MNC_CW_RS_W('D',bfname,0,0,'dyF',dyF,myThid)
0189 CALL MNC_CW_RS_W('D',bfname,0,0,'dxG',dxG,myThid)
0190 CALL MNC_CW_RS_W('D',bfname,0,0,'dyG',dyG,myThid)
0191 CALL MNC_CW_RS_W('D',bfname,0,0,'dxV',dxV,myThid)
0192 CALL MNC_CW_RS_W('D',bfname,0,0,'dyU',dyU,myThid)
0193 CALL MNC_CW_RS_W('D',bfname,0,0,'rA',rA,myThid)
0194 CALL MNC_CW_RS_W('D',bfname,0,0,'rAw',rAw,myThid)
0195 CALL MNC_CW_RS_W('D',bfname,0,0,'rAs',rAs,myThid)
0196 CALL MNC_CW_RS_W('D',bfname,0,0,'rAz',rAz,myThid)
0197 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
0198 CALL MNC_CW_RS_W('D',bfname,0,0,'AngleCS',angleCosC,myThid)
0199 CALL MNC_CW_RS_W('D',bfname,0,0,'AngleSN',angleSinC,myThid)
0200 ENDIF
0201 CALL MNC_CW_RS_W('D',bfname,0,0,'fCori',fCori,myThid)
0202 CALL MNC_CW_RS_W('D',bfname,0,0,'fCoriG',fCoriG,myThid)
0203 CALL MNC_CW_RS_W('D',bfname,0,0,'R_low',R_low,myThid)
0204 CALL MNC_CW_RS_W('D',bfname,0,0,'Ro_surf',Ro_surf,myThid)
0205 CALL MNC_CW_RS_W('D',bfname,0,0,'Depth',tmpfld,myThid)
0206 CALL MNC_CW_RS_W('D',bfname,0,0,'HFacC',HFacC,myThid)
0207 CALL MNC_CW_RS_W('D',bfname,0,0,'HFacW',HFacW,myThid)
0208 CALL MNC_CW_RS_W('D',bfname,0,0,'HFacS',HFacS,myThid)
115f70d8c8 Jean*0209
fef0093425 Ed H*0210 _END_MASTER(myThid)
a30418b6b9 Ed H*0211
f4a7634227 Alis*0212 ENDIF
bceafc40c5 Mart*0213
0214 IF ( useMNC .AND. (usingCurvilinearGrid .OR. rotateGrid) ) THEN
0215
300ac09bf1 Jean*0216
0217 IF ( snapshot_mnc .AND.
4d90cde3c7 Mart*0218 & ( dumpFreq .GT. 0. .OR. dumpInitAndLast ) )
bceafc40c5 Mart*0219 & CALL MNC_CW_WRITE_GRID_COORD('state', myThid)
0220 #if (defined ALLOW_AUTODIFF) && \
0221 (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM)) && \
0222 (defined ALLOW_AUTODIFF_MONITOR)
4d90cde3c7 Mart*0223 IF ( autodiff_mnc .AND. adjDumpFreq .GT. 0. ) THEN
bceafc40c5 Mart*0224 CALL MNC_CW_WRITE_GRID_COORD('adstate', myThid)
0225 #ifdef ALLOW_EXF
0226 IF (useEXF) CALL MNC_CW_WRITE_GRID_COORD('adexf',myThid)
0227 #endif /* ALLOW_EXF */
300ac09bf1 Jean*0228 #ifdef ALLOW_SEAICE
bceafc40c5 Mart*0229 IF (useSEAICE) CALL MNC_CW_WRITE_GRID_COORD('adseaice',myThid)
0230 #endif /* ALLOW_SEAICE */
0231 ENDIF
0232 #endif /* ALLOW_AUTODIFF */
0233 ENDIF
0234
f4a7634227 Alis*0235 #endif /* ALLOW_MNC */
0236
0237 RETURN
0238 END