! $Id: transfer_mod.f,v 1.1 2009/06/09 21:51:51 daven Exp $ MODULE TRANSFER_MOD ! !****************************************************************************** ! Module TRANSFER_MOD contains routines used to copy data from REAL*4 to ! REAL*8 arrays after being read from disk. Also, vertical levels will be ! collapsed in the stratosphere if necessary. This will help us to gain ! computational advantage. (mje, bmy, 9/27/01, 10/3/07) ! ! NOTE: The level above which we start collapsing layers is ~78 hPa. ! ! Module Variables: ! ============================================================================ ! (1 ) EDGE_IN : Input sigma edges (for pure sigma models) ! (2 ) I0 : Global longitude offset (%%% NOTE: usually=0 %%%) ! (3 ) J0 : Global latitude offset (%%% NOTE: usually=0 %%%) ! (4 ) L_COPY : # of levels to copy (before stratosphere lumping) ! ! Module Routines: ! ============================================================================ ! (1 ) TRANSFER_A6 : Transfers GEOS A-6 fields, regrids if necessary ! (2 ) TRANSFER_3D : Transfers GEOS 3-D fields, regrids if necessary ! (3 ) TRANSFER_3D_TROP : Transfers GEOS 3-D fields up to tropopause level ! (4 ) TRANSFER_G5_PLE : Transfers GEOS-5 3-D pressure edges, regrids ! (5 ) TRANSFER_3D_Lp1 : Transfers GEOS-5 3-D fields defined on level edges ! (6 ) TRANSFER_ZONAL_R4 : Transfers GEOS zonal fields, regrids (REAL*4) ! (7 ) TRANSFER_ZONAL_R8 : Transfers GEOS zonal fields, regrids (REAL*8) ! (8 ) TRANSFER_ZONAL : Transfers GEOS zonal fields, regrids if necessary ! (9 ) TRANSFER_2D_INT : Transfers GEOS 2-D fields (INTEGER argument) ! (10) TRANSFER_2D_R4 : Transfers GEOS 2-D fields (REAL*4 argument) ! (11) TRANSFER_2D_R8 : Transfers GEOS 2-D fields (REAL*8 argument) ! (12) TRANSFER_TO_1D : Transfers GEOS 2-D fields to a 1-D array ! (13) LUMP_2_R4 : Combines 2 levels into 1 thick level (REAL*4) ! (14) LUMP_2_R8 : Combines 2 levels into 1 thick level (REAL*8) ! (15) LUMP_4_R4 : Combines 4 levels into 1 thick level (REAL*4) ! (16) LUMP_4_R8 : Combines 4 levels into 1 thick level (REAL*8) ! (17) INIT_TRANSFER : Allocates and initializes the EDGE_IN array ! (18) CLEANUP_TRANSFER : Deallocates the EDGE_IN array ! ! Module Interfaces: ! ============================================================================ ! (1 ) LUMP_2 : Overloads LUMP_2_* module routines ! (2 ) LUMP_4 : Overloads LUMP_4_* module routines ! (3 ) TRANSFER_2D : Overloads TRANSFER_2D_* module routines ! (4 ) TRANSFER_ZONAL : Overloads TRANSFER_ZONAL_* module routines ! ! GEOS-Chem modules referenced by "transfer_mod.f" ! ============================================================================ ! (1 ) error_mod.f : Module w/ NaN and other error check routines ! ! NOTES: ! (1 ) GEOS-3 Output levels were determined by Mat Evans. Groups of 2 levels ! and groups of 4 levels on the original grid are merged together into ! thick levels for the output grid. (mje, bmy, 9/26/01) ! (2 ) Assumes that LLPAR == LGLOB for GEOS-1, GEOS-STRAT (bmy, 9/26/01) ! (3 ) EDGE_IN needs to be provided for each model type, within an #ifdef ! block, in order to ensure compilation. However, EDGE_IN is currently ! only used for regridding GEOS-3 data (and probably also GEOS-4 when ! that becomes available). (bmy, 9/26/01) ! (4 ) Add interfaces TRANSFER_2D and TRANSFER_ZONAL (bmy, 9/27/01) ! (5 ) Added routine TRANSFER_2D_R4. Added TRANSFER_2D_R4 to the generic ! TRANSFER_2D interface. (bmy, 1/25/02) ! (6 ) Updated comments, cosmetic changes (bmy, 2/28/02) ! (7 ) Bug fix: remove extraneous "," in GEOS-1 definition of EDGE_IN array. ! (bmy, 3/25/02) ! (8 ) Now divide module header into MODULE PRIVATE, MODULE VARIABLES, and ! MODULE ROUTINES sections. Also add MODULE INTERFACES section, ! since we have an interface here. (bmy, 5/28/02) ! (9 ) Now references "pressure_mod.f" (dsa, bdf, bmy, 8/22/02) ! (10) Bug fix in "init_transfer", declare variable L. Also reference ! GEOS_CHEM_STOP from "error_mod.f" for safe stop (bmy, 10/15/02) ! (11) Added routine TRANSFER_3D_TROP. Also updated comments. (bmy, 10/31/02) ! (12) Now uses functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f". ! (bmy, 3/11/03) ! (13) Added code to regrid GEOS-4 from 55 --> 30 levels. Renamed module ! variable SIGE_IN to EDGE_IN. (mje, bmy, 10/31/03) ! (14) Now modified for GEOS-5 and GCAP met fields (swu, bmy, 5/24/05) ! (15) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) ! (16) Modified for GEOS-5. Rewritten for clarity. (bmy, 10/30/07) !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE PRIVATE DECLARATIONS -- keep certain internal variables ! and routines from being seen outside "transfer_mod.f" !================================================================= ! Make everything PRIVATE ... PRIVATE ! ... except these routines PUBLIC :: TRANSFER_A6 PUBLIC :: TRANSFER_2D PUBLIC :: TRANSFER_3D PUBLIC :: TRANSFER_3D_Lp1 PUBLIC :: TRANSFER_3D_TROP PUBLIC :: TRANSFER_G5_PLE PUBLIC :: TRANSFER_ZONAL PUBLIC :: TRANSFER_TO_1D PUBLIC :: INIT_TRANSFER PUBLIC :: CLEANUP_TRANSFER !================================================================= ! MODULE VARIABLES !================================================================= ! Scalars INTEGER :: I0 INTEGER :: J0 INTEGER :: L_COPY ! Arrays REAL*8, ALLOCATABLE :: EDGE_IN(:) !================================================================= ! MODULE INTERFACES -- "bind" two or more routines with different ! argument types or # of arguments under one unique name !================================================================= ! Interface for routines to lump 2 levels together INTERFACE LUMP_2 MODULE PROCEDURE LUMP_2_R4 MODULE PROCEDURE LUMP_2_R8 END INTERFACE ! Interface for routines to lump 4 levels together INTERFACE LUMP_4 MODULE PROCEDURE LUMP_4_R4 MODULE PROCEDURE LUMP_4_R8 END INTERFACE ! Interface for routines which copy 2-D data INTERFACE TRANSFER_2D MODULE PROCEDURE TRANSFER_2D_INT MODULE PROCEDURE TRANSFER_2D_R4 MODULE PROCEDURE TRANSFER_2D_R8 END INTERFACE ! Interface for routines which copy zonal data INTERFACE TRANSFER_ZONAL MODULE PROCEDURE TRANSFER_ZONAL_R4 MODULE PROCEDURE TRANSFER_ZONAL_R8 END INTERFACE !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_A6( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_A6 transfers A-6 data from a REAL*4 array to a REAL*8 ! array. Vertical layers are collapsed (from LGLOB to LLPAR) if necessary. ! (mje, bmy, 9/21/01, 11/6/08) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, dimensioned (IGLOB,JGLOB,LGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*4) : Output field, dimensioned (LLPAR,IIPAR,JJPAR) ! ! NOTES: ! (1 ) A-6 fields are dimensioned (LLPAR,IIPAR,JJPAR) since for Fortran ! efficiency, since the code loops over vertical layers L in a column ! located above a certain surface location (I,J). (bmy, 9/21/01) ! (2 ) Assumes that LLPAR == LGLOB for GEOS-1, GEOS-STRAT (bmy, 9/21/01) ! (3 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f". ! Now I0, J0 are local variables. (bmy, 3/11/03) ! (4 ) Added code to regrid GEOS-4 from 55 --> 30 levels (mje, bmy, 10/31/03) ! (5 ) Now modified for GEOS-5 met fields (bmy, 5/24/05) ! (6 ) Rewritten for clarity (bmy, 2/8/07) ! (7 ) Now get nested-grid offsets (dan, bmy, 11/6/08) !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB,LGLOB) REAL*8, INTENT(OUT) :: OUT(LLPAR,IIPAR,JJPAR) ! Local variables INTEGER :: I, J, L REAL*4 :: INCOL(LGLOB) !================================================================ ! TRANSFER_A6 begins here! !================================================================ ! Copy the first L_COPY levels !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO J = 1, JJPAR DO I = 1, IIPAR DO L = 1, L_COPY OUT(L,I,J) = IN(I+I0,J+J0,L) ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! Exit if we are running at full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================= ! Collapse levels in the stratosphere !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, INCOL ) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR DO I = 1, IIPAR ! Store vertical column at (IREF,JREF) in a 1-D vector INCOL = IN( I+I0, J+J0, 1:LGLOB ) #if defined( GEOS_3 ) !-------------------------------------------------------------- ! GEOS-3: Lump 48 levels into 30 levels, starting above L=22. ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time, starting at L=23 OUT(23,I,J) = LUMP_2( INCOL, LGLOB, 23 ) OUT(24,I,J) = LUMP_2( INCOL, LGLOB, 25 ) OUT(25,I,J) = LUMP_2( INCOL, LGLOB, 27 ) ! Lump 4 levels together at a time, starting at L=29 OUT(26,I,J) = LUMP_4( INCOL, LGLOB, 29 ) OUT(27,I,J) = LUMP_4( INCOL, LGLOB, 33 ) OUT(28,I,J) = LUMP_4( INCOL, LGLOB, 37 ) OUT(29,I,J) = LUMP_4( INCOL, LGLOB, 41 ) OUT(30,I,J) = LUMP_4( INCOL, LGLOB, 45 ) #elif defined( GEOS_4 ) !-------------------------------------------------------------- ! GEOS-4: Lump 55 levels into 30 levels, starting above L=20 ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(20,I,J) = LUMP_2( INCOL, LGLOB, 20 ) OUT(21,I,J) = LUMP_2( INCOL, LGLOB, 22 ) OUT(22,I,J) = LUMP_2( INCOL, LGLOB, 24 ) OUT(23,I,J) = LUMP_2( INCOL, LGLOB, 26 ) ! Lump 4 levels together at a time OUT(24,I,J) = LUMP_4( INCOL, LGLOB, 28 ) OUT(25,I,J) = LUMP_4( INCOL, LGLOB, 32 ) OUT(26,I,J) = LUMP_4( INCOL, LGLOB, 36 ) OUT(27,I,J) = LUMP_4( INCOL, LGLOB, 40 ) OUT(28,I,J) = LUMP_4( INCOL, LGLOB, 44 ) OUT(29,I,J) = LUMP_4( INCOL, LGLOB, 48 ) OUT(30,I,J) = LUMP_4( INCOL, LGLOB, 52 ) #elif defined( GEOS_5 ) || defined( GEOS_FP ) !-------------------------------------------------------------- ! GEOS-5: Lump 72 levels into 47 levels, starting above L=36 ! Lump levels in groups of 2, then 4. (cf. Bob Yantosca) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(37,I,J) = LUMP_2( INCOL, LGLOB, 37 ) OUT(38,I,J) = LUMP_2( INCOL, LGLOB, 39 ) OUT(39,I,J) = LUMP_2( INCOL, LGLOB, 41 ) OUT(40,I,J) = LUMP_2( INCOL, LGLOB, 43 ) ! Lump 4 levels together at a time OUT(41,I,J) = LUMP_4( INCOL, LGLOB, 45 ) OUT(42,I,J) = LUMP_4( INCOL, LGLOB, 49 ) OUT(43,I,J) = LUMP_4( INCOL, LGLOB, 53 ) OUT(44,I,J) = LUMP_4( INCOL, LGLOB, 57 ) OUT(45,I,J) = LUMP_4( INCOL, LGLOB, 61 ) OUT(46,I,J) = LUMP_4( INCOL, LGLOB, 65 ) OUT(47,I,J) = LUMP_4( INCOL, LGLOB, 69 ) #endif ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE TRANSFER_A6 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_3D( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_3D transfers A-6 data from a REAL*4 array to a REAL*8 ! array. Vertical layers are collapsed (from LGLOB to LLPAR) if necessary. ! (mje, bmy, 9/21/01, 2/8/07) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB,LGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (IIPAR,JJPAR,LLPAR) ! ! NOTES: ! (1 ) Lump levels together in groups of 2 or 4, as dictated by Mat Evans. ! (bmy, 9/21/01) ! (2 ) Assumes that LLPAR == LGLOB for GEOS-1, GEOS-STRAT (bmy, 9/21/01) ! (3 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f". ! Now I0, J0 are local variables. (bmy, 3/11/03) ! (4 ) Added code to regrid GEOS-4 from 55 --> 30 levels (mje, bmy, 10/31/03) ! (5 ) Now modified for GEOS-5 met fields (bmy, 5/24/05) ! (6 ) Rewritten for clarity (bmy, 2/8/07) !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(IIPAR,JJPAR,LGLOB) REAL*8, INTENT(OUT) :: OUT(IIPAR,JJPAR,LLPAR) ! Local variables INTEGER :: I, J REAL*4 :: INCOL(LGLOB) !================================================================ ! TRANSFER_3D begins here! !================================================================ ! Copy the first L_COPY levels OUT(:,:,1:L_COPY) = IN( 1+I0:IIPAR+I0, 1+J0:JJPAR+J0, 1:L_COPY ) ! Exit if we are running at full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================ ! Collapse levels in the stratosphere !================================================================ !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, INCOL ) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR DO I = 1, IIPAR ! Copy a vertical column into INCOL INCOL = IN( I+I0, J+J0, 1:LGLOB ) #if defined( GEOS_3 ) !-------------------------------------------------------------- ! GEOS-3: Lump 48 levels into 30 levels, starting above L=22. ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time, starting at L=23 OUT(I,J,23) = LUMP_2( INCOL, LGLOB, 23 ) OUT(I,J,24) = LUMP_2( INCOL, LGLOB, 25 ) OUT(I,J,25) = LUMP_2( INCOL, LGLOB, 27 ) ! Lump 4 levels together at a time, starting at L=29 OUT(I,J,26) = LUMP_4( INCOL, LGLOB, 29 ) OUT(I,J,27) = LUMP_4( INCOL, LGLOB, 33 ) OUT(I,J,28) = LUMP_4( INCOL, LGLOB, 37 ) OUT(I,J,29) = LUMP_4( INCOL, LGLOB, 41 ) OUT(I,J,30) = LUMP_4( INCOL, LGLOB, 45 ) #elif defined( GEOS_4 ) !-------------------------------------------------------------- ! GEOS-4: Lump 55 levels into 30 levels, starting above L=20 ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time, starting at L=20 OUT(I,J,20) = LUMP_2( INCOL, LGLOB, 20 ) OUT(I,J,21) = LUMP_2( INCOL, LGLOB, 22 ) OUT(I,J,22) = LUMP_2( INCOL, LGLOB, 24 ) OUT(I,J,23) = LUMP_2( INCOL, LGLOB, 26 ) ! Lump 4 levels together at a time, starting at L=28 OUT(I,J,24) = LUMP_4( INCOL, LGLOB, 28 ) OUT(I,J,25) = LUMP_4( INCOL, LGLOB, 32 ) OUT(I,J,26) = LUMP_4( INCOL, LGLOB, 36 ) OUT(I,J,27) = LUMP_4( INCOL, LGLOB, 40 ) OUT(I,J,28) = LUMP_4( INCOL, LGLOB, 44 ) OUT(I,J,29) = LUMP_4( INCOL, LGLOB, 48 ) OUT(I,J,30) = LUMP_4( INCOL, LGLOB, 52 ) #elif defined( GEOS_5 ) || defined( GEOS_FP ) !-------------------------------------------------------------- ! GEOS-5: Lump 72 levels into 47 levels, starting above L=36 ! Lump levels in groups of 2, then 4. (cf. Bob Yantosca) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(I,J,37) = LUMP_2( INCOL, LGLOB, 37 ) OUT(I,J,38) = LUMP_2( INCOL, LGLOB, 39 ) OUT(I,J,39) = LUMP_2( INCOL, LGLOB, 41 ) OUT(I,J,40) = LUMP_2( INCOL, LGLOB, 43 ) ! Lump 4 levels together at a time OUT(I,J,41) = LUMP_4( INCOL, LGLOB, 45 ) OUT(I,J,42) = LUMP_4( INCOL, LGLOB, 49 ) OUT(I,J,43) = LUMP_4( INCOL, LGLOB, 53 ) OUT(I,J,44) = LUMP_4( INCOL, LGLOB, 57 ) OUT(I,J,45) = LUMP_4( INCOL, LGLOB, 61 ) OUT(I,J,46) = LUMP_4( INCOL, LGLOB, 65 ) OUT(I,J,47) = LUMP_4( INCOL, LGLOB, 69 ) #endif ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE TRANSFER_3D !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_G5_PLE( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_G5_PLE transfers GEOS-5 pressure edge data from the ! native 72-level grid to the reduced 47-level grid. (bmy, 2/8/07) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB,LGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (IIPAR,JJPAR,LLPAR) ! ! NOTES: !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(IIPAR,JJPAR,LGLOB+1) REAL*8, INTENT(OUT) :: OUT(IIPAR,JJPAR,LLPAR+1) ! Local variables INTEGER :: I, J !================================================================ ! TRANSFER_PLE begins here! !================================================================ ! Copy the first L_COPY+1 edges (which define L_COPY levels) OUT(:,:,1:L_COPY+1) = IN( 1+I0:IIPAR+I0,1+J0:JJPAR+J0,1:L_COPY+1 ) ! Exit if we are running at full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================ ! Return GEOS-5 pressure edges for reduced grid !================================================================ #if defined( GEOS_5 ) || defined( GEOS_FP ) !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR DO I = 1, IIPAR ! Top edges of levels lumped by 2's OUT(I,J,38) = IN(I+I0,J+J0,39) OUT(I,J,39) = IN(I+I0,J+J0,41) OUT(I,J,40) = IN(I+I0,J+J0,43) OUT(I,J,41) = IN(I+I0,J+J0,45) ! Top edges of levels lumped by 4's OUT(I,J,42) = IN(I+I0,J+J0,49) OUT(I,J,43) = IN(I+I0,J+J0,53) OUT(I,J,44) = IN(I+I0,J+J0,57) OUT(I,J,45) = IN(I+I0,J+J0,61) OUT(I,J,46) = IN(I+I0,J+J0,65) OUT(I,J,47) = IN(I+I0,J+J0,69) OUT(I,J,48) = IN(I+I0,J+J0,73) ENDDO ENDDO !$OMP END PARALLEL DO #endif ! Return to calling program END SUBROUTINE TRANSFER_G5_PLE !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_3D_Lp1( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_3D_Lp1 transfers 3-D data from a REAL*4 array of ! dimension (IGLOB,JGLOB,LGLOB+1) to a REAL*8 array of dimension ! (IIPAR,JJPAR,LLPAR+1). Regrid in the vertical if needed. ! (bmy, 9/21/01, 2/8/07) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB,LGLOB+1) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (IIPAR,JJPAR,LLPAR+1) ! ! NOTES: !****************************************************************************** ! # include "CMN_SIZE" ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB,LGLOB+1) REAL*8, INTENT(OUT) :: OUT(IIPAR,JJPAR,LLPAR+1) ! Local variables LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: I, J REAL*4 :: INCOL(LGLOB) !================================================================= ! TRANSFER_3D_Lp1 begins here! !================================================================= ! Copy the first L_COPY+1 levels OUT(:,:,1:L_COPY+1) = IN( 1+I0:IIPAR+I0, 1+J0:JJPAR+J0,1:L_COPY+1) ! Exit if we are running full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================= ! Collapse levels in the stratosphere ! ! %%% TEMPORARY KLUDGE!!!! ! %%% NOTE: For now do the same thing as in TRANSFER_G5_PLE, i.e. ! %%% return the values at the edges. The only other field than ! %%% PLE defined on the edges is CMFMC and that is always zero ! %%% above about 120 hPa. (bmy, 2/8/07) !================================================================= #if defined( GEOS_5 ) || defined( GEOS_FP ) !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J ) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR DO I = 1, IIPAR ! Top edges of levels lumped by 2's OUT(I,J,38) = IN(I+I0,J+J0,39) OUT(I,J,39) = IN(I+I0,J+J0,41) OUT(I,J,40) = IN(I+I0,J+J0,43) OUT(I,J,41) = IN(I+I0,J+J0,45) ! Top edges of levels lumped by 4's OUT(I,J,42) = IN(I+I0,J+J0,49) OUT(I,J,43) = IN(I+I0,J+J0,53) OUT(I,J,44) = IN(I+I0,J+J0,57) OUT(I,J,45) = IN(I+I0,J+J0,61) OUT(I,J,46) = IN(I+I0,J+J0,65) OUT(I,J,47) = IN(I+I0,J+J0,69) OUT(I,J,48) = IN(I+I0,J+J0,73) ENDDO ENDDO !$OMP END PARALLEL DO #endif ! Return to calling program END SUBROUTINE TRANSFER_3D_Lp1 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_3D_TROP( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_3D_TROP transfers tropospheric 3-D data from a REAL*4 ! array to a REAL*8 array. (mje, bmy, 9/21/01, 2/8/07) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB,LLTROP) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (IIPAR,LLPAR,LLTROP) ! ! NOTES: ! (1 ) Now use LLTROP_FIX instead of LLTROP, since most of the offline ! simulations use the annual mean tropopause (bmy, 2/8/07) !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB,LLTROP_FIX) REAL*8, INTENT(OUT) :: OUT(IIPAR,JJPAR,LLTROP_FIX) ! Local variables INTEGER :: L !================================================================= ! TRANSFER_3D_TROP !================================================================= ! Cast to REAL*8 abd resize up to LLTROP DO L = 1, LLTROP_FIX CALL TRANSFER_2D( IN(:,:,L), OUT(:,:,L) ) ENDDO ! Return to calling program END SUBROUTINE TRANSFER_3D_TROP !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_ZONAL_R4( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_ZOJAL_R4 transfers zonal-mean data from a REAL*4 array ! to a REAL*8 array. Vertical levels are collapsed (from LGLOB to LLPAR) if ! necessary. (mje, bmy, 9/21/01, 2/8/07) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (JGLOB,LGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (JJPAR,LLPAR) ! ! NOTES: ! (1 ) Lump levels together in groups of 2 or 4, as dictated by Mat Evans. ! (bmy, 9/21/01) ! (2 ) Assumes that LLPAR == LGLOB for GEOS-1, GEOS-STRAT (bmy, 9/21/01) ! (3 ) Now use function GET_YOFFSET from "grid_mod.f". Now I0 and J0 are ! local variables (bmy, 3/11/03) ! (4 ) Added code to regrid GEOS-4 from 55 --> 30 levels (mje, bmy, 10/31/03) ! (5 ) Rewritten for clarity (bmy, 2/8/07) !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(JGLOB,LGLOB) REAL*4, INTENT(OUT) :: OUT(JJPAR,LLPAR) ! Local variables INTEGER :: J REAL*4 :: INCOL(LGLOB) !================================================================ ! TRANSFER_ZONAL_R4 begins here! !================================================================ ! Copy the first L_COPY levels OUT(:,1:L_COPY) = IN( 1+J0:JJPAR+J0, 1:L_COPY ) ! Exit if we are running at full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================ ! Collapse levels in the stratosphere !================================================================ !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( J, INCOL ) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR ! Store vertical column at (I,J) in a 1-D vector INCOL = IN( J+J0, 1:LGLOB ) #if defined( GEOS_3 ) !-------------------------------------------------------------- ! GEOS-3: Lump 48 levels into 30 levels, starting above L=22. ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,23) = LUMP_2( INCOL, LGLOB, 23 ) OUT(J,24) = LUMP_2( INCOL, LGLOB, 25 ) OUT(J,25) = LUMP_2( INCOL, LGLOB, 27 ) ! Lump 4 levels together at a time OUT(J,26) = LUMP_4( INCOL, LGLOB, 29 ) OUT(J,27) = LUMP_4( INCOL, LGLOB, 33 ) OUT(J,28) = LUMP_4( INCOL, LGLOB, 37 ) OUT(J,29) = LUMP_4( INCOL, LGLOB, 41 ) OUT(J,30) = LUMP_4( INCOL, LGLOB, 45 ) #elif defined( GEOS_4 ) !-------------------------------------------------------------- ! GEOS-4: Lump 55 levels into 30 levels, starting above L=20 ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,20) = LUMP_2( INCOL, LGLOB, 20 ) OUT(J,21) = LUMP_2( INCOL, LGLOB, 22 ) OUT(J,22) = LUMP_2( INCOL, LGLOB, 24 ) OUT(J,23) = LUMP_2( INCOL, LGLOB, 26 ) ! Lump 4 levels together at a time OUT(J,24) = LUMP_4( INCOL, LGLOB, 28 ) OUT(J,25) = LUMP_4( INCOL, LGLOB, 32 ) OUT(J,26) = LUMP_4( INCOL, LGLOB, 36 ) OUT(J,27) = LUMP_4( INCOL, LGLOB, 40 ) OUT(J,28) = LUMP_4( INCOL, LGLOB, 44 ) OUT(J,29) = LUMP_4( INCOL, LGLOB, 48 ) OUT(J,30) = LUMP_4( INCOL, LGLOB, 52 ) #elif defined( GEOS_5 ) || defined( GEOS_FP ) !-------------------------------------------------------------- ! GEOS-5: Lump 72 levels into 47 levels, starting above L=36 ! Lump levels in groups of 2, then 4. !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,37) = LUMP_2( INCOL, LGLOB, 37 ) OUT(J,38) = LUMP_2( INCOL, LGLOB, 39 ) OUT(J,39) = LUMP_2( INCOL, LGLOB, 41 ) OUT(J,40) = LUMP_2( INCOL, LGLOB, 43 ) ! Lump 4 levels together at a time OUT(J,41) = LUMP_4( INCOL, LGLOB, 45 ) OUT(J,42) = LUMP_4( INCOL, LGLOB, 49 ) OUT(J,43) = LUMP_4( INCOL, LGLOB, 53 ) OUT(J,44) = LUMP_4( INCOL, LGLOB, 57 ) OUT(J,45) = LUMP_4( INCOL, LGLOB, 61 ) OUT(J,46) = LUMP_4( INCOL, LGLOB, 65 ) OUT(J,47) = LUMP_4( INCOL, LGLOB, 69 ) #endif ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE TRANSFER_ZONAL_R4 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_ZONAL_R8( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_ZONAL_R4 transfers zonal mean or lat-alt data from a ! REAL*4 array of dimension (JGLOB,LGLOB) to a REAL*8 array of dimension ! (JJPAR,LLPAR). Regrid GEOS-3 data from 48 --> 30 levels or GEOS-4 data ! from 55 --> 30 levels if necessary. (bmy, 9/21/01, 5/24/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (JGLOB,LGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (JJPAR,LLPAR) ! ! NOTES: ! (1 ) Lump levels together in groups of 2 or 4, as dictated by Mat Evans. ! (bmy, 9/21/01) ! (2 ) Assumes that LLPAR == LGLOB for GEOS-1, GEOS-STRAT (bmy, 9/21/01) ! (3 ) Now use function GET_YOFFSET from "grid_mod.f". Now I0 and J0 are ! local variables (bmy, 3/11/03) ! (4 ) Added code to regrid GEOS-4 from 55 --> 30 levels (mje, bmy, 10/31/03) ! (5 ) Now modified for GEOS-5 met fields (bmy, 5/24/05) !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments REAL*4, INTENT(IN) :: IN(JGLOB,LGLOB) REAL*8, INTENT(OUT) :: OUT(JJPAR,LLPAR) ! Local variables INTEGER :: J REAL*4 :: INCOL(LGLOB) !================================================================ ! TRANSFER_ZONAL_R8 begins here! !================================================================ ! Copy the first L_COPY levels OUT(:,1:L_COPY) = IN( 1+J0:JJPAR+J0, 1:L_COPY ) ! Exit if we are running at full vertical resolution IF ( LLPAR == LGLOB ) RETURN !================================================================ ! Collapse levels in the stratosphere !================================================================ !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( J, INCOL ) !$OMP+SCHEDULE( DYNAMIC ) DO J = 1, JJPAR ! Store vertical column at (I,J) in a 1-D vector INCOL = IN( J+J0, 1:LGLOB ) #if defined( GEOS_3 ) !-------------------------------------------------------------- ! GEOS-3: Lump 48 levels into 30 levels, starting above L=22. ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,23) = LUMP_2( INCOL, LGLOB, 23 ) OUT(J,24) = LUMP_2( INCOL, LGLOB, 25 ) OUT(J,25) = LUMP_2( INCOL, LGLOB, 27 ) ! Lump 4 levels together at a time OUT(J,26) = LUMP_4( INCOL, LGLOB, 29 ) OUT(J,27) = LUMP_4( INCOL, LGLOB, 33 ) OUT(J,28) = LUMP_4( INCOL, LGLOB, 37 ) OUT(J,29) = LUMP_4( INCOL, LGLOB, 41 ) OUT(J,30) = LUMP_4( INCOL, LGLOB, 45 ) #elif defined( GEOS_4 ) !-------------------------------------------------------------- ! GEOS-4: Lump 55 levels into 30 levels, starting above L=20 ! Lump levels in groups of 2, then 4. (cf. Mat Evans) !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,20) = LUMP_2( INCOL, LGLOB, 20 ) OUT(J,21) = LUMP_2( INCOL, LGLOB, 22 ) OUT(J,22) = LUMP_2( INCOL, LGLOB, 24 ) OUT(J,23) = LUMP_2( INCOL, LGLOB, 26 ) ! Lump 4 levels together at a time OUT(J,24) = LUMP_4( INCOL, LGLOB, 28 ) OUT(J,25) = LUMP_4( INCOL, LGLOB, 32 ) OUT(J,26) = LUMP_4( INCOL, LGLOB, 36 ) OUT(J,27) = LUMP_4( INCOL, LGLOB, 40 ) OUT(J,28) = LUMP_4( INCOL, LGLOB, 44 ) OUT(J,29) = LUMP_4( INCOL, LGLOB, 48 ) OUT(J,30) = LUMP_4( INCOL, LGLOB, 52 ) #elif defined( GEOS_5 ) || defined( GEOS_FP ) !-------------------------------------------------------------- ! GEOS-5: Lump 72 levels into 47 levels, starting above L=36 ! Lump levels in groups of 2, then 4. !-------------------------------------------------------------- ! Lump 2 levels together at a time OUT(J,37) = LUMP_2( INCOL, LGLOB, 37 ) OUT(J,38) = LUMP_2( INCOL, LGLOB, 39 ) OUT(J,39) = LUMP_2( INCOL, LGLOB, 41 ) OUT(J,40) = LUMP_2( INCOL, LGLOB, 43 ) ! Lump 4 levels together at a time OUT(J,41) = LUMP_4( INCOL, LGLOB, 45 ) OUT(J,42) = LUMP_4( INCOL, LGLOB, 49 ) OUT(J,43) = LUMP_4( INCOL, LGLOB, 53 ) OUT(J,44) = LUMP_4( INCOL, LGLOB, 57 ) OUT(J,45) = LUMP_4( INCOL, LGLOB, 61 ) OUT(J,46) = LUMP_4( INCOL, LGLOB, 65 ) OUT(J,47) = LUMP_4( INCOL, LGLOB, 69 ) #endif ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE TRANSFER_ZONAL_R8 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_2D_INT( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_2D_INT transfers 2-D data from a REAL*4 array of ! dimension (IGLOB,JGLOB) to an INTEGER array of dimension (IIPAR,JJPAR). ! (bmy, 9/21/01, 3/11/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4 ) : Input field, of dimension (IGLOB,JGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (INTEGER) : Output field, of dimension (IIPAR,JJPAR) ! ! NOTES: ! (1 ) Use parallel DO loops to speed things up (bmy, 9/21/01)! ! (2 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f". ! Now I0 and J0 are local variables. (bmy, 3/11/03) !****************************************************************************** ! # include "CMN_SIZE" ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB) INTEGER, INTENT(OUT) :: OUT(IIPAR,JJPAR) !================================================================= ! TRANSFER_2D_INT begins here! !================================================================= ! Copy and cast array OUT = IN( 1+I0:IIPAR+I0, 1+J0:JJPAR+J0 ) ! Return to calling program END SUBROUTINE TRANSFER_2D_INT !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_2D_R4( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_2D_R4 transfers 2-D data from a REAL*4 array of ! dimension (IGLOB,JGLOB) to a REAL*4 array of dimension (IIPAR,JJPAR). ! (bmy, 1/25/02, 3/11/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*4) : Output field, of dimension (IIPAR,JJPAR) ! ! NOTES: ! (1 ) Use parallel DO loops to speed things up (bmy, 9/21/01) ! (2 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f" ! Now I0 and J0 are local variables (bmy, 3/11/03) !****************************************************************************** ! # include "CMN_SIZE" ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB) REAL*4, INTENT(OUT) :: OUT(IIPAR,JJPAR) !================================================================= ! TRANSFER_2D_R4 begins here! !================================================================= ! Copy and cast array OUT = IN( 1+I0:IIPAR+I0, 1+J0:JJPAR+J0 ) ! Return to calling program END SUBROUTINE TRANSFER_2D_R4 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_2D_R8( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_2D_R8 transfers 2-D data from a REAL*4 array of ! dimension (IGLOB,JGLOB) to a REAL*8 array of dimension (IIPAR,JJPAR). ! (bmy, 9/21/01, 3/11/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (IIPAR,JJPAR) ! ! NOTES: ! (1 ) Use parallel DO loops to speed things up (bmy, 9/21/01) ! (2 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f" ! Now I0 and J0 are local variables. (bmy, 3/11/03) !****************************************************************************** ! # include "CMN_SIZE" ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB) REAL*8, INTENT(OUT) :: OUT(IIPAR,JJPAR) !================================================================= ! TRANSFER_2D_R8 begins here! !================================================================= ! Copy and cast array OUT = IN( 1+I0:IIPAR+I0, 1+J0:JJPAR+J0 ) ! Return to calling program END SUBROUTINE TRANSFER_2D_R8 !------------------------------------------------------------------------------ SUBROUTINE TRANSFER_TO_1D( IN, OUT ) ! !****************************************************************************** ! Subroutine TRANSFER_TO_1D transfers 2-D data from a REAL*4 array of ! dimension (IGLOB,JGLOB) to 1-D a REAL*8 array of dimension (MAXIJ), ! where MAXIJ = IIPAR * JJPAR. (bmy, 9/21/01, 3/11/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4) : Input field, of dimension (IGLOB,JGLOB) ! ! Arguments as Output: ! ============================================================================ ! (2 ) OUT (REAL*8) : Output field, of dimension (MAXIJ) ! ! NOTES: ! (1 ) Use single-processor DO-loops for now (bmy, 9/21/01) ! (2 ) Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f". ! Now I0 and J0 are local variables. (bmy, 3/11/03) !****************************************************************************** ! # include "CMN_SIZE" ! Arguments REAL*4, INTENT(IN) :: IN(IGLOB,JGLOB) REAL*8, INTENT(OUT) :: OUT(MAXIJ) ! Local variables INTEGER :: I, IREF, J, JREF, IJLOOP !================================================================= ! TRANSFER_TO_1D begins here! !================================================================= ! 1-D counter IJLOOP = 0 ! IJLOOP = ( (J-1) * IIPAR ) + I DO J = 1, JJPAR JREF = J + J0 DO I = 1, IIPAR IREF = I + I0 IJLOOP = IJLOOP + 1 OUT(IJLOOP) = IN(IREF,JREF) ENDDO ENDDO ! Return to calling program END SUBROUTINE TRANSFER_TO_1D !------------------------------------------------------------------------------ FUNCTION LUMP_2_R4( IN, L_IN, L ) RESULT( OUT ) ! !****************************************************************************** ! Function LUMP_2_R4 lumps 2 sigma levels into one thick level. ! Input arguments must be REAL*4. (bmy, 9/18/01, 10/31/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4 ) : Column of data on input vertical grid ! (2 ) L_IN (INTEGER) : Vertical dimension of the IN array ! (3 ) L (INTEGER) : Level on input grid from which to start regridding ! ! Function Value: ! ============================================================================ ! (4 ) OUT (REAL*4 ) : Data on output grid -- 2 levels merged together ! ! NOTES: ! (1 ) Now references GEOS_CHEM_STOP from "error_mod.f" (bmy, 10/15/02) ! (2 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). Also updated comments (bmy, 10/31/03) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : GEOS_CHEM_STOP ! Arguments INTEGER, INTENT(IN) :: L_IN, L REAL*4, INTENT(IN) :: IN(L_IN) ! Function value REAL*4 :: OUT !================================================================= ! LUMP_2_R4 begins here! !================================================================= ! Error check: prevent array out of bounds error IF ( L < 1 .or. L > L_IN .or. L+2 > L_IN+1 ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'Error: L < 1 or L > L_IN or L+2 > L_IN+1!' WRITE( 6, '(a)' ) 'STOP in LUMP_2 ("regrid_mod.f")' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF !================================================================= ! When lumping the levels together, we need to perform a weighted ! average by air mass. The air mass in a grid box is given by: ! ! Air Mass = Delta-P [hPa] * 100/g * Grid box sfc area [cm2] ! ! Where Delta-P is the difference in pressure between the bottom ! and top edges of the grid box (Delta-P is positive), 100/g is a ! constant, and the grid box surface area is also constant w/in ! the same vertical column. Therefore, for a vertical column, ! the air mass in a grid box really only depends on Delta-P. ! ! Because of this, we may compute the quantity Q(L') on the new ! merged sigma according to the weighted average (EQUATION 1): ! ! [ ( Q(L ) * ( PEDGE(L ) - PEDGE(L+1) ) ) + ! ( Q(L+1) * ( PEDGE(L+1) - PEDGE(L+2) ) ) ] ! Q(L') = ------------------------------------------------- ! PEDGE(L) - PEDGE(L+2) ! ! where PEDGE(L) is the pressure at the bottom edge of layer L. ! ! GEOS-4 is a hybrid sigma-pressure grid, with all of the levels ! above level 14 being pure pressure levels. Therefore, for ! GEOS-4, we may just use EQUATION 1 exactly as written above. ! ! However, GEOS-3 is a pure sigma grid. The pressure at the ! edge of a grid box is given by (EQUATION 2): ! ! PEDGE(I,J,L) = PTOP + ( SIG_EDGE(L) * ( Psurf(I,J) - PTOP) ) ! ! In a vertical column, then ( Psurf(I,J) - PTOP ) will be the ! same for all vertical levels, and will divide out of the ! equation. Also the PTOP's will cancel each other out. Thus ! for GEOS-3, the above equation reduces to (EQUATION 3): ! ! [ ( Q(L ) * ( SIG_EDGE(L ) - SIG_EDGE(L+1) ) ) + ! ( Q(L+1) * ( SIG_EDGE(L+1) - SIG_EDGE(L+2) ) ) ] ! Q(L') = ---------------------------------------------------- ! SIG_EDGE(L) - SIG_EDGE(L+2) !================================================================= ! For GEOS-3, EDGE_IN are the sigma values at grid box edges ! For GEOS-4, EDGE_IN are the pressures at grid box edges OUT = ( IN(L ) * ( EDGE_IN(L ) - EDGE_IN(L+1) ) ) + & ( IN(L+1) * ( EDGE_IN(L+1) - EDGE_IN(L+2) ) ) ! Divde by sigma thickness of new thick level OUT = OUT / ( EDGE_IN(L) - EDGE_IN(L+2) ) ! Return to calling routine END FUNCTION LUMP_2_R4 !------------------------------------------------------------------------------ FUNCTION LUMP_2_R8( IN, L_IN, L ) RESULT( OUT ) ! !****************************************************************************** ! Function LUMP_2_R8 lumps 2 sigma levels into one thick level. ! Input arguments must be REAL*8. (bmy, 9/18/01, 10/31/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*8 ) : Column of data on input vertical grid ! (2 ) L_IN (INTEGER) : Vertical dimension of the IN array ! (3 ) L (INTEGER) : Level on input grid from which to start regridding ! ! Function Value: ! ============================================================================ ! (4 ) OUT (REAL*8 ) : Data on output grid -- 2 levels merged together ! ! NOTES: ! (1 ) Now references GEOS_CHEM_STOP from "error_mod.f" (bmy, 10/15/02) ! (2 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). Also updated comments (bmy, 10/31/03) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : GEOS_CHEM_STOP ! Arguments INTEGER, INTENT(IN) :: L_IN, L REAL*8, INTENT(IN) :: IN(L_IN) ! Function value REAL*8 :: OUT !================================================================= ! LUMP_2_R8 begins here! !================================================================= ! Error check: prevent array out of bounds error IF ( L < 1 .or. L > L_IN .or. L+2 > L_IN+1 ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'ERROR: L < 1 or L > L_IN or L+2 > L_IN+1!' WRITE( 6, '(a)' ) 'STOP in LUMP_2 ("regrid_mod.f")' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF !================================================================= ! When lumping the levels together, we need to perform a weighted ! average by air mass. The air mass in a grid box is given by: ! ! Air Mass = Delta-P [hPa] * 100/g * Grid box sfc area [cm2] ! ! Where Delta-P is the difference in pressure between the bottom ! and top edges of the grid box (Delta-P is positive), 100/g is a ! constant, and the grid box surface area is also constant w/in ! the same vertical column. Therefore, for a vertical column, ! the air mass in a grid box really only depends on Delta-P. ! ! Because of this, we may compute the quantity Q(L') on the new ! merged sigma according to the weighted average (EQUATION 1): ! ! [ ( Q(L ) * ( PEDGE(L ) - PEDGE(L+1) ) ) + ! ( Q(L+1) * ( PEDGE(L+1) - PEDGE(L+2) ) ) + ! ( Q(L+2) * ( PEDGE(L+2) - PEDGE(L+3) ) ) + ! ( Q(L+3) * ( PEDGE(L+3) - PEDGE(L+4) ) ) ] ! Q(L') = ------------------------------------------------ ! PEDGE(L) - PEDGE(L+4) ! ! where PEDGE(L) is the pressure at the bottom edge of layer L. ! ! GEOS-4 is a hybrid sigma-pressure grid, with all of the levels ! above level 14 being pure pressure levels. Therefore, for ! GEOS-4, we may just use EQUATION 1 exactly as written above. ! ! However, GEOS-3 is a pure sigma grid. The pressure at the ! edge of a grid box is given by EQUATION 2: ! ! PEDGE(I,J,L) = PTOP + ( SIG_EDGE(L) * ( Psurf(I,J) - PTOP) ) ! ! In a vertical column, then ( Psurf(I,J) - PTOP ) will be the ! same for all vertical levels, and will divide out of the ! equation. Also the PTOP's will cancel each other out. Thus ! for GEOS-3, the above equation reduces to (EQUATION 3): ! ! [ ( Q(L ) * ( SIG_EDGE(L ) - SIG_EDGE(L+1) ) ) + ! ( Q(L+1) * ( SIG_EDGE(L+1) - SIG_EDGE(L+2) ) ) ] ! Q(L') = ---------------------------------------------------- ! SIG_EDGE(L) - SIG_EDGE(L+2) !================================================================= ! For GEOS-3, EDGE_IN are the sigma values at grid box edges ! For GEOS-4, EDGE_IN are the pressures at grid box edges OUT = ( IN(L ) * ( EDGE_IN(L ) - EDGE_IN(L+1) ) ) + & ( IN(L+1) * ( EDGE_IN(L+1) - EDGE_IN(L+2) ) ) ! Divde by thickness of new lumped level OUT = OUT / ( EDGE_IN(L) - EDGE_IN(L+2) ) ! Return to calling routine END FUNCTION LUMP_2_R8 !------------------------------------------------------------------------------ FUNCTION LUMP_4_R4( IN, L_IN, L ) RESULT( OUT ) ! !****************************************************************************** ! Function LUMP_4_R4 lumps 4 sigma levels into one thick level. ! Input arguments must be REAL*4. (bmy, 9/18/01, 10/31/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*4 ) : Column of data on input vertical grid ! (2 ) L_IN (INTEGER) : Vertical dimension of the IN array ! (3 ) L (INTEGER) : Level on input grid from which to start regridding ! ! Function Value: ! ============================================================================ ! (4 ) OUT (REAL*4 ) : Data on output grid -- 4 levels merged together ! ! NOTES: ! (1 ) Now references GEOS_CHEM_STOP from "error_mod.f" (bmy, 10/15/02) ! (2 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). Also updated comments (bmy, 10/31/03) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : GEOS_CHEM_STOP ! Arguments INTEGER, INTENT(IN) :: L_IN, L REAL*4, INTENT(IN) :: IN(L_IN) ! Function value REAL*4 :: OUT !================================================================= ! LUMP_4_R4 begins here! !================================================================= ! Error check: prevent array out of bounds error IF ( L < 1 .or. L > L_IN .or. L+4 > L_IN+1 ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'ERROR: L < 1 or L > L_IN or L+4 > L_IN+1!' WRITE( 6, '(a)' ) 'STOP in LUMP_4 ("regrid_mod.f")' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF !================================================================= ! When lumping the levels together, we need to perform a weighted ! average by air mass. The air mass in a grid box is given by: ! ! Air Mass = Delta-P [hPa] * 100/g * Grid box sfc area [cm2] ! ! Where Delta-P is the difference in pressure between the bottom ! and top edges of the grid box (Delta-P is positive), 100/g is a ! constant, and the grid box surface area is also constant w/in ! the same vertical column. Therefore, for a vertical column, ! the air mass in a grid box really only depends on Delta-P. ! ! Because of this, we may compute the quantity Q(L') on the new ! merged sigma according to the weighted average (EQUATION 1): ! ! [ ( Q(L ) * ( PEDGE(L ) - PEDGE(L+1) ) ) + ! ( Q(L+1) * ( PEDGE(L+1) - PEDGE(L+2) ) ) + ! ( Q(L+2) * ( PEDGE(L+2) - PEDGE(L+3) ) ) + ! ( Q(L+3) * ( PEDGE(L+3) - PEDGE(L+4) ) ) ] ! Q(L') = -------------------------------------------------- ! PEDGE(L) - PEDGE(L+4) ! ! where PEDGE(L) is the pressure at the bottom edge of layer L. ! ! GEOS-4 is a hybrid sigma-pressure grid, with all of the levels ! above level 14 being pure pressure levels. Therefore, for ! GEOS-4, we may just use EQUATION 1 exactly as written above. ! ! However, GEOS-3 is a pure sigma grid. The pressure at the ! edge of a grid box is given by EQUATION 2: ! ! PEDGE(I,J,L) = PTOP + ( SIG_EDGE(L) * ( Psurf(I,J) - PTOP) ) ! ! In a vertical column, then ( Psurf(I,J) - PTOP ) will be the ! same for all vertical levels, and will divide out of the ! equation. Also the PTOP's will cancel each other out. Thus ! for GEOS-3, the above equation reduces to (EQUATION 3): ! ! [ ( Q(L ) * ( SIG_EDGE(L ) - SIG_EDGE(L+1) ) ) + ! ( Q(L+1) * ( SIG_EDGE(L+1) - SIG_EDGE(L+2) ) ) + ! ( Q(L+2) * ( SIG_EDGE(L+2) - SIG_EDGE(L+3) ) ) + ! ( Q(L+3) * ( SIG_EDGE(L+3) - SIG_EDGE(L+4) ) ) ] ! Q(L') = ---------------------------------------------------- ! SIG_EDGE(L) - SIG_EDGE(L+4) !================================================================= ! For GEOS-3, EDGE_IN are the sigma values at grid box edges ! For GEOS-4, EDGE_IN are the pressures at grid box edges OUT = ( IN(L ) * ( EDGE_IN(L ) - EDGE_IN(L+1) ) ) + & ( IN(L+1) * ( EDGE_IN(L+1) - EDGE_IN(L+2) ) ) + & ( IN(L+2) * ( EDGE_IN(L+2) - EDGE_IN(L+3) ) ) + & ( IN(L+3) * ( EDGE_IN(L+3) - EDGE_IN(L+4) ) ) ! Divde by thickness of new lumped level OUT = OUT / ( EDGE_IN(L) - EDGE_IN(L+4) ) ! Return to calling routine END FUNCTION LUMP_4_R4 !------------------------------------------------------------------------------ FUNCTION LUMP_4_R8( IN, L_IN, L ) RESULT( OUT ) ! !****************************************************************************** ! Function LUMP_4_R8 lumps 4 sigma levels into one thick level. ! Input arguments must be REAL*8. (bmy, 9/18/01, 10/31/03) ! ! Arguments as Input: ! ============================================================================ ! (1 ) IN (REAL*8 ) : Column of data on input vertical grid ! (2 ) L_IN (INTEGER) : Vertical dimension of the IN array ! (3 ) L (INTEGER) : Level on input grid from which to start regridding ! ! Function Value: ! ============================================================================ ! (4 ) OUT (REAL*8 ) : Data on output grid -- 4 levels merged together ! ! NOTES: ! (1 ) Now references GEOS_CHEM_STOP from "error_mod.f" (bmy, 10/15/02) ! (2 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). Also updated comments (bmy, 10/31/03) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : GEOS_CHEM_STOP # include "CMN_SIZE" ! Arguments INTEGER, INTENT(IN) :: L_IN, L REAL*8, INTENT(IN) :: IN(L_IN) ! Function value REAL*8 :: OUT !================================================================= ! LUMP_4_R8 begins here! !================================================================= ! Error check: prevent array out of bounds error IF ( L < 1 .or. L > L_IN .or. L+4 > L_IN+1 ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'ERROR: L < 1 or L > L_IN or L+4 > L_IN+1!' WRITE( 6, '(a)' ) 'STOP in LUMP_4 ("regrid_mod.f")' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF !================================================================= ! When lumping the levels together, we need to perform a weighted ! average by air mass. The air mass in a grid box is given by: ! ! Air Mass = Delta-P [hPa] * 100/g * Grid box sfc area [cm2] ! ! Where Delta-P is the difference in pressure between the bottom ! and top edges of the grid box (Delta-P is positive), 100/g is a ! constant, and the grid box surface area is also constant w/in ! the same vertical column. Therefore, for a vertical column, ! the air mass in a grid box really only depends on Delta-P. ! ! Because of this, we may compute the quantity Q(L') on the new ! merged sigma according to the weighted average (EQUATION 1): ! ! [ ( Q(L ) * ( PEDGE(L ) - PEDGE(L+1) ) ) + ! ( Q(L+1) * ( PEDGE(L+1) - PEDGE(L+2) ) ) + ! ( Q(L+2) * ( PEDGE(L+2) - PEDGE(L+3) ) ) + ! ( Q(L+3) * ( PEDGE(L+3) - PEDGE(L+4) ) ) ] ! Q(L') = ------------------------------------------------ ! PEDGE(L) - PEDGE(L+4) ! ! where PEDGE(L) is the pressure at the bottom edge of layer L. ! ! GEOS-4 is a hybrid sigma-pressure grid, with all of the levels ! above level 14 being pure pressure levels. Therefore, for ! GEOS-4, we may just use EQUATION 1 exactly as written above. ! ! However, GEOS-3 is a pure sigma grid. The pressure at the ! edge of a grid box is given by EQUATION 2: ! ! PEDGE(I,J,L) = PTOP + ( SIG_EDGE(L) * ( Psurf(I,J) - PTOP) ) ! ! In a vertical column, then ( Psurf(I,J) - PTOP ) will be the ! same for all vertical levels, and will divide out of the ! equation. Also the PTOP's will cancel each other out. Thus ! for GEOS-3, the above equation reduces to (EQUATION 3): ! ! [ ( Q(L ) * ( SIG_EDGE(L ) - SIG_EDGE(L+1) ) ) + ! ( Q(L+1) * ( SIG_EDGE(L+1) - SIG_EDGE(L+2) ) ) + ! ( Q(L+2) * ( SIG_EDGE(L+2) - SIG_EDGE(L+3) ) ) + ! ( Q(L+3) * ( SIG_EDGE(L+3) - SIG_EDGE(L+4) ) ) ] ! Q(L') = ------------------------------------------------ ! SIG_EDGE(L) - SIG_EDGE(L+4) !================================================================= ! For GEOS-3, EDGE_IN are the sigma values at grid box edges ! For GEOS-4, EDGE_IN are the pressures at grid box edges OUT = ( IN(L ) * ( EDGE_IN(L ) - EDGE_IN(L+1) ) ) + & ( IN(L+1) * ( EDGE_IN(L+1) - EDGE_IN(L+2) ) ) + & ( IN(L+2) * ( EDGE_IN(L+2) - EDGE_IN(L+3) ) ) + & ( IN(L+3) * ( EDGE_IN(L+3) - EDGE_IN(L+4) ) ) ! Divde by thickness of new lumped level OUT = OUT / ( EDGE_IN(L) - EDGE_IN(L+4) ) ! Return to calling routine END FUNCTION LUMP_4_R8 !------------------------------------------------------------------------------ SUBROUTINE INIT_TRANSFER( THIS_I0, THIS_J0 ) ! !****************************************************************************** ! Subroutine INIT_TRANSFER initializes and zeroes the EDGE_IN array. ! (bmy, 9/19/01, 2/8/07) ! ! NOTES: ! (1 ) Removed additional "," for GEOS-1 definition of EDGE_IN (bmy, 3/25/02) ! (2 ) Now use GET_BP from "pressure_mod.f" to get sigma edges for all ! grids except GEOS-3 (dsa, bdf, bmy, 8/22/02) ! (3 ) Declare L as a local variable. Also reference ALLOC_ERR from module ! "error_mod.f" (bmy, 10/15/02) ! (4 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). Now assign original Ap coordinates from ! the GEOS-4 grid to the EDGE_IN array (bmy, 10/31/03) ! (5 ) Now modified for GEOS-5 met fields (bmy, 5/24/05) ! (6 ) Rewritten for clarity. Remove references to "grid_mod.f" and ! "pressure_mod.f". Now pass I0, J0 from "grid_mod.f" via the arg list. ! (bmy, 2/8/07) !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : ALLOC_ERR # include "CMN_SIZE" ! Size parameters ! Arguments INTEGER, INTENT(IN) :: THIS_I0, THIS_J0 ! Local variables LOGICAL, SAVE :: IS_INIT = .FALSE. INTEGER :: AS, L !================================================================= ! INIT_TRANSFER begins here! !================================================================= ! Return if we have already initialized IF ( IS_INIT ) RETURN !----------------------------------------------------------------- ! Get global X and Y offsets (usually =0, even for nested grid) !----------------------------------------------------------------- I0 = THIS_I0 J0 = THIS_J0 !----------------------------------------------------------------- ! Get the # of levels to copy in the vertical !----------------------------------------------------------------- IF ( LLPAR == LGLOB ) THEN ! Full vertical resolution; copy all levels! L_COPY = LGLOB ELSE #if defined( GEOS_3 ) L_COPY = 22 ! GEOS-3: Copy up to L=22 #elif defined( GEOS_4 ) L_COPY = 19 ! GEOS-4: Copy up to L=19 #elif defined( GEOS_5 ) || defined( GEOS_FP ) L_COPY = 36 ! GEOS-5: Copy up to L=36 #elif defined( GCAP ) L_COPY = LGLOB ! GCAP: Copy all levels #endif ENDIF !================================================================= ! Define vertical edges for collapsing stratospheric levels !================================================================= ! Allocate the EDGE_IN array ALLOCATE( EDGE_IN( LGLOB + 1 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'EDGE_IN' ) EDGE_IN = 0d0 #if defined( GEOS_5 ) || defined( GEOS_FP ) !----------------------------------------------------------------- ! For GEOS-5, levels 1-31 are "terrain-following" coordinates ! (i.e. vary with location), and levels 32-72 are fixed pressure ! levels. The transition pressure is 176.93 hPa, which is the ! edge between L=31 and L=32. ! ! Initialize EDGE_IN with the original 73 Ap values for GEOS-5. !----------------------------------------------------------------- EDGE_IN = (/ & 0.000000d+00, 4.804826d-02, 6.593752d+00, 1.313480d+01, & 1.961311d+01, 2.609201d+01, 3.257081d+01, 3.898201d+01, & 4.533901d+01, 5.169611d+01, 5.805321d+01, 6.436264d+01, & 7.062198d+01, 7.883422d+01, 8.909992d+01, 9.936521d+01, & 1.091817d+02, 1.189586d+02, 1.286959d+02, 1.429100d+02, & 1.562600d+02, 1.696090d+02, 1.816190d+02, 1.930970d+02, & 2.032590d+02, 2.121500d+02, 2.187760d+02, 2.238980d+02, & 2.243630d+02, 2.168650d+02, 2.011920d+02, !------- EDGES OF GEOS-5 FIXED PRESSURE LEVELS OCCUR BELOW THIS LINE ------ & 1.769300d+02, & 1.503930d+02, 1.278370d+02, 1.086630d+02, 9.236572d+01, & 7.851231d+01, 6.660341d+01, 5.638791d+01, 4.764391d+01, & 4.017541d+01, 3.381001d+01, 2.836781d+01, 2.373041d+01, & 1.979160d+01, 1.645710d+01, 1.364340d+01, 1.127690d+01, & 9.292942d+00, 7.619842d+00, 6.216801d+00, 5.046801d+00, & 4.076571d+00, 3.276431d+00, 2.620211d+00, 2.084970d+00, & 1.650790d+00, 1.300510d+00, 1.019440d+00, 7.951341d-01, & 6.167791d-01, 4.758061d-01, 3.650411d-01, 2.785261d-01, & 2.113490d-01, 1.594950d-01, 1.197030d-01, 8.934502d-02, & 6.600001d-02, 4.758501d-02, 3.270000d-02, 2.000000d-02, & 1.000000d-02 /) #elif defined( GEOS_4 ) !----------------------------------------------------------------- ! For GEOS-4, levels 1-14 are "terrain-following" coordinates ! (i.e. vary with location), and levels 15-55 are fixed pressure ! levels. The transition pressure is 176.93 hPa, which is the ! edge between L=14 and L=15. ! ! Initialize EDGE_IN with the original 56 Ap values for GEOS-4. !----------------------------------------------------------------- EDGE_IN = (/ 0.000000d0, 0.000000d0, 12.704939d0, & 35.465965d0, 66.098427d0, 101.671654d0, & 138.744400d0, 173.403183d0, 198.737839d0, & 215.417526d0, 223.884689d0, 224.362869d0, & 216.864929d0, 201.192093d0, 176.929993d0, & 150.393005d0, 127.837006d0, 108.663429d0, & 92.365662d0, 78.512299d0, 66.603378d0, & 56.387939d0, 47.643932d0, 40.175419d0, & 33.809956d0, 28.367815d0, 23.730362d0, & 19.791553d0, 16.457071d0, 13.643393d0, & 11.276889d0, 9.292943d0, 7.619839d0, & 6.216800d0, 5.046805d0, 4.076567d0, & 3.276433d0, 2.620212d0, 2.084972d0, & 1.650792d0, 1.300508d0, 1.019442d0, & 0.795134d0, 0.616779d0, 0.475806d0, & 0.365041d0, 0.278526d0, 0.211349d0, & 0.159495d0, 0.119703d0, 0.089345d0, & 0.066000d0, 0.047585d0, 0.032700d0, & 0.020000d0, 0.010000d0 /) #elif defined( GEOS_3 ) !----------------------------------------------------------------- ! For GEOS-3, this is a pure-sigma grid. ! Initialize EDGE_IN with the original 49 sigma edges. !----------------------------------------------------------------- EDGE_IN = (/ 1.000000d0, 0.997095d0, 0.991200d0, 0.981500d0, & 0.967100d0, 0.946800d0, 0.919500d0, 0.884000d0, & 0.839000d0, 0.783000d0, 0.718200d0, 0.647600d0, & 0.574100d0, 0.500000d0, 0.427800d0, 0.359500d0, & 0.297050d0, 0.241950d0, 0.194640d0, 0.155000d0, & 0.122680d0, 0.096900d0, 0.076480d0, 0.060350d0, & 0.047610d0, 0.037540d0, 0.029600d0, 0.023330d0, & 0.018380d0, 0.014480d0, 0.011405d0, 0.008975d0, & 0.007040d0, 0.005500d0, 0.004280d0, 0.003300d0, & 0.002530d0, 0.001900d0, 0.001440d0, 0.001060d0, & 0.000765d0, 0.000540d0, 0.000370d0, 0.000245d0, & 0.000155d0, 9.20000d-5, 4.75000d-5, 1.76800d-5, & 0.000000d0 /) #endif ! We have now initialized everything IS_INIT = .TRUE. ! Return to calling program END SUBROUTINE INIT_TRANSFER !------------------------------------------------------------------------------ SUBROUTINE CLEANUP_TRANSFER ! !****************************************************************************** ! Subroutine CLEANUP_TRANSFER deallocates the EDGE_IN array. ! (bmy, 9/19/01, 10/31/03) ! ! NOTES: ! (1 ) Renamed SIGE_IN to EDGE_IN to denote that it is not always a sigma ! coordinate (as for GEOS-4). (bmy, 10/31/03) !****************************************************************************** ! !================================================================= ! CLEANUP_TRANSFER begins here! !================================================================= IF ( ALLOCATED( EDGE_IN ) ) DEALLOCATE( EDGE_IN ) ! Return to calling program END SUBROUTINE CLEANUP_TRANSFER !------------------------------------------------------------------------------ ! End of module END MODULE TRANSFER_MOD