File: C:\NOAA\NEMS_11731\src\atmos\gfs\phys\gfs_physics_grid_create_mod.f

1           module gfs_physics_grid_create_mod
2     !
3     !-------------------------------------------------------------------
4     ! this code is used to create the esmf grids for the gfs esmf model.
5     ! weiyu yang, 09/2005.
6     ! updated by henry juang 04/2007
7     ! updated by shrinivas moorthi for physics on 07/2007
8     ! updated by henry juang 11/2007
9     ! weiyu yang, 02/2008, updated to use the ESMF 3.1.0 library.
10     ! Sarah Lu, 10/09/09, add gfs_physics_grid_create_Gauss3D routine 
11     !                     that creates mGrid (3D Gaussian grids)
12     !-------------------------------------------------------------------
13     !
14     !!uses:
15     !
16           use esmf_mod,                         ONLY: esmf_grid, esmf_vm,                &
17                                                       ESMF_DistGrid, esmf_success,       &
18                                                       ESMF_LogWrite, ESMF_LOG_INFO,      &
19                                                       ESMF_DistGridCreate,               &
20                                                       ESMF_LogMsgFoundError,             &
21                                                       ESMF_FAILURE, ESMF_GridCreate,     &
22                                                       ESMF_GridCreateShapeTile,          &
23                                                       ESMF_INDEX_DELOCAL,                &
24                                                       ESMF_GridAddCoord,                 &
25                                                       ESMF_GridGetCoord,                 &
26                                                       ESMF_STAGGERLOC_CENTER,            &
27                                                       ESMF_GridValidate,ESMF_MAXSTR,     &
28                                                       ESMF_DELayout,ESMF_GridGet,        &
29                                                       ESMF_DistGridGet,ESMF_DELayoutGet
30           use gfs_physics_internal_state_mod,   ONLY: gfs_physics_internal_state
31           use machine,                          ONLY: kind_rad       !added for mGrid
32     
33           implicit none
34     
35           type(esmf_grid), save :: grid0   ! the esmf grid type array. for the 
36                                            ! gfs start date and time information.
37           type(esmf_grid), save :: grid3   ! the esmf grid type array.
38                                            ! for the single gaussian grid arrays.
39           type(esmf_grid), save :: grid4   ! the esmf grid type array.
40                                            ! for the multiple gaussian grid arrays.
41           type(ESMF_Grid), save :: mGrid   ! Mid-layer 3D gaussian grid (im,jm,km)
42     
43     
44           contains
45     
46     !------------------------------------------------------------------------
47           subroutine gfs_physics_grid_create_gauss(vm, int_state,  &
48                                                    DistGrid0, DistGrid3, DistGrid4, rc)
49     !
50     ! this routine create Gaussian grid type for single and multiple levels
51     ! grid 3 (single) and grid4(multiple)
52     !
53           type(esmf_vm),                     intent(inout) :: vm   
54           type(gfs_physics_internal_state),  intent(inout) :: int_state
55           integer,                           intent(out)   :: rc
56     
57           TYPE(ESMF_DistGrid),               INTENT(inout) :: DistGrid0    ! the ESMF DistGrid.
58           TYPE(ESMF_DistGrid),               INTENT(inout) :: DistGrid3    ! the ESMF DistGrid.
59           TYPE(ESMF_DistGrid),               INTENT(inout) :: DistGrid4    ! the ESMF DistGrid.
60     
61           integer                           :: rc1
62           integer                           :: rcfinal
63     
64           integer,            dimension(2)  :: counts
65           integer,            dimension(2)  :: arraystr, arrayend
66     
67           rc1     = esmf_success
68           rcfinal = esmf_success
69     
70     ! create grid.
71     !=====================================================================
72     ! set up parameter arrays for the esmf grid of the gaussian grid space.
73     ! the first dimension is the multiple of latitudian and longitudian
74     ! the second dimension is single level.
75     !----------------------------------------------------------------------
76           counts(1)      = int_state%lonr*int_state%lats_node_r_max
77           counts(1)      = counts(1) * int_state%nodes
78           counts(2)      = 1
79           arraystr(1)    = 1
80           arraystr(2)    = 1
81           arrayend(1)    = counts(1)
82           arrayend(2)    = counts(2)
83     
84     ! Create the ESMF DistGrid3 using the 1-D default decomposition.
85     !---------------------------------------------------------------
86           CALL ESMF_LogWrite("Create DistGrid3", ESMF_LOG_INFO, rc = rc1)
87     
88           DistGrid3 = ESMF_DistGridCreate(arraystr, arrayend, rc = rc1)
89     
90           IF(ESMF_LogMsgFoundError(rc1, "Create DistGrid3")) THEN
91               rcfinal = ESMF_FAILURE
92               PRINT*, 'Error Happened When Creating DistGrid3, rc = ', rc1
93               rc1     = ESMF_SUCCESS
94           END IF
95     
96     ! Create the ESMF grid3 based on the created ESMF DistGrid3 information.
97     ! Grid3 is the grid for the Gaussian grid space.
98     !-----------------------------------------------------------------------
99           CALL ESMF_LogWrite("create gfs_phy grid3", ESMF_LOG_INFO, rc = rc1)
100     
101           grid3 = ESMF_GridCreate(name = "gfs_phy grid3", distgrid = DistGrid3, rc = rc1)
102     
103           IF(ESMF_LogMsgFoundError(rc1, "Create Grid3")) THEN
104               rcfinal = ESMF_FAILURE
105               PRINT*, 'Error Happened When Creating Grid3, rc = ', rc1
106               rc1     = ESMF_SUCCESS
107           END IF
108     
109     !=====================================================================
110     ! set up parameter arrays for the esmf grid of the gaussian grid space.
111     ! the first dimension is the multiple of latitudian and longitudian
112     ! the second dimension is single level.
113     !--------------------------------------------------
114           counts(1)      = int_state%lonr*int_state%lats_node_r_max
115           counts(1)      = counts(1) * int_state%nodes
116           counts(2)      = int_state%levs
117           arraystr(1)    = 1
118           arraystr(2)    = 1
119           arrayend(1)    = counts(1)
120           arrayend(2)    = counts(2)
121     
122     ! Create the ESMF DistGrid4 using the 1-D default decomposition.
123     !---------------------------------------------------------------
124           CALL ESMF_LogWrite("Create DistGrid4", ESMF_LOG_INFO, rc = rc1)
125     
126           DistGrid4 = ESMF_DistGridCreate(arraystr, arrayend, rc = rc1)
127     
128           IF(ESMF_LogMsgFoundError(rc1, "Create DistGrid4")) THEN
129               rcfinal = ESMF_FAILURE
130               PRINT*, 'Error Happened When Creating DistGrid4, rc = ', rc1
131               rc1     = ESMF_SUCCESS
132           END IF
133     
134     ! Create the ESMF grid4 based on the created ESMF DistGrid4 information.
135     ! Grid4 is the grid for the multiple level Gaussian grid space.
136     !-----------------------------------------------------------------------
137           CALL ESMF_LogWrite("create gfs_phy grid4", ESMF_LOG_INFO, rc = rc1)
138     
139           grid4 = ESMF_GridCreate(name = "gfs_phy grid4", distgrid = DistGrid4, rc = rc1)
140     
141           IF(ESMF_LogMsgFoundError(rc1, "Create Grid4")) THEN
142               rcfinal = ESMF_FAILURE
143               PRINT*, 'Error Happened When Creating Grid4, rc = ', rc1
144               rc1     = ESMF_SUCCESS
145           END IF
146     
147     ! set up parameter arrays for the esmf grid used for the date and time
148     ! information to run the gfs.  all processors contains the same five date
149     ! and time valus.
150     !------------------------------------------------------------------------
151           counts(1)      = int_state%nodes
152           counts(2)      = 5
153           arraystr(1)    = 1
154           arraystr(2)    = 1
155           arrayend(1)    = counts(1)
156           arrayend(2)    = counts(2)
157     
158     ! Create the ESMF DistGrid0 using the 1-D default decomposition.
159     !---------------------------------------------------------------
160           CALL ESMF_LogWrite("Create DistGrid0", ESMF_LOG_INFO, rc = rc1)
161     
162           DistGrid0 = ESMF_DistGridCreate(arraystr, arrayend, rc = rc1)
163     
164           IF(ESMF_LogMsgFoundError(rc1, "Create DistGrid0")) THEN
165               rcfinal = ESMF_FAILURE
166               PRINT*, 'Error Happened When Creating DistGrid0, rc = ', rc1
167               rc1     = ESMF_SUCCESS
168           END IF
169     
170     ! create the esmf grid for the date and time information.
171     !--------------------------------------------------------
172           CALL ESMF_LogWrite("create create gfs_phy grid0", ESMF_LOG_INFO, rc = rc1)
173     
174           grid0 = ESMF_GridCreate(name = "gfs_phy grid0", distgrid = DistGrid0, rc = rc1)
175     
176           IF(ESMF_LogMsgFoundError(rc1, "Create Grid0")) THEN
177               rcfinal = ESMF_FAILURE
178               PRINT*, 'Error Happened When Creating Grid0, rc = ', rc1
179               rc1     = ESMF_SUCCESS
180           END IF
181     
182           if(rcfinal == esmf_success) then
183               print*, "pass: gfs_physics_grid_create_gauss."
184           else
185               print*, "fail: gfs_physics_grid_create_gauss."
186           end if
187     
188           rc = rcfinal
189     
190           end subroutine gfs_physics_grid_create_gauss
191     
192     !-----------------------------------------------------------------------
193     !-----------------------------------------------------------------------
194     !BOP
195     !
196     !    !IROUTINE: gfs_physics_grid_create_Gauss3D
197     !
198     !    !INTERFACE:
199     !
200           subroutine gfs_physics_grid_create_Gauss3D(vm, iState, distGrid, rc ) 
201     
202     !     !ARGUMENTS:
203     
204           type(ESMF_VM),                     intent(in)  :: vm   
205           type(gfs_physics_internal_state),  intent(in)  :: iState
206           TYPE(ESMF_DistGrid),               intent(out) :: distGrid
207     
208           integer,                           intent(out)  :: rc
209     
210     !     !DESCRIPTION:
211     !
212     !     This routine creates a 3D Gaussian grid on mid-layer vertical levels.
213     !     The actual distribution has already been determined and such information
214     !     is contained in the internal state *iState*.
215     !
216     !     Consistent with the current design, the actual grid is returned in 
217     !     module-scoped variable *mGrid*.
218     !
219     !     !REVISION HISTORY:
220     !      da Silva  05Feb2009  Based of similar MAPL routine
221     !      Sarah Lu  13Feb2009  Remove MAPL exception handling; specify coord info 
222     !      Sarah Lu  09Oct2009  Port from local branch to the trunk
223     !
224     !EOP
225     !                                      ---
226     
227           integer                 :: I1, IN, J1, JN                              
228           integer                 :: rc1, i, j                                 
229     
230     !     Local space for coordinate information
231     !     --------------------------------------
232           real(kind=kind_rad), pointer :: centerX(:,:)                       
233           real(kind=kind_rad), pointer :: centerY(:,:)                     
234     
235     ! initialize the error signal variables.                            
236     !---------------------------------------
237           rc1     = esmf_success                                               
238     
239           CALL ESMF_LogWrite('CreateGauss3D', ESMF_LOG_INFO, rc = rc1)            
240     
241     !     Create grid with index-space information from internal state
242     !     ------------------------------------------------------------
243           mGrid = ESMF_GridCreateShapeTile ( name='mGrid',        &
244                        countsPerDEDim1=(/iState%lonr/),           &
245                        countsPerDEDim2=iState%lats_nodes_r_fix,   &           
246                        countsPerDEDim3=(/iState%levs/),           &         
247                        coordDep1 = (/1,2/),                       &
248                        coordDep2 = (/1,2/),                       &
249                        coordDep3 = (/3/),                         &
250                        gridEdgeLWidth = (/0,0,0/),                &
251                        gridEdgeUWidth = (/0,0,0/),                &
252                        indexflag = ESMF_INDEX_DELOCAL,            &             
253                        rc = rc1 )                                              
254     
255     !  Add coordinate information
256     !  --------------------------
257        call ESMF_GridAddCoord(mGrid, rc = rc1 )                                  
258     
259     !  Retrieve the coordinates so we can set them
260     !  -------------------------------------------
261        call ESMF_GridGetCoord (mGrid, coordDim=1, localDE=0, &
262                                staggerloc=ESMF_STAGGERLOC_CENTER, &
263                                fptr=centerX, rc = rc1 )                            
264        
265        call ESMF_GridGetCoord (mGrid, coordDim=2, localDE=0, &
266                                staggerloc=ESMF_STAGGERLOC_CENTER, &
267                                fptr=centerY, rc = rc1 )                        
268     
269        call GridGetInterior_ (mGrid,i1,in,j1,jn)
270       
271        do i = 1, iState%lonr                               
272        do j = 1, iState%lats_node_r      
273          centerX(i,j) = 57.29578* iState%xlon(i,j)                                           
274          centerY(i,j) = 57.29578* iState%xlat(i,j)                                      
275        enddo                                                                       
276        enddo                                                                   
277     
278     !  Make sure we've got it right
279     !  ----------------------------
280        call ESMF_GridValidate(mGrid, rc=rc1 )                                    
281     
282        return
283        end subroutine gfs_physics_grid_create_Gauss3D
284     
285     !..................................................................................
286     
287     !  This routine came from MAPL...
288        subroutine GridGetInterior_(GRID,I1,IN,J1,JN)
289         type (ESMF_Grid), intent(IN) :: grid
290         integer, intent(OUT)         :: I1, IN, J1, JN
291     
292     ! local vars
293         integer                               :: status
294         character(len=ESMF_MAXSTR)            :: IAm='MAPL_GridGetInterior'
295     
296         type (ESMF_DistGrid)                  :: distGrid
297         type(ESMF_DELayout)                   :: LAYOUT
298         integer,               allocatable    :: AL(:,:)
299         integer,               allocatable    :: AU(:,:)
300         integer                               :: nDEs
301         integer                               :: deId
302         integer                               :: gridRank
303         integer                               :: deList(1)
304     
305         integer                               :: ierr, rc1                    
306     
307     
308         CALL ESMF_LogWrite("GridGetInterior_", ESMF_LOG_INFO, rc=rc1)            
309     
310         call ESMF_GridGet    (GRID, dimCount=gridRank, distGrid=distGrid, rc=rc1) 
311         call ESMF_DistGridGet(distGRID, delayout=layout, rc=STATUS)
312         call ESMF_DELayoutGet(layout, deCount =nDEs, localDeList=deList, rc=rc1)
313         deId = deList(1)
314     
315         allocate (AL(gridRank,0:nDEs-1), stat = ierr )                           
316         allocate (AU(gridRank,0:nDEs-1), stat = ierr )                            
317     
318         call ESMF_DistGridGet(distgrid, &
319              minIndexPDimPDe=AL, maxIndexPDimPDe=AU, rc=rc1 )                    
320     
321         I1 = AL(1, deId)
322         IN = AU(1, deId)
323         J1 = AL(2, deId)
324         JN = AU(2, deId)
325         deallocate(AU, AL)
326     
327       end subroutine GridGetInterior_
328     
329           end module gfs_physics_grid_create_mod
330