File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\gfs_dynamics_add_get_state_mod.f

1     !BOP
2     !
3     ! !MODULE: GFS_ESMFStateAddGetMod --- a class attaching a F90 array to an 
4     !                                     ESMF state, getting F90 pointer and 
5     !                                     providing related services
6     !
7     ! !INTERFACE:
8     !
9      MODULE gfs_dynamics_add_get_state_mod
10     
11     !USES:
12       USE ESMF_Mod, ONLY :                          &
13           ESMF_Grid,                                &
14           ESMF_GridGet,                             &
15           ESMF_DistGrid,                            &
16           ESMF_State,                               &
17           ESMF_StateAdd,                            &
18           ESMF_StateGet,                            &
19           ESMF_SUCCESS,                             &
20           ESMF_Array,                               &
21           ESMF_ArrayCreate,                         &
22           ESMF_ArrayGet,                            &
23           ESMF_ArrayDestroy,                        &
24           ESMF_CopyFlag
25     
26      IMPLICIT NONE
27      PRIVATE
28       
29     !
30     ! !PUBLIC TYPES:.
31     !
32     ! !PUBLIC MEMBER FUNCTIONS:
33     !
34       Public AddF90ArrayToState  ! Adds new allocated F90 array to an ESMF State
35       Public GetF90ArrayFromState
36     !
37     ! !DESCRIPTION:
38     
39     ! !REVISION HISTORY:
40     !
41     ! 20oct2003 Zaslavsky   Initial code.
42     ! 07Dec2003 Cruz        Added real(4) methods for 2D, 3D
43     ! March 26, 2004, Weiyu Yang, modified for the ESMF 1.0.6 version.
44     ! September 3, 2004, Weiyu Yang, modified for the NCEP GFS model.
45     ! July 2005,            Weiyu Yang added real(4) for 1D and changed real to real(8).
46     ! May 2006, Weiyu Yang modIFied the code for the ESMF 3.0.0 library
47     !                      and adding the releasing memory option after
48     !                      getting a fortran array from the state.
49     ! June 2006, Weiyu Yang, modified the code to reduce the maximum memory requirement.
50     ! April 2007 , S. Moorthi Added Weiyu's upgrades to use ESMF 3.0.0 library
51     ! September 2007       Weiyu Yang updated to use the ESMF 3.0.3 library.
52     ! May 2008             Weiyu Yang updated to use the ESMF 3.1.0r library
53     !
54     !EOP
55     !-------------------------------------------------------------------------
56     
57     !BOC
58     
59       Interface AddF90ArrayToState
60          module procedure AddF90IntegerArrayToState1D
61          module procedure AddF90IntegerArrayToState2D
62          module procedure AddF90Real8ArrayToState1D
63          module procedure AddF90Real4ArrayToState1D
64          module procedure AddF90Real8ArrayToState2D
65          module procedure AddF90Real4ArrayToState2D
66          module procedure AddF90Real8ArrayToState3D
67          module procedure AddF90Real4ArrayToState3D
68          module procedure AddF90Real8ArrayToState4D
69          module procedure AddF90Real4ArrayToState4D
70       end interface AddF90ArrayToState
71       
72       Interface GetF90ArrayFromState
73          module  procedure GetF90IntegerArrayFromState1D
74          module  procedure GetF90IntegerArrayFromState2D
75          module  procedure GetF90Real8ArrayFromState1D
76          module  procedure GetF90Real4ArrayFromState1D
77          module  procedure GetF90Real8ArrayFromState2D
78          module  procedure GetF90Real4ArrayFromState2D
79          module  procedure GetF90Real8ArrayFromState3D
80          module  procedure GetF90Real4ArrayFromState3D
81          module  procedure GetF90Real8ArrayFromState4D
82          module  procedure GetF90Real4ArrayFromState4D
83       end interface GetF90ArrayFromState
84     
85     !EOC
86     
87     !---------------------------------------------------------------------------
88     
89     CONTAINS
90     
91     
92     !BOP
93     !!
94     ! !IROUTINE: Adds an allocated 1D integer array to ESMF State (through an 
95     !            ESMF array and related ESMF DistGrid in the ESMF grid).
96     !
97     ! !INTERFACE:
98     !
99      SUBROUTINE AddF90IntegerArrayToState1D(state, grid, name, F90Array, copyflag, rc)
100     
101     !
102     ! !USES:
103     !
104      IMPLICIT none
105     
106     ! INPUT PARAMETERS:
107     
108      INTEGER, DIMENSION(:), POINTER       :: F90array
109      TYPE(ESMF_Grid),       INTENT(inout) :: grid
110      CHARACTER(LEN = *),    INTENT(in)    :: name
111     
112      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
113     
114     ! INPUT/OUTPUT PARAMETERS:
115     
116      TYPE(ESMF_State),      INTENT(inout) :: state
117         
118     !
119     ! !OUTPUT PARAMETERS:
120     !
121     
122      INTEGER, OPTIONAL,     INTENT(out)   :: rc ! 0 sucess;  
123                                                 ! 1 F90array is not associated; 
124                                                 ! 2 failure to get the ESMF DistGrid.
125                                                 ! 3 failure to create an ESMF array.
126                                                 ! 4 failure to add the ESMF array to the ESMF state.
127     !
128     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
129     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
130     !               an adds it to a given ESMF state.
131     !
132     ! !REVISION HISTORY:
133     !
134     ! 20oct2003  Zaslavsky   Initial code.
135     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
136     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
137     !
138     !
139     !EOP
140     !-------------------------------------------------------------------------
141      TYPE(ESMF_DistGrid)                  :: distgrid
142      TYPE(ESMF_Array)                     :: ESMFArray
143      INTEGER                              :: status
144     
145      status = ESMF_SUCCESS
146      IF(ASSOCIATED(F90Array)) THEN
147           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
148     
149           IF(status /= ESMF_SUCCESS) THEN
150              IF(PRESENT(rc)) rc = 2
151              RETURN
152           END IF
153     
154           IF(PRESENT(copyflag)) THEN
155               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
156                   copyflag = copyflag, name = name, rc = status)
157           ELSE
158               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
159                   name = name, rc = status)
160           END IF
161     
162           IF(status /= ESMF_SUCCESS) THEN
163              IF(PRESENT(rc)) rc = 3
164              return
165           END IF
166     
167           CALL ESMF_StateAdd(state, ESMFArray, rc=status)
168     
169           IF(status /= ESMF_SUCCESS ) THEn
170                IF(PRESENT(rc)) rc = 4
171                RETURN
172           END IF
173      ELSE
174           IF(PRESENT(rc)) rc = 1
175               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
176           RETURN
177      END IF
178        
179      IF(PRESENT(rc)) rc = status
180     
181      END SUBROUTINE AddF90IntegerArrayToState1D
182     
183     
184     
185     
186     
187     !BOP
188     !!
189     ! !IROUTINE: Adds an allocated 2D integer array to ESMF State (through an 
190     !            ESMF array and related ESMF DistGrid in the ESMF grid).
191     !
192     ! !INTERFACE:
193     !
194      SUBROUTINE AddF90IntegerArrayToState2D(state, grid, name, F90Array, copyflag, rc)
195     
196     !
197     ! !USES:
198     !
199      IMPLICIT none
200     
201     ! INPUT PARAMETERS:
202     
203      INTEGER, DIMENSION(:, :), POINTER       :: F90array
204      TYPE(ESMF_Grid),          INTENT(inout) :: grid
205      CHARACTER(LEN = *),       INTENT(in)    :: name
206     
207      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
208     
209     ! INPUT/OUTPUT PARAMETERS:
210     
211      TYPE(ESMF_State),         INTENT(inout) :: state
212         
213     !
214     ! !OUTPUT PARAMETERS:
215     !
216     
217      INTEGER, OPTIONAL,        INTENT(out)   :: rc ! 0 sucess;  
218                                                    ! 1 F90array is not associated; 
219                                                    ! 2 failure to get the ESMF DistGrid.
220                                                    ! 3 failure to create an ESMF array.
221                                                    ! 4 failure to add the ESMF array to the ESMF state.
222     !
223     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
224     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
225     !               and adds it to a given ESMF state.
226     !
227     ! !REVISION HISTORY:
228     !
229     ! 20oct2003  Zaslavsky   Initial code.
230     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
231     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
232     !
233     !
234     !EOP
235     !-------------------------------------------------------------------------
236      TYPE(ESMF_DistGrid)                     :: distgrid
237      TYPE(ESMF_Array)                        :: ESMFArray
238      INTEGER                                 :: status
239     
240      status = ESMF_SUCCESS
241      IF(ASSOCIATED(F90Array)) THEN
242           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
243     
244           IF(status /= ESMF_SUCCESS) THEN
245              IF(PRESENT(rc)) rc = 2
246              RETURN
247           END IF
248     
249           IF(PRESENT(copyflag)) THEN
250               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
251                   copyflag = copyflag, name = name, rc = status)
252           ELSE
253               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
254                   name = name, rc = status)
255           END IF
256     
257           IF(status /= ESMF_SUCCESS) THEN
258              IF(PRESENT(rc)) rc = 3
259              return
260           END IF
261     
262           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
263     
264           IF(status /= ESMF_SUCCESS ) THEn
265                IF(PRESENT(rc)) rc = 4
266                RETURN
267           END IF
268      ELSE
269           IF(PRESENT(rc)) rc = 1
270               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
271           RETURN
272      END IF
273        
274      IF(PRESENT(rc)) rc = status
275     
276      END SUBROUTINE AddF90IntegerArrayToState2D
277     
278     
279     
280     
281     
282     !BOP
283     !!
284     ! !IROUTINE: Adds an allocated 1D real 8 array to ESMF State (through an 
285     !            ESMF array and related ESMF DistGrid in the ESMF grid).
286     !
287     ! !INTERFACE:
288     !
289      SUBROUTINE AddF90Real8ArrayToState1D(state, grid, name, F90Array, copyflag, rc)
290     
291     !
292     ! !USES:
293     !
294      IMPLICIT none
295     
296     ! INPUT PARAMETERS:
297     
298      REAL(8), DIMENSION(:), POINTER       :: F90array
299      TYPE(ESMF_Grid),       INTENT(inout) :: grid
300      CHARACTER(LEN = *),    INTENT(in)    :: name
301     
302      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
303     
304     ! INPUT/OUTPUT PARAMETERS:
305     
306      TYPE(ESMF_State),      INTENT(inout) :: state
307         
308     !
309     ! !OUTPUT PARAMETERS:
310     !
311     
312      INTEGER, OPTIONAL,     INTENT(out)   :: rc ! 0 sucess;  
313                                                 ! 1 F90array is not associated; 
314                                                 ! 2 failure to get the ESMF DistGrid.
315                                                 ! 3 failure to create an ESMF array.
316                                                 ! 4 failure to add the ESMF array to the ESMF state.
317     !
318     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
319     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
320     !               and adds it to a given ESMF state.
321     !
322     ! !REVISION HISTORY:
323     !
324     ! 20oct2003  Zaslavsky   Initial code.
325     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
326     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
327     !
328     !
329     !EOP
330     !-------------------------------------------------------------------------
331      TYPE(ESMF_DistGrid)                  :: distgrid
332      TYPE(ESMF_Array)                     :: ESMFArray
333      INTEGER                              :: status
334     
335      status = ESMF_SUCCESS
336      IF(ASSOCIATED(F90Array)) THEN
337           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
338     
339           IF(status /= ESMF_SUCCESS) THEN
340              IF(PRESENT(rc)) rc = 2
341              RETURN
342           END IF
343     
344           IF(PRESENT(copyflag)) THEN
345               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
346                   copyflag = copyflag, name = name, rc = status)
347           ELSE
348               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
349                   name = name, rc = status)
350           END IF
351     
352           IF(status /= ESMF_SUCCESS) THEN
353              IF(PRESENT(rc)) rc = 3
354              return
355           END IF
356     
357           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
358     
359           IF(status /= ESMF_SUCCESS ) THEn
360                IF(PRESENT(rc)) rc = 4
361                RETURN
362           END IF
363      ELSE
364           IF(PRESENT(rc)) rc = 1
365               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
366           RETURN
367      END IF
368        
369      IF(PRESENT(rc)) rc = status
370     
371      END SUBROUTINE AddF90Real8ArrayToState1D
372     
373     
374     
375     
376     
377     !BOP
378     !!
379     ! !IROUTINE: Adds an allocated 1D real 4 array to ESMF State (through an
380     !            ESMF array and related ESMF DistGrid in the ESMF grid).
381     !
382     ! !INTERFACE:
383     !
384      SUBROUTINE AddF90Real4ArrayToState1D(state, grid, name, F90Array, copyflag, rc)
385     
386     !
387     ! !USES:
388     !
389      IMPLICIT none
390     
391     ! INPUT PARAMETERS:
392     
393      REAL(4), DIMENSION(:), POINTER       :: F90array
394      TYPE(ESMF_Grid),       INTENT(inout) :: grid
395      CHARACTER(LEN = *),    INTENT(in)    :: name
396     
397      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
398     
399     ! INPUT/OUTPUT PARAMETERS:
400     
401      TYPE(ESMF_State),      INTENT(inout) :: state
402     
403     !
404     ! !OUTPUT PARAMETERS:
405     !
406     
407      INTEGER, OPTIONAL,     INTENT(out)   :: rc ! 0 sucess;
408                                                 ! 1 F90array is not associated;
409                                                 ! 2 failure to get the ESMF DistGrid.
410                                                 ! 3 failure to create an ESMF array.
411                                                 ! 4 failure to add the ESMF array to the ESMF state.
412     !
413     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
414     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
415     !               and adds it to a given ESMF state.
416     !
417     ! !REVISION HISTORY:
418     !
419     ! 20oct2003  Zaslavsky   Initial code.
420     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
421     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
422     !
423     !
424     !EOP
425     !-------------------------------------------------------------------------
426      TYPE(ESMF_DistGrid)                  :: distgrid
427      TYPE(ESMF_Array)                     :: ESMFArray
428      INTEGER                              :: status
429     
430      status = ESMF_SUCCESS
431      IF(ASSOCIATED(F90Array)) THEN
432           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
433     
434           IF(status /= ESMF_SUCCESS) THEN
435              IF(PRESENT(rc)) rc = 2
436              RETURN
437           END IF
438     
439           IF(PRESENT(copyflag)) THEN
440               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
441                   copyflag = copyflag, name = name, rc = status)
442           ELSE
443               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
444                   name = name, rc = status)
445           END IF
446     
447           IF(status /= ESMF_SUCCESS) THEN
448              IF(PRESENT(rc)) rc = 3
449              return
450           END IF
451     
452           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
453     
454           IF(status /= ESMF_SUCCESS ) THEn
455                IF(PRESENT(rc)) rc = 4
456                RETURN
457           END IF
458      ELSE
459           IF(PRESENT(rc)) rc = 1
460               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
461           RETURN
462      END IF
463     
464      IF(PRESENT(rc)) rc = status
465     
466      END SUBROUTINE AddF90Real4ArrayToState1D
467     
468     
469     
470     
471     
472     !BOP
473     !!
474     ! !IROUTINE: Adds an allocated 2D real 8 array to ESMF State (through an 
475     !            ESMF array and related ESMF DistGrid in the ESMF grid).
476     !
477     ! !INTERFACE:
478     !
479      SUBROUTINE AddF90Real8ArrayToState2D(state, grid, name, F90Array, copyflag, rc)
480     
481     !
482     ! !USES:
483     !
484      IMPLICIT none
485     
486     ! INPUT PARAMETERS:
487     
488      REAL(8), DIMENSION(:, :), POINTER       :: F90array
489      TYPE(ESMF_Grid),          INTENT(inout) :: grid
490      CHARACTER(LEN = *),       INTENT(in)    :: name
491     
492      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
493     
494     ! INPUT/OUTPUT PARAMETERS:
495     
496      TYPE(ESMF_State),         INTENT(inout) :: state
497         
498     !
499     ! !OUTPUT PARAMETERS:
500     !
501     
502      INTEGER, OPTIONAL,        INTENT(out)   :: rc ! 0 sucess;  
503                                                    ! 1 F90array is not associated; 
504                                                    ! 2 failure to get the ESMF DistGrid.
505                                                    ! 3 failure to create an ESMF array.
506                                                    ! 4 failure to add the ESMF array to the ESMF state.
507     !
508     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
509     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
510     !               and adds it to a given ESMF state.
511     !
512     ! !REVISION HISTORY:
513     !
514     ! 20oct2003  Zaslavsky   Initial code.
515     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
516     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
517     !
518     !
519     !EOP
520     !-------------------------------------------------------------------------
521      TYPE(ESMF_DistGrid)                     :: distgrid
522      TYPE(ESMF_Array)                        :: ESMFArray
523      INTEGER                                 :: status
524     
525      status = ESMF_SUCCESS
526      IF(ASSOCIATED(F90Array)) THEN
527           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
528     
529           IF(status /= ESMF_SUCCESS) THEN
530              IF(PRESENT(rc)) rc = 2
531              RETURN
532           END IF
533     
534           IF(PRESENT(copyflag)) THEN
535               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
536                   copyflag = copyflag, name = name, rc = status)
537           ELSE
538               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
539                   name = name, rc = status)
540           END IF
541     
542           IF(status /= ESMF_SUCCESS) THEN
543              IF(PRESENT(rc)) rc = 3
544              return
545           END IF
546     
547           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
548     
549           IF(status /= ESMF_SUCCESS ) THEn
550                IF(PRESENT(rc)) rc = 4
551                RETURN
552           END IF
553      ELSE
554           IF(PRESENT(rc)) rc = 1
555               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
556           RETURN
557      END IF
558        
559      IF(PRESENT(rc)) rc = status
560     
561      END SUBROUTINE AddF90Real8ArrayToState2D
562     
563     
564     
565     
566     
567     !BOP
568     !!
569     ! !IROUTINE: Adds an allocated 2D real 4 array to ESMF State (through an 
570     !            ESMF array and related ESMF DistGrid in the ESMF grid).
571     !
572     ! !INTERFACE:
573     !
574      SUBROUTINE AddF90Real4ArrayToState2D(state, grid, name, F90Array, copyflag, rc)
575     
576     !
577     ! !USES:
578     !
579      IMPLICIT none
580     
581     ! INPUT PARAMETERS:
582     
583      REAL(4), DIMENSION(:, :), POINTER       :: F90array
584      TYPE(ESMF_Grid),          INTENT(inout) :: grid
585      CHARACTER(LEN = *),       INTENT(in)    :: name
586     
587      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL :: copyflag
588     
589     ! INPUT/OUTPUT PARAMETERS:
590     
591      TYPE(ESMF_State),         INTENT(inout) :: state
592         
593     !
594     ! !OUTPUT PARAMETERS:
595     !
596     
597      INTEGER, OPTIONAL,        INTENT(out)   :: rc ! 0 sucess;  
598                                                    ! 1 F90array is not associated; 
599                                                    ! 2 failure to get the ESMF DistGrid.
600                                                    ! 3 failure to create an ESMF array.
601                                                    ! 4 failure to add the ESMF array to the ESMF state.
602     !
603     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
604     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
605     !               and adds it to a given ESMF state.
606     !
607     ! !REVISION HISTORY:
608     !
609     ! 20oct2003  Zaslavsky   Initial code.
610     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
611     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
612     !
613     !
614     !EOP
615     !-------------------------------------------------------------------------
616      TYPE(ESMF_DistGrid)                     :: distgrid
617      TYPE(ESMF_Array)                        :: ESMFArray
618      INTEGER                                 :: status
619     
620      status = ESMF_SUCCESS
621      IF(ASSOCIATED(F90Array)) THEN
622           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
623     
624           IF(status /= ESMF_SUCCESS) THEN
625              IF(PRESENT(rc)) rc = 2
626              RETURN
627           END IF
628     
629           IF(PRESENT(copyflag)) THEN
630               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
631                   copyflag = copyflag, name = name, rc = status)
632           ELSE
633               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
634                   name = name, rc = status)
635           END IF
636     
637           IF(status /= ESMF_SUCCESS) THEN
638              IF(PRESENT(rc)) rc = 3
639              return
640           END IF
641     
642           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
643     
644           IF(status /= ESMF_SUCCESS ) THEn
645                IF(PRESENT(rc)) rc = 4
646                RETURN
647           END IF
648      ELSE
649           IF(PRESENT(rc)) rc = 1
650               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
651           RETURN
652      END IF
653        
654      IF(PRESENT(rc)) rc = status
655     
656      END SUBROUTINE AddF90Real4ArrayToState2D
657     
658     
659     
660     
661     
662     !BOP
663     !!
664     ! !IROUTINE: Adds an allocated 3D real 8 array to ESMF State (through an 
665     !            ESMF array and related ESMF DistGrid in the ESMF grid).
666     !
667     ! !INTERFACE:
668     !
669      SUBROUTINE AddF90Real8ArrayToState3D(state, grid, name, F90Array, copyflag, rc)
670     
671     !
672     ! !USES:
673     !
674      IMPLICIT none
675     
676     ! INPUT PARAMETERS:
677     
678      REAL(8), DIMENSION(:, :, :), POINTER       :: F90array
679      TYPE(ESMF_Grid),             INTENT(inout) :: grid
680      CHARACTER(LEN = *),          INTENT(in)    :: name
681     
682      TYPE(ESMF_CopyFlag),  INTENT(in), OPTIONAL :: copyflag
683     
684     ! INPUT/OUTPUT PARAMETERS:
685     
686      TYPE(ESMF_State),            INTENT(inout) :: state
687         
688     !
689     ! !OUTPUT PARAMETERS:
690     !
691     
692      INTEGER, OPTIONAL,           INTENT(out)   :: rc ! 0 sucess;  
693                                                       ! 1 F90array is not associated; 
694                                                       ! 2 failure to get the ESMF DistGrid.
695                                                       ! 3 failure to create an ESMF array.
696                                                       ! 4 failure to add the ESMF array to the ESMF state.
697     !
698     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
699     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
700     !               and adds it to a given ESMF state.
701     !
702     ! !REVISION HISTORY:
703     !
704     ! 20oct2003  Zaslavsky   Initial code.
705     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
706     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
707     !
708     !
709     !EOP
710     !-------------------------------------------------------------------------
711      TYPE(ESMF_DistGrid)                        :: distgrid
712      TYPE(ESMF_Array)                           :: ESMFArray
713      INTEGER                                    :: status
714     
715      status = ESMF_SUCCESS
716      IF(ASSOCIATED(F90Array)) THEN
717           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
718     
719           IF(status /= ESMF_SUCCESS) THEN
720              IF(PRESENT(rc)) rc = 2
721              RETURN
722           END IF
723     
724           IF(PRESENT(copyflag)) THEN
725               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
726                   copyflag = copyflag, name = name, rc = status)
727           ELSE
728               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
729                   name = name, rc = status)
730           END IF
731     
732           IF(status /= ESMF_SUCCESS) THEN
733              IF(PRESENT(rc)) rc = 3
734              return
735           END IF
736     
737           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
738     
739           IF(status /= ESMF_SUCCESS ) THEn
740                IF(PRESENT(rc)) rc = 4
741                RETURN
742           END IF
743      ELSE
744           IF(PRESENT(rc)) rc = 1
745               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
746           RETURN
747      END IF
748        
749      IF(PRESENT(rc)) rc = status
750     
751      END SUBROUTINE AddF90Real8ArrayToState3D
752     
753     
754     
755     
756     
757     !BOP
758     !!
759     ! !IROUTINE: Adds an allocated 3D real 4 array to ESMF State (through an 
760     !            ESMF array and related ESMF DistGrid in the ESMF grid).
761     !
762     ! !INTERFACE:
763     !
764      SUBROUTINE AddF90Real4ArrayToState3D(state, grid, name, F90Array, copyflag, rc)
765     
766     !
767     ! !USES:
768     !
769      IMPLICIT none
770     
771     ! INPUT PARAMETERS:
772     
773      REAL(4), DIMENSION(:, :, :), POINTER       :: F90array
774      TYPE(ESMF_Grid),             INTENT(inout) :: grid
775      CHARACTER(LEN = *),          INTENT(in)    :: name
776     
777      TYPE(ESMF_CopyFlag),  INTENT(in), OPTIONAL :: copyflag
778     
779     ! INPUT/OUTPUT PARAMETERS:
780     
781      TYPE(ESMF_State),            INTENT(inout) :: state
782         
783     !
784     ! !OUTPUT PARAMETERS:
785     !
786     
787      INTEGER, OPTIONAL,           INTENT(out)   :: rc ! 0 sucess;  
788                                                       ! 1 F90array is not associated; 
789                                                       ! 2 failure to get the ESMF DistGrid.
790                                                       ! 3 failure to create an ESMF array.
791                                                       ! 4 failure to add the ESMF array to the ESMF state.
792     !
793     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
794     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
795     !               and adds it to a given ESMF state.
796     !
797     ! !REVISION HISTORY:
798     !
799     ! 20oct2003  Zaslavsky   Initial code.
800     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
801     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
802     !
803     !
804     !EOP
805     !-------------------------------------------------------------------------
806      TYPE(ESMF_DistGrid)                        :: distgrid
807      TYPE(ESMF_Array)                           :: ESMFArray
808      INTEGER                                    :: status
809     
810      status = ESMF_SUCCESS
811      IF(ASSOCIATED(F90Array)) THEN
812           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
813     
814           IF(status /= ESMF_SUCCESS) THEN
815              IF(PRESENT(rc)) rc = 2
816              RETURN
817           END IF
818     
819           IF(PRESENT(copyflag)) THEN
820               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
821                   copyflag = copyflag, name = name, rc = status)
822           ELSE
823               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
824                   name = name, rc = status)
825           END IF
826     
827           IF(status /= ESMF_SUCCESS) THEN
828              IF(PRESENT(rc)) rc = 3
829              return
830           END IF
831     
832           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
833     
834           IF(status /= ESMF_SUCCESS ) THEn
835                IF(PRESENT(rc)) rc = 4
836                RETURN
837           END IF
838      ELSE
839           IF(PRESENT(rc)) rc = 1
840               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
841           RETURN
842      END IF
843        
844      IF(PRESENT(rc)) rc = status
845     
846      END SUBROUTINE AddF90Real4ArrayToState3D
847     
848     
849     
850     
851     
852     !BOP
853     !!
854     ! !IROUTINE: Adds an allocated 4D real 8 array to ESMF State (through an 
855     !            ESMF array and related ESMF DistGrid in the ESMF grid).
856     !
857     ! !INTERFACE:
858     !
859      SUBROUTINE AddF90Real8ArrayToState4D(state, grid, name, F90Array, copyflag, rc)
860     
861     !
862     ! !USES:
863     !
864      IMPLICIT none
865     
866     ! INPUT PARAMETERS:
867     
868      REAL(8), DIMENSION(:, :, :, :), POINTER       :: F90array
869      TYPE(ESMF_Grid),                INTENT(inout) :: grid
870      CHARACTER(LEN = *),             INTENT(in)    :: name
871     
872      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL   :: copyflag
873     
874     ! INPUT/OUTPUT PARAMETERS:
875     
876      TYPE(ESMF_State),               INTENT(inout) :: state
877         
878     !
879     ! !OUTPUT PARAMETERS:
880     !
881     
882      INTEGER, OPTIONAL,              INTENT(out)   :: rc ! 0 sucess;  
883                                                          ! 1 F90array is not associated; 
884                                                          ! 2 failure to get the ESMF DistGrid.
885                                                          ! 3 failure to create an ESMF array.
886                                                          ! 4 failure to add the ESMF array to the ESMF state.
887     !
888     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
889     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
890     !               and adds it to a given ESMF state.
891     !
892     ! !REVISION HISTORY:
893     !
894     ! 20oct2003  Zaslavsky   Initial code.
895     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
896     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
897     !
898     !
899     !EOP
900     !-------------------------------------------------------------------------
901      TYPE(ESMF_DistGrid)                           :: distgrid
902      TYPE(ESMF_Array)                              :: ESMFArray
903      INTEGER                                       :: status
904     
905      status = ESMF_SUCCESS
906      IF(ASSOCIATED(F90Array)) THEN
907           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
908     
909           IF(status /= ESMF_SUCCESS) THEN
910              IF(PRESENT(rc)) rc = 2
911              RETURN
912           END IF
913     
914           IF(PRESENT(copyflag)) THEN
915               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
916                   copyflag = copyflag, name = name, rc = status)
917           ELSE
918               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
919                   name = name, rc = status)
920           END IF
921     
922           IF(status /= ESMF_SUCCESS) THEN
923              IF(PRESENT(rc)) rc = 3
924              return
925           END IF
926     
927           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
928     
929           IF(status /= ESMF_SUCCESS ) THEn
930                IF(PRESENT(rc)) rc = 4
931                RETURN
932           END IF
933      ELSE
934           IF(PRESENT(rc)) rc = 1
935               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
936           RETURN
937      END IF
938        
939      IF(PRESENT(rc)) rc = status
940     
941      END SUBROUTINE AddF90Real8ArrayToState4D
942     
943     
944     
945     
946     
947     !BOP
948     !!
949     ! !IROUTINE: Adds an allocated 4D real 4 array to ESMF State (through an 
950     !            ESMF array and related ESMF DistGrid in the ESMF grid).
951     !
952     ! !INTERFACE:
953     !
954      SUBROUTINE AddF90Real4ArrayToState4D(state, grid, name, F90Array, copyflag, rc)
955     
956     !
957     ! !USES:
958     !
959      IMPLICIT none
960     
961     ! INPUT PARAMETERS:
962     
963      REAL(4), DIMENSION(:, :, :, :), POINTER       :: F90array
964      TYPE(ESMF_Grid),                INTENT(inout) :: grid
965      CHARACTER(LEN = *),             INTENT(in)    :: name
966     
967      TYPE(ESMF_CopyFlag),   INTENT(in), OPTIONAL   :: copyflag
968     
969     ! INPUT/OUTPUT PARAMETERS:
970     
971      TYPE(ESMF_State),               INTENT(inout) :: state
972         
973     !
974     ! !OUTPUT PARAMETERS:
975     !
976     
977      INTEGER, OPTIONAL,              INTENT(out)   :: rc ! 0 sucess;  
978                                                          ! 1 F90array is not associated; 
979                                                          ! 2 failure to get the ESMF DistGrid.
980                                                          ! 3 failure to create an ESMF array.
981                                                          ! 4 failure to add the ESMF array to the ESMF state.
982     !
983     ! !DESCRIPTION: This subroutine takes an allocated F90 array, creates
984     !               an ESMF Array, associated wirh the ESMF DistGrid in the given grid,
985     !               and adds it to a given ESMF state.
986     !
987     ! !REVISION HISTORY:
988     !
989     ! 20oct2003  Zaslavsky   Initial code.
990     ! 10/01/2007 Weiyu Yang  Rewritting for the ESFM 3.0.3 version.
991     ! May 2008   Weiyu Yang updated to use the ESMF 3.1.0r library.
992     !
993     !
994     !EOP
995     !-------------------------------------------------------------------------
996      TYPE(ESMF_DistGrid)                           :: distgrid
997      TYPE(ESMF_Array)                              :: ESMFArray
998      INTEGER                                       :: status
999     
1000      status = ESMF_SUCCESS
1001      IF(ASSOCIATED(F90Array)) THEN
1002           CALL ESMF_GridGet(grid, DistGrid = distgrid, rc = status)
1003     
1004           IF(status /= ESMF_SUCCESS) THEN
1005              IF(PRESENT(rc)) rc = 2
1006              RETURN
1007           END IF
1008     
1009           IF(PRESENT(copyflag)) THEN
1010               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
1011                   copyflag = copyflag, name = name, rc = status)
1012           ELSE
1013               ESMFArray = ESMF_ArrayCreate(F90Array, distgrid, &
1014                   name = name, rc = status)
1015           END IF
1016     
1017           IF(status /= ESMF_SUCCESS) THEN
1018              IF(PRESENT(rc)) rc = 3
1019              return
1020           END IF
1021     
1022           CALL ESMF_StateAdd(state, ESMFArray, rc = status)
1023     
1024           IF(status /= ESMF_SUCCESS ) THEn
1025                IF(PRESENT(rc)) rc = 4
1026                RETURN
1027           END IF
1028      ELSE
1029           IF(PRESENT(rc)) rc = 1
1030               PRINT *, ' AddF90...F90 array is NOT ASSOCIATED '
1031           RETURN
1032      END IF
1033        
1034      IF(PRESENT(rc)) rc = status
1035     
1036      END SUBROUTINE AddF90Real4ArrayToState4D
1037     
1038     
1039     
1040     
1041     
1042     !BOP
1043     !!
1044     ! !IROUTINE: Gets a F90 pointer to a F90 1D integer array 
1045     !            from the ESMF array which is in the ESMF State.
1046     !
1047     ! !INTERFACE:
1048     
1049      SUBROUTINE GetF90IntegerArrayFromState1D(state, name, F90Array, &
1050          localPE, nestedStateName, DestroyArray, rc)
1051     
1052     !
1053     ! !USES:
1054     !
1055      IMPLICIT NONE
1056     
1057     ! INPUT PARAMETERS:
1058     
1059      TYPE(ESMF_State)                          :: state  
1060                                                      ! ESMF state to extract F90 array from
1061      CHARACTER(LEN = *)                        :: name   
1062                                                      ! name of the ESMF array to extract 
1063                                                      ! the fortran array from
1064     
1065      INTEGER,            INTENT(in)            :: localPE 
1066                                                      ! PE id of the local PE.
1067     
1068      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1069                                                      ! Name of the nested ESMF state which contains
1070                                                      ! the ESMF array.
1071     
1072      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1073                                                      ! If 1, THEN destroy the ESMF array.
1074     
1075     ! OUTPUT PARAMETERS:
1076     
1077      INTEGER, DIMENSION(:),           POINTER  :: F90Array
1078      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1079                                                      ! 1 failure to get ESMF array
1080                                                      !   from the ESMF state; 
1081                                                      ! 2 failure to get a F90 POINTER from
1082                                                      !   the ESMF array.
1083                                                      ! 3 failure to destroy the ESMF array.
1084     
1085     !
1086     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1087     !               given ESMF state assuming that the name of corresponding 
1088     !               ESMF array is provided.
1089     
1090     ! !REVISION HISTORY:
1091     !
1092     ! 20oct2003        Zaslavsky  Initial code.
1093     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1094     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1095     !                             the destroy field option
1096     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1097     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1098     !
1099     !EOP
1100     !-------------------------------------------------------------------------    
1101      TYPE(ESMF_Array)                          :: ESMFArray
1102      INTEGER                                   :: status
1103     
1104      status = ESMF_SUCCESS
1105     
1106      IF(PRESENT(nestedStateName)) THEN
1107          CALL ESMF_StateGet(state, name, ESMFArray,           &
1108              nestedStateName = nestedStateName, rc = status)
1109      ELSE
1110          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1111      END IF
1112     
1113      IF(status /= ESMF_SUCCESS) THEN
1114          IF(PRESENT(rc)) rc = 1
1115          RETURN
1116      END IF
1117     
1118      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1119     
1120      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1121     
1122      IF(status /= ESMF_SUCCESS ) THEN
1123          IF(PRESENT(rc)) rc = 2
1124          RETURN
1125      END IF
1126     
1127      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1128          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1129     
1130          IF(status /= ESMF_SUCCESS) THEN
1131              IF(PRESENT(rc)) rc = 3
1132              RETURN
1133          END IF
1134      END IF
1135     
1136      IF(PRESENT(rc)) rc = status
1137     
1138      END SUBROUTINE GetF90IntegerArrayFromState1D
1139     
1140     
1141     
1142     
1143     
1144     !BOP
1145     !!
1146     ! !IROUTINE: Gets a F90 pointer to a F90 2D integer array 
1147     !            from the ESMF array which is in the ESMF State.
1148     !
1149     ! !INTERFACE:
1150     
1151      SUBROUTINE GetF90IntegerArrayFromState2D(state, name, F90Array, &
1152          localPE, nestedStateName, DestroyArray, rc)
1153     
1154     !
1155     ! !USES:
1156     !
1157      IMPLICIT NONE
1158     
1159     ! INPUT PARAMETERS:
1160     
1161      TYPE(ESMF_State)                          :: state  
1162                                                      ! ESMF state to extract F90 array from
1163      CHARACTER(LEN = *)                        :: name   
1164                                                      ! name of the ESMF array to extract 
1165                                                      ! the fortran array from
1166     
1167      INTEGER,            INTENT(in)            :: localPE 
1168                                                      ! PE id of the local PE.
1169     
1170      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1171                                                      ! Name of the nested ESMF state which contains
1172                                                      ! the ESMF array.
1173     
1174      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1175                                                      ! If 1, THEN destroy the ESMF array.
1176     
1177     ! OUTPUT PARAMETERS:
1178     
1179      INTEGER, DIMENSION(:, :),        POINTER  :: F90Array
1180      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1181                                                      ! 1 failure to get ESMF array
1182                                                      !   from the ESMF state; 
1183                                                      ! 2 failure to get a F90 POINTER from
1184                                                      !   the ESMF array.
1185                                                      ! 3 failure to destroy the ESMF array.
1186     
1187     !
1188     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1189     !               given ESMF state assuming that the name of corresponding 
1190     !               ESMF array is provided.
1191     
1192     ! !REVISION HISTORY:
1193     !
1194     ! 20oct2003        Zaslavsky  Initial code.
1195     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1196     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1197     !                             the destroy field option
1198     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1199     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1200     !
1201     !EOP
1202     !-------------------------------------------------------------------------    
1203      TYPE(ESMF_Array)                          :: ESMFArray
1204      INTEGER                                   :: status
1205     
1206      status = ESMF_SUCCESS
1207     
1208      IF(PRESENT(nestedStateName)) THEN
1209          CALL ESMF_StateGet(state, name, ESMFArray,           &
1210              nestedStateName = nestedStateName, rc = status)
1211      ELSE
1212          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1213      END IF
1214     
1215      IF(status /= ESMF_SUCCESS) THEN
1216          IF(PRESENT(rc)) rc = 1
1217          RETURN
1218      END IF
1219     
1220      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1221     
1222      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1223     
1224      IF(status /= ESMF_SUCCESS ) THEN
1225          IF(PRESENT(rc)) rc = 2
1226          RETURN
1227      END IF
1228     
1229      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1230          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1231     
1232          IF(status /= ESMF_SUCCESS) THEN
1233              IF(PRESENT(rc)) rc = 3
1234              RETURN
1235          END IF
1236      END IF
1237     
1238      IF(PRESENT(rc)) rc = status
1239     
1240      END SUBROUTINE GetF90IntegerArrayFromState2D
1241     
1242     
1243     
1244     
1245     
1246     !BOP
1247     !!
1248     ! !IROUTINE: Gets a F90 pointer to a F90 1D real 8 array 
1249     !            from the ESMF array which is in the ESMF State.
1250     !
1251     ! !INTERFACE:
1252     
1253      SUBROUTINE GetF90Real8ArrayFromState1D(state, name, F90Array, &
1254          localPE, nestedStateName, DestroyArray, rc)
1255     
1256     !
1257     ! !USES:
1258     !
1259      IMPLICIT NONE
1260     
1261     ! INPUT PARAMETERS:
1262     
1263      TYPE(ESMF_State)                          :: state  
1264                                                      ! ESMF state to extract F90 array from
1265      CHARACTER(LEN = *)                        :: name   
1266                                                      ! name of the ESMF array to extract 
1267                                                      ! the fortran array from
1268     
1269      INTEGER,            INTENT(in)            :: localPE 
1270                                                      ! PE id of the local PE.
1271     
1272      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1273                                                      ! Name of the nested ESMF state which contains
1274                                                      ! the ESMF array.
1275     
1276      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1277                                                      ! If 1, THEN destroy the ESMF array.
1278     
1279     ! OUTPUT PARAMETERS:
1280     
1281      REAL(8), DIMENSION(:),           POINTER  :: F90Array
1282      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1283                                                      ! 1 failure to get ESMF array
1284                                                      !   from the ESMF state; 
1285                                                      ! 2 failure to get a F90 POINTER from
1286                                                      !   the ESMF array.
1287                                                      ! 3 failure to destroy the ESMF array.
1288     
1289     !
1290     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1291     !               given ESMF state assuming that the name of corresponding 
1292     !               ESMF array is provided.
1293     
1294     ! !REVISION HISTORY:
1295     !
1296     ! 20oct2003        Zaslavsky  Initial code.
1297     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1298     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1299     !                             the destroy field option
1300     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1301     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1302     !
1303     !EOP
1304     !-------------------------------------------------------------------------    
1305      TYPE(ESMF_Array)                          :: ESMFArray
1306      INTEGER                                   :: status
1307     
1308      status = ESMF_SUCCESS
1309     
1310      IF(PRESENT(nestedStateName)) THEN
1311          CALL ESMF_StateGet(state, name, ESMFArray,           &
1312              nestedStateName = nestedStateName, rc = status)
1313      ELSE
1314          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1315      END IF
1316     
1317      IF(status /= ESMF_SUCCESS) THEN
1318          IF(PRESENT(rc)) rc = 1
1319          RETURN
1320      END IF
1321     
1322      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1323     
1324      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1325     
1326      IF(status /= ESMF_SUCCESS ) THEN
1327          IF(PRESENT(rc)) rc = 2
1328          RETURN
1329      END IF
1330     
1331      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1332          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1333     
1334          IF(status /= ESMF_SUCCESS) THEN
1335              IF(PRESENT(rc)) rc = 3
1336              RETURN
1337          END IF
1338      END IF
1339     
1340      IF(PRESENT(rc)) rc = status
1341     
1342      END SUBROUTINE GetF90Real8ArrayFromState1D
1343     
1344     
1345     
1346     
1347     
1348     !BOP
1349     !!
1350     ! !IROUTINE: Gets a F90 pointer to a F90 1D real 4 array 
1351     !            from the ESMF array which is in the ESMF State.
1352     !
1353     ! !INTERFACE:
1354     
1355      SUBROUTINE GetF90Real4ArrayFromState1D(state, name, F90Array, &
1356          localPE, nestedStateName, DestroyArray, rc)
1357     
1358     !
1359     ! !USES:
1360     !
1361      IMPLICIT NONE
1362     
1363     ! INPUT PARAMETERS:
1364     
1365      TYPE(ESMF_State)                          :: state  
1366                                                      ! ESMF state to extract F90 array from
1367      CHARACTER(LEN = *)                        :: name   
1368                                                      ! name of the ESMF array to extract 
1369                                                      ! the fortran array from
1370     
1371      INTEGER,            INTENT(in)            :: localPE 
1372                                                      ! PE id of the local PE.
1373     
1374      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1375                                                      ! Name of the nested ESMF state which contains
1376                                                      ! the ESMF array.
1377     
1378      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1379                                                      ! If 1, THEN destroy the ESMF array.
1380     
1381     ! OUTPUT PARAMETERS:
1382     
1383      REAL(4), DIMENSION(:),           POINTER  :: F90Array
1384      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1385                                                      ! 1 failure to get ESMF array
1386                                                      !   from the ESMF state; 
1387                                                      ! 2 failure to get a F90 POINTER from
1388                                                      !   the ESMF array.
1389                                                      ! 3 failure to destroy the ESMF array.
1390     
1391     !
1392     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1393     !               given ESMF state assuming that the name of corresponding 
1394     !               ESMF array is provided.
1395     
1396     ! !REVISION HISTORY:
1397     !
1398     ! 20oct2003        Zaslavsky  Initial code.
1399     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1400     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1401     !                             the destroy field option
1402     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1403     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1404     !
1405     !EOP
1406     !-------------------------------------------------------------------------    
1407      TYPE(ESMF_Array)                          :: ESMFArray
1408      INTEGER                                   :: status
1409     
1410      status = ESMF_SUCCESS
1411     
1412      IF(PRESENT(nestedStateName)) THEN
1413          CALL ESMF_StateGet(state, name, ESMFArray,           &
1414              nestedStateName = nestedStateName, rc = status)
1415      ELSE
1416          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1417      END IF
1418     
1419      IF(status /= ESMF_SUCCESS) THEN
1420          IF(PRESENT(rc)) rc = 1
1421          RETURN
1422      END IF
1423     
1424      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1425     
1426      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1427     
1428      IF(status /= ESMF_SUCCESS ) THEN
1429          IF(PRESENT(rc)) rc = 2
1430          RETURN
1431      END IF
1432     
1433      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1434          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1435     
1436          IF(status /= ESMF_SUCCESS) THEN
1437              IF(PRESENT(rc)) rc = 3
1438              RETURN
1439          END IF
1440      END IF
1441     
1442      IF(PRESENT(rc)) rc = status
1443     
1444      END SUBROUTINE GetF90Real4ArrayFromState1D
1445     
1446     
1447     
1448     
1449     
1450     !BOP
1451     !!
1452     ! !IROUTINE: Gets a F90 pointer to a F90 2D real 8 array 
1453     !            from the ESMF array which is in the ESMF State.
1454     !
1455     ! !INTERFACE:
1456     
1457      SUBROUTINE GetF90Real8ArrayFromState2D(state, name, F90Array, &
1458          localPE, nestedStateName, DestroyArray, rc)
1459     
1460     !
1461     ! !USES:
1462     !
1463      IMPLICIT NONE
1464     
1465     ! INPUT PARAMETERS:
1466     
1467      TYPE(ESMF_State)                          :: state  
1468                                                      ! ESMF state to extract F90 array from
1469      CHARACTER(LEN = *)                        :: name   
1470                                                      ! name of the ESMF array to extract 
1471                                                      ! the fortran array from
1472     
1473      INTEGER,            INTENT(in)            :: localPE 
1474                                                      ! PE id of the local PE.
1475     
1476      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1477                                                      ! Name of the nested ESMF state which contains
1478                                                      ! the ESMF array.
1479     
1480      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1481                                                      ! If 1, THEN destroy the ESMF array.
1482     
1483     ! OUTPUT PARAMETERS:
1484     
1485      REAL(8), DIMENSION(:, :),        POINTER  :: F90Array
1486      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1487                                                      ! 1 failure to get ESMF array
1488                                                      !   from the ESMF state; 
1489                                                      ! 2 failure to get a F90 POINTER from
1490                                                      !   the ESMF array.
1491                                                      ! 3 failure to destroy the ESMF array.
1492     
1493     !
1494     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1495     !               given ESMF state assuming that the name of corresponding 
1496     !               ESMF array is provided.
1497     
1498     ! !REVISION HISTORY:
1499     !
1500     ! 20oct2003        Zaslavsky  Initial code.
1501     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1502     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1503     !                             the destroy field option
1504     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1505     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1506     !
1507     !EOP
1508     !-------------------------------------------------------------------------    
1509      TYPE(ESMF_Array)                          :: ESMFArray
1510      INTEGER                                   :: status
1511     
1512      status = ESMF_SUCCESS
1513     
1514      IF(PRESENT(nestedStateName)) THEN
1515          CALL ESMF_StateGet(state, name, ESMFArray,           &
1516              nestedStateName = nestedStateName, rc = status)
1517      ELSE
1518          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1519      END IF
1520     
1521      IF(status /= ESMF_SUCCESS) THEN
1522          IF(PRESENT(rc)) rc = 1
1523          RETURN
1524      END IF
1525     
1526      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1527     
1528      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1529     
1530      IF(status /= ESMF_SUCCESS ) THEN
1531          IF(PRESENT(rc)) rc = 2
1532          RETURN
1533      END IF
1534     
1535      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1536          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1537     
1538          IF(status /= ESMF_SUCCESS) THEN
1539              IF(PRESENT(rc)) rc = 3
1540              RETURN
1541          END IF
1542      END IF
1543     
1544      IF(PRESENT(rc)) rc = status
1545     
1546      END SUBROUTINE GetF90Real8ArrayFromState2D
1547     
1548     
1549     
1550     
1551     
1552     !BOP
1553     !!
1554     ! !IROUTINE: Gets a F90 pointer to a F90 2D real 4 array 
1555     !            from the ESMF array which is in the ESMF State.
1556     !
1557     ! !INTERFACE:
1558     
1559      SUBROUTINE GetF90Real4ArrayFromState2D(state, name, F90Array, &
1560          localPE, nestedStateName, DestroyArray, rc)
1561     
1562     !
1563     ! !USES:
1564     !
1565      IMPLICIT NONE
1566     
1567     ! INPUT PARAMETERS:
1568     
1569      TYPE(ESMF_State)                          :: state  
1570                                                      ! ESMF state to extract F90 array from
1571      CHARACTER(LEN = *)                        :: name   
1572                                                      ! name of the ESMF array to extract 
1573                                                      ! the fortran array from
1574     
1575      INTEGER,            INTENT(in)            :: localPE 
1576                                                      ! PE id of the local PE.
1577     
1578      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1579                                                      ! Name of the nested ESMF state which contains
1580                                                      ! the ESMF array.
1581     
1582      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1583                                                      ! If 1, THEN destroy the ESMF array.
1584     
1585     ! OUTPUT PARAMETERS:
1586     
1587      REAL(4), DIMENSION(:, :),        POINTER  :: F90Array
1588      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1589                                                      ! 1 failure to get ESMF array
1590                                                      !   from the ESMF state; 
1591                                                      ! 2 failure to get a F90 POINTER from
1592                                                      !   the ESMF array.
1593                                                      ! 3 failure to destroy the ESMF array.
1594     
1595     !
1596     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1597     !               given ESMF state assuming that the name of corresponding 
1598     !               ESMF array is provided.
1599     
1600     ! !REVISION HISTORY:
1601     !
1602     ! 20oct2003        Zaslavsky  Initial code.
1603     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1604     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1605     !                             the destroy field option
1606     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1607     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1608     !
1609     !EOP
1610     !-------------------------------------------------------------------------    
1611      TYPE(ESMF_Array)                          :: ESMFArray
1612      INTEGER                                   :: status
1613     
1614      status = ESMF_SUCCESS
1615     
1616      IF(PRESENT(nestedStateName)) THEN
1617          CALL ESMF_StateGet(state, name, ESMFArray,           &
1618              nestedStateName = nestedStateName, rc = status)
1619      ELSE
1620          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1621      END IF
1622     
1623      IF(status /= ESMF_SUCCESS) THEN
1624          IF(PRESENT(rc)) rc = 1
1625          RETURN
1626      END IF
1627     
1628      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1629     
1630      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1631     
1632      IF(status /= ESMF_SUCCESS ) THEN
1633          IF(PRESENT(rc)) rc = 2
1634          RETURN
1635      END IF
1636     
1637      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1638          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1639     
1640          IF(status /= ESMF_SUCCESS) THEN
1641              IF(PRESENT(rc)) rc = 3
1642              RETURN
1643          END IF
1644      END IF
1645     
1646      IF(PRESENT(rc)) rc = status
1647     
1648      END SUBROUTINE GetF90Real4ArrayFromState2D
1649     
1650     
1651     
1652     
1653     
1654     !BOP
1655     !!
1656     ! !IROUTINE: Gets a F90 pointer to a F90 3D real 8 array 
1657     !            from the ESMF array which is in the ESMF State.
1658     !
1659     ! !INTERFACE:
1660     
1661      SUBROUTINE GetF90Real8ArrayFromState3D(state, name, F90Array, &
1662          localPE, nestedStateName, DestroyArray, rc)
1663     
1664     !
1665     ! !USES:
1666     !
1667      IMPLICIT NONE
1668     
1669     ! INPUT PARAMETERS:
1670     
1671      TYPE(ESMF_State)                          :: state  
1672                                                      ! ESMF state to extract F90 array from
1673      CHARACTER(LEN = *)                        :: name   
1674                                                      ! name of the ESMF array to extract 
1675                                                      ! the fortran array from
1676     
1677      INTEGER,            INTENT(in)            :: localPE 
1678                                                      ! PE id of the local PE.
1679     
1680      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1681                                                      ! Name of the nested ESMF state which contains
1682                                                      ! the ESMF array.
1683     
1684      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1685                                                      ! If 1, THEN destroy the ESMF array.
1686     
1687     ! OUTPUT PARAMETERS:
1688     
1689      REAL(8), DIMENSION(:, :, :),     POINTER  :: F90Array
1690      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1691                                                      ! 1 failure to get ESMF array
1692                                                      !   from the ESMF state; 
1693                                                      ! 2 failure to get a F90 POINTER from
1694                                                      !   the ESMF array.
1695                                                      ! 3 failure to destroy the ESMF array.
1696     
1697     !
1698     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1699     !               given ESMF state assuming that the name of corresponding 
1700     !               ESMF array is provided.
1701     
1702     ! !REVISION HISTORY:
1703     !
1704     ! 20oct2003        Zaslavsky  Initial code.
1705     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1706     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1707     !                             the destroy field option
1708     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1709     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1710     !
1711     !EOP
1712     !-------------------------------------------------------------------------    
1713      TYPE(ESMF_Array)                          :: ESMFArray
1714      INTEGER                                   :: status
1715     
1716      status = ESMF_SUCCESS
1717     
1718      IF(PRESENT(nestedStateName)) THEN
1719          CALL ESMF_StateGet(state, name, ESMFArray,           &
1720              nestedStateName = nestedStateName, rc = status)
1721      ELSE
1722          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1723      END IF
1724     
1725      IF(status /= ESMF_SUCCESS) THEN
1726          IF(PRESENT(rc)) rc = 1
1727          RETURN
1728      END IF
1729     
1730      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1731     
1732      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1733     
1734      IF(status /= ESMF_SUCCESS ) THEN
1735          IF(PRESENT(rc)) rc = 2
1736          RETURN
1737      END IF
1738     
1739      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1740          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1741     
1742          IF(status /= ESMF_SUCCESS) THEN
1743              IF(PRESENT(rc)) rc = 3
1744              RETURN
1745          END IF
1746      END IF
1747     
1748      IF(PRESENT(rc)) rc = status
1749     
1750      END SUBROUTINE GetF90Real8ArrayFromState3D
1751     
1752     
1753     
1754     
1755     
1756     !BOP
1757     !!
1758     ! !IROUTINE: Gets a F90 pointer to a F90 3D real 4 array 
1759     !            from the ESMF array which is in the ESMF State.
1760     !
1761     ! !INTERFACE:
1762     
1763      SUBROUTINE GetF90Real4ArrayFromState3D(state, name, F90Array, &
1764          localPE, nestedStateName, DestroyArray, rc)
1765     
1766     !
1767     ! !USES:
1768     !
1769      IMPLICIT NONE
1770     
1771     ! INPUT PARAMETERS:
1772     
1773      TYPE(ESMF_State)                          :: state  
1774                                                      ! ESMF state to extract F90 array from
1775      CHARACTER(LEN = *)                        :: name   
1776                                                      ! name of the ESMF array to extract 
1777                                                      ! the fortran array from
1778     
1779      INTEGER,            INTENT(in)            :: localPE 
1780                                                      ! PE id of the local PE.
1781     
1782      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1783                                                      ! Name of the nested ESMF state which contains
1784                                                      ! the ESMF array.
1785     
1786      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1787                                                      ! If 1, THEN destroy the ESMF array.
1788     
1789     ! OUTPUT PARAMETERS:
1790     
1791      REAL(4), DIMENSION(:, :, :),     POINTER  :: F90Array
1792      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1793                                                      ! 1 failure to get ESMF array
1794                                                      !   from the ESMF state; 
1795                                                      ! 2 failure to get a F90 POINTER from
1796                                                      !   the ESMF array.
1797                                                      ! 3 failure to destroy the ESMF array.
1798     
1799     !
1800     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1801     !               given ESMF state assuming that the name of corresponding 
1802     !               ESMF array is provided.
1803     
1804     ! !REVISION HISTORY:
1805     !
1806     ! 20oct2003        Zaslavsky  Initial code.
1807     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1808     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1809     !                             the destroy field option
1810     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1811     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1812     !
1813     !EOP
1814     !-------------------------------------------------------------------------    
1815      TYPE(ESMF_Array)                          :: ESMFArray
1816      INTEGER                                   :: status
1817     
1818      status = ESMF_SUCCESS
1819     
1820      IF(PRESENT(nestedStateName)) THEN
1821          CALL ESMF_StateGet(state, name, ESMFArray,           &
1822              nestedStateName = nestedStateName, rc = status)
1823      ELSE
1824          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1825      END IF
1826     
1827      IF(status /= ESMF_SUCCESS) THEN
1828          IF(PRESENT(rc)) rc = 1
1829          RETURN
1830      END IF
1831     
1832      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1833     
1834      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1835     
1836      IF(status /= ESMF_SUCCESS ) THEN
1837          IF(PRESENT(rc)) rc = 2
1838          RETURN
1839      END IF
1840     
1841      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1842          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1843     
1844          IF(status /= ESMF_SUCCESS) THEN
1845              IF(PRESENT(rc)) rc = 3
1846              RETURN
1847          END IF
1848      END IF
1849     
1850      IF(PRESENT(rc)) rc = status
1851     
1852      END SUBROUTINE GetF90Real4ArrayFromState3D
1853     
1854     
1855     
1856     
1857     
1858     !BOP
1859     !!
1860     ! !IROUTINE: Gets a F90 pointer to a F90 4D real 8 array 
1861     !            from the ESMF array which is in the ESMF State.
1862     !
1863     ! !INTERFACE:
1864     
1865      SUBROUTINE GetF90Real8ArrayFromState4D(state, name, F90Array, &
1866          localPE, nestedStateName, DestroyArray, rc)
1867     
1868     !
1869     ! !USES:
1870     !
1871      IMPLICIT NONE
1872     
1873     ! INPUT PARAMETERS:
1874     
1875      TYPE(ESMF_State)                          :: state  
1876                                                      ! ESMF state to extract F90 array from
1877      CHARACTER(LEN = *)                        :: name   
1878                                                      ! name of the ESMF array to extract 
1879                                                      ! the fortran array from
1880     
1881      INTEGER,            INTENT(in)            :: localPE 
1882                                                      ! PE id of the local PE.
1883     
1884      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1885                                                      ! Name of the nested ESMF state which contains
1886                                                      ! the ESMF array.
1887     
1888      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1889                                                      ! If 1, THEN destroy the ESMF array.
1890     
1891     ! OUTPUT PARAMETERS:
1892     
1893      REAL(8), DIMENSION(:, :, :, :),  POINTER  :: F90Array
1894      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1895                                                      ! 1 failure to get ESMF array
1896                                                      !   from the ESMF state; 
1897                                                      ! 2 failure to get a F90 POINTER from
1898                                                      !   the ESMF array.
1899                                                      ! 3 failure to destroy the ESMF array.
1900     
1901     !
1902     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
1903     !               given ESMF state assuming that the name of corresponding 
1904     !               ESMF array is provided.
1905     
1906     ! !REVISION HISTORY:
1907     !
1908     ! 20oct2003        Zaslavsky  Initial code.
1909     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
1910     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
1911     !                             the destroy field option
1912     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
1913     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
1914     !
1915     !EOP
1916     !-------------------------------------------------------------------------    
1917      TYPE(ESMF_Array)                          :: ESMFArray
1918      INTEGER                                   :: status
1919     
1920      status = ESMF_SUCCESS
1921     
1922      IF(PRESENT(nestedStateName)) THEN
1923          CALL ESMF_StateGet(state, name, ESMFArray,           &
1924              nestedStateName = nestedStateName, rc = status)
1925      ELSE
1926          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
1927      END IF
1928     
1929      IF(status /= ESMF_SUCCESS) THEN
1930          IF(PRESENT(rc)) rc = 1
1931          RETURN
1932      END IF
1933     
1934      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
1935     
1936      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
1937     
1938      IF(status /= ESMF_SUCCESS ) THEN
1939          IF(PRESENT(rc)) rc = 2
1940          RETURN
1941      END IF
1942     
1943      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
1944          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
1945     
1946          IF(status /= ESMF_SUCCESS) THEN
1947              IF(PRESENT(rc)) rc = 3
1948              RETURN
1949          END IF
1950      END IF
1951     
1952      IF(PRESENT(rc)) rc = status
1953     
1954      END SUBROUTINE GetF90Real8ArrayFromState4D
1955     
1956     
1957     
1958     
1959     
1960     !BOP
1961     !!
1962     ! !IROUTINE: Gets a F90 pointer to a F90 4D real 4 array 
1963     !            from the ESMF array which is in the ESMF State.
1964     !
1965     ! !INTERFACE:
1966     
1967      SUBROUTINE GetF90Real4ArrayFromState4D(state, name, F90Array, &
1968          localPE, nestedStateName, DestroyArray, rc)
1969     
1970     !
1971     ! !USES:
1972     !
1973      IMPLICIT NONE
1974     
1975     ! INPUT PARAMETERS:
1976     
1977      TYPE(ESMF_State)                          :: state  
1978                                                      ! ESMF state to extract F90 array from
1979      CHARACTER(LEN = *)                        :: name   
1980                                                      ! name of the ESMF array to extract 
1981                                                      ! the fortran array from
1982     
1983      INTEGER,            INTENT(in)            :: localPE 
1984                                                      ! PE id of the local PE.
1985     
1986      CHARACTER(LEN = *), INTENT(in), OPTIONAL  :: nestedStateName   
1987                                                      ! Name of the nested ESMF state which contains
1988                                                      ! the ESMF array.
1989     
1990      INTEGER,            INTENT(in), OPTIONAL  :: DestroyArray  
1991                                                      ! If 1, THEN destroy the ESMF array.
1992     
1993     ! OUTPUT PARAMETERS:
1994     
1995      REAL(4), DIMENSION(:, :, :, :),  POINTER  :: F90Array
1996      INTEGER,            INTENT(out), OPTIONAL :: rc ! 0 sucess;  
1997                                                      ! 1 failure to get ESMF array
1998                                                      !   from the ESMF state; 
1999                                                      ! 2 failure to get a F90 POINTER from
2000                                                      !   the ESMF array.
2001                                                      ! 3 failure to destroy the ESMF array.
2002     
2003     !
2004     ! !DESCRIPTION: This subroutine gets a F90 pointer to F90 array from 
2005     !               given ESMF state assuming that the name of corresponding 
2006     !               ESMF array is provided.
2007     
2008     ! !REVISION HISTORY:
2009     !
2010     ! 20oct2003        Zaslavsky  Initial code.
2011     ! March 26, 2004,  Weiyu Yang modified for the ESMF 1.0.6 version.
2012     ! April 05, 2007,  S. Moorthi added WeiYu's modifications for ESMF 3.0.0 (adding
2013     !                             the destroy field option
2014     ! Ootober 01, 2007 Weiyu Yang Rewritting for the ESFM 3.0.3 version.
2015     ! May 2008         Weiyu Yang updated to use the ESMF 3.1.0r library.
2016     !
2017     !EOP
2018     !-------------------------------------------------------------------------    
2019      TYPE(ESMF_Array)                          :: ESMFArray
2020      INTEGER                                   :: status
2021     
2022      status = ESMF_SUCCESS
2023     
2024      IF(PRESENT(nestedStateName)) THEN
2025          CALL ESMF_StateGet(state, name, ESMFArray,           &
2026              nestedStateName = nestedStateName, rc = status)
2027      ELSE
2028          CALL ESMF_StateGet(state, name, ESMFArray, rc = status)
2029      END IF
2030     
2031      IF(status /= ESMF_SUCCESS) THEN
2032          IF(PRESENT(rc)) rc = 1
2033          RETURN
2034      END IF
2035     
2036      IF(ASSOCIATED(F90Array)) NULLIFY(F90Array)
2037     
2038      CALL ESMF_ArrayGet(ESMFArray, localPE, F90Array, rc = status)
2039     
2040      IF(status /= ESMF_SUCCESS ) THEN
2041          IF(PRESENT(rc)) rc = 2
2042          RETURN
2043      END IF
2044     
2045      IF(PRESENT(DestroyArray) .AND. DestroyArray == 1) THEN
2046          CALL ESMF_ArrayDestroy(ESMFArray, rc = status)
2047     
2048          IF(status /= ESMF_SUCCESS) THEN
2049              IF(PRESENT(rc)) rc = 3
2050              RETURN
2051          END IF
2052      END IF
2053     
2054      IF(PRESENT(rc)) rc = status
2055     
2056      END SUBROUTINE GetF90Real4ArrayFromState4D
2057     
2058      END MODULE gfs_dynamics_add_get_state_mod
2059