** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Mon, 1 Mar 2026 06:09:13 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/model/src/ini_nh_fields.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:36:51 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
5700f22e40 Jean*0001 #include "CPP_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: INI_NH_FIELDS
                0005 C     !INTERFACE:
                0006       SUBROUTINE INI_NH_FIELDS( myThid )
                0007 
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE INI_NH_FIELDS
                0011 C     | o Set model initial non-hydrostatic fields.
                0012 C     *==========================================================*
                0013 C     | Note: If using NH form,
                0014 C     |  call this S/R whether starting or restarting simulation.
                0015 C     | This is different from other "true" ini_fields type S/R
                0016 C     |  (e.g., INI_VEL) which are called only when starting.
                0017 C     | Reason: no real physical field to initialise (since wVel
                0018 C     |  is diagnose from continuity) but needs to set few arrays
                0019 C     *==========================================================*
                0020 C     \ev
                0021 
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 C     === Global variables ===
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "GRID.h"
                0029 #include "RESTART.h"
                0030 #include "NH_VARS.h"
                0031 
                0032 C     !INPUT/OUTPUT PARAMETERS:
                0033 C     == Routine arguments ==
                0034 C     myThid  :: My Thread Id number
                0035       INTEGER myThid
                0036 
                0037 #ifdef ALLOW_NONHYDROSTATIC
                0038 C     !LOCAL VARIABLES:
                0039 C     == Local variables ==
                0040       INTEGER bi,bj
c3c6ac25ae Jean*0041       INTEGER i,j
5700f22e40 Jean*0042       INTEGER ks
6583ada144 Jean*0043       CHARACTER*(MAX_LEN_MBUF) msgBuf
c3c6ac25ae Jean*0044 #ifdef NONLIN_FRSURF
                0045       INTEGER k
                0046 #endif
5700f22e40 Jean*0047 CEOP
                0048 
                0049       IF ( startTime .EQ. baseTime .AND.  nIter0 .EQ. 0
                0050      &     .AND. pickupSuff .EQ. ' ' ) THEN
                0051 C--   Case where starting from initial conditions
                0052 
                0053 C--   Read an initial non-hydrostatic pressure field
                0054 c       IF (phiNHinitFile .NE. ' ') THEN
                0055 c        CALL READ_FLD_XYZ_RL( phiNHinitFile, ' ', phi_nh, 0, myThid )
                0056 c        _EXCH_XYZ_RL(phi_nh, myThid)
                0057 c       ENDIF
                0058 
                0059       ELSE
                0060 C--   Case where restarting from a pickup
                0061 
2c18da0d62 Jean*0062        _BEGIN_MASTER(myThid)
6583ada144 Jean*0063        WRITE(msgBuf,'(A,I4)')
                0064      &   'INI_NH_FIELDS: dPhiNHstatus=', dPhiNHstatus
                0065        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0066      &                     SQUEEZE_RIGHT, myThid )
2c18da0d62 Jean*0067        _END_MASTER(myThid)
5700f22e40 Jean*0068        IF ( exactConserv .AND. dPhiNHstatus.EQ.0 ) THEN
                0069 c      IF ( exactConserv ) THEN
                0070 C--   Separate the Hydrostatic Surface Pressure adjusment (=> put it in dPhiNH)
                0071 C     from the Non-hydrostatic pressure (since cg3d_x contains both contribution)
                0072         DO bj=myByLo(myThid),myByHi(myThid)
                0073          DO bi=myBxLo(myThid),myBxHi(myThid)
e78345ed77 Jean*0074           IF ( select_rStar.EQ.0 .AND. uniformFreeSurfLev ) THEN
5700f22e40 Jean*0075 C-       Z coordinate: assume surface @ level k=1
                0076            DO j=1-OLy,sNy+OLy
                0077             DO i=1-OLx,sNx+OLx
                0078               dPhiNH(i,j,bi,bj) = phi_nh(i,j,1,bi,bj)
                0079 c             dPhiNH(i,j,bi,bj) = 0.
                0080             ENDDO
                0081            ENDDO
                0082           ELSEIF ( select_rStar.EQ.0 ) THEN
                0083 C-       Other than Z coordinate: no assumption on surface level index
                0084            DO j=1-OLy,sNy+OLy
                0085             DO i=1-OLx,sNx+OLx
2c18da0d62 Jean*0086              ks = kSurfC(i,j,bi,bj)
5700f22e40 Jean*0087              IF ( ks.LE.Nr ) THEN
                0088               dPhiNH(i,j,bi,bj) = phi_nh(i,j,ks,bi,bj)
                0089              ELSE
                0090               dPhiNH(i,j,bi,bj) = 0.
                0091              ENDIF
                0092             ENDDO
                0093            ENDDO
                0094 #ifdef NONLIN_FRSURF
                0095           ELSE
                0096 C        rStar : take vertical average of P_NH as Hyd.Surf.Press adjustment
                0097            DO j=1-OLy,sNy+OLy
                0098             DO i=1-OLx,sNx+OLx
                0099               dPhiNH(i,j,bi,bj) = 0.
                0100             ENDDO
                0101            ENDDO
                0102            DO k=1,Nr
                0103             DO j=1-OLy,sNy+OLy
                0104              DO i=1-OLx,sNx+OLx
                0105               dPhiNH(i,j,bi,bj) = dPhiNH(i,j,bi,bj)
                0106      &          + phi_nh(i,j,k,bi,bj)*drF(k)*hFacC(i,j,k,bi,bj)
                0107              ENDDO
                0108             ENDDO
                0109            ENDDO
                0110            DO j=1-OLy,sNy+OLy
                0111             DO i=1-OLx,sNx+OLx
                0112               dPhiNH(i,j,bi,bj) = dPhiNH(i,j,bi,bj)
                0113      &                           *recip_Rcol(i,j,bi,bj)
                0114             ENDDO
                0115            ENDDO
                0116 #endif /* NONLIN_FRSURF */
                0117           ENDIF
                0118          ENDDO
                0119         ENDDO
                0120 C-     end of if-block: dPhiNH_status
                0121        ENDIF
                0122 
                0123       ENDIF
                0124 
                0125 #endif /* ALLOW_NONHYDROSTATIC */
                0126       RETURN
                0127       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!