model/src/write_grid.F

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 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP
                0010 C     !ROUTINE: WRITE_GRID
                0011 C     !INTERFACE:
                0012       SUBROUTINE WRITE_GRID(
7634fc94b4 Jean*0013      I                 myThid )
f4a7634227 Alis*0014
a30418b6b9 Ed H*0015 C     !DESCRIPTION:
                0016 C     Writes the model geometry and grid arrays to file(s) using which
                0017 C     ever I/O package is available/active.  This includes horizontal
                0018 C     and vertical grid and finite volume modulating factors (hFacs).
                0019 C     Essentailly, it dumps the contents of GRID.h to disk.
f4a7634227 Alis*0020
                0021 C     !CALLING SEQUENCE:
                0022 C     INITIALIZE_FIXED
                0023 C       |
                0024 C       |-- WRITE_GRID
                0025
d0b8d6d9c3 Jean*0026 C     !USES:
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 C     !INPUT/OUTPUT PARAMETERS:
                0038 C     myThid -  Number of this instances
                0039       INTEGER myThid
                0040
                0041 C     !LOCAL VARIABLES:
115f70d8c8 Jean*0042 C     tmpfld :: Temporary array used to compute & write Total Depth ;
                0043 C               loaded in multi-threaded way but written by single (master)
                0044 C               thread => needs to be in common to be shared by all threads
7e2457fc25 Jean*0045 C     no longer needed since MDSIO now allows (2009/06/07) to write local arrays
                0046 c     COMMON / LOCAL_WRITE_GRID / tmpfld
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 CEOP
                0055
a30418b6b9 Ed H*0056 C     Calculate the fluid thickness in R coordinates as seen by the
                0057 C     model.  This may differ from what the user specified due to
                0058 C     partial cells, etc.
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 C     Total fluid column thickness (r_unit) :
                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 c     _BARRIER
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 C     Write horizontal grid arrays
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 C     Write 3D geometry arrays
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 c         CALL WRITE_FULLARRAY_RS('maskInC',maskInC,1,0,0,1,-1,myThid)
                0123 c         CALL WRITE_FULLARRAY_RS('maskInW',maskInW,1,0,0,1,-1,myThid)
                0124 c         CALL WRITE_FULLARRAY_RS('maskInS',maskInS,1,0,0,1,-1,myThid)
300ac09bf1 Jean*0125         ENDIF
8f24437970 Jean*0126
                0127 C     Write vertical grid arrays
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 C--  Comment out the "if": also useful for the Ocean (to get the full
                0146 C    Pressure) and write also these MDS file when writegrid_mdsio=F
                0147 C    (since missing from MNC grid-file)
                0148 c      IF (buoyancyRelation .EQ. 'ATMOSPHERIC') THEN
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 c      ENDIF
f4a7634227 Alis*0158
115f70d8c8 Jean*0159 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                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 C       Write the GRID.h variables to a file
                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 c       CALL MNC_CW_RS_W('D',bfname,0,0,'XU',xG,myThid)
                0180 c       CALL MNC_CW_RS_W('D',bfname,0,0,'YU',yC,myThid)
                0181 c       CALL MNC_CW_RS_W('D',bfname,0,0,'XV',xC,myThid)
                0182 c       CALL MNC_CW_RS_W('D',bfname,0,0,'YV',yG,myThid)
                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 C     If the grid is not simply cartesian, cylindrical or spherical,
300ac09bf1 Jean*0216 C     include additional coordinate information to the following files
                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