pkg/gridalt/gridalt_update.F

cc36b35673 Jean*0001 #include "GRIDALT_OPTIONS.h"
                0002
8aa94f3b31 Andr*0003        subroutine gridalt_update(myThid)
                0004 c***********************************************************************
                0005 c subroutine gridalt_update
cc36b35673 Jean*0006 c
                0007 c Purpose: Update the pressure thicknesses of the layers of the
8aa94f3b31 Andr*0008 c          alternative vertical grid (used now for atmospheric physics).
                0009 c
                0010 c Calculate: dpphys    - new delta r (p*) edge-to-edge of physics grid
                0011 c                        using dpphys0 (initial value) and rstarfacC
                0012 c
                0013 c***********************************************************************
                0014        implicit none
cc36b35673 Jean*0015
8aa94f3b31 Andr*0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
c18865c80b Andr*0018 #include "PARAMS.h"
8aa94f3b31 Andr*0019 #include "GRID.h"
                0020 #include "fizhi_SIZE.h"
                0021 #include "gridalt_mapping.h"
                0022 #include "SURFACE.h"
                0023
                0024        integer myThid
                0025
                0026        integer im1,im2,jm1,jm2
                0027        integer i1,i2,j1,j2,bi,bj
                0028        integer i,j,L
f13426fb9c Andr*0029        logical  diagnostics_is_on
                0030        external diagnostics_is_on
f330f595f9 Andr*0031        _RL temparr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys,nSx,nSy)
8aa94f3b31 Andr*0032
                0033        im1 = 1-OLx
                0034        im2 = sNx+OLx
                0035        jm1 = 1-OLy
                0036        jm2 = sNy+OLy
                0037        i1 = 1
                0038        i2 = sNx
                0039        j1 = 1
                0040        j2 = sNy
62fb009c0d Andr*0041
                0042 #ifdef ALLOW_FIZHI
5b98764936 Andr*0043 #ifdef NONLIN_FRSURF
                0044
                0045        if(usefizhi .and. (select_rStar.GT.0) )then
62fb009c0d Andr*0046         do bj = myByLo(myThid), myByHi(myThid)
                0047         do bi = myBxLo(myThid), myBxHi(myThid)
8aa94f3b31 Andr*0048 c
62fb009c0d Andr*0049          do L = 1,Nrphys
                0050           do j = j1,j2
                0051           do i = i1,i2
                0052            dpphys(i,j,L,bi,bj) = dpphys0(i,j,L,bi,bj) *
be5ec7d59d Andr*0053      .                     rstarfacC(i,j,bi,bj)
62fb009c0d Andr*0054           enddo
                0055           enddo
8aa94f3b31 Andr*0056          enddo
                0057 c
62fb009c0d Andr*0058         enddo
                0059         enddo
705a6a8f3c Andr*0060
62fb009c0d Andr*0061        endif
                0062
                0063 #endif
f13426fb9c Andr*0064
                0065 #ifdef ALLOW_DIAGNOSTICS
                0066        if(useDiagnostics) then
723964922e Andr*0067        IF ( DIAGNOSTICS_IS_ON('DPPHYS  ',myThid) ) THEN
                0068         do bj = myByLo(myThid), myByHi(myThid)
                0069         do bi = myBxLo(myThid), myBxHi(myThid)
                0070          do L = 1,Nrphys
                0071           do j = j1,j2
                0072           do i = i1,i2
705a6a8f3c Andr*0073            temparr(i,j,L,bi,bj) = dpphys(i,j,L,bi,bj) * 1. _d -2
723964922e Andr*0074           enddo
f330f595f9 Andr*0075           enddo
                0076          enddo
723964922e Andr*0077         enddo
                0078         enddo
                0079         CALL DIAGNOSTICS_FILL(temparr,'DPPHYS  ',-1,Nrphys,0,1,1,myThid)
                0080        ENDIF
f13426fb9c Andr*0081        endif
5b98764936 Andr*0082 #endif
8aa94f3b31 Andr*0083
f13426fb9c Andr*0084 #endif
8aa94f3b31 Andr*0085        return
                0086        end