source: XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90 @ 26

Last change on this file since 26 was 26, checked in by ymipsl, 13 years ago

Mise à jour importante :

  • ajout de la grille type LMDZ
  • ajout des context
  • ajout de namelist pour parametrer l'utilisation du server : avec/sans MPI, en utlisant ou pas OASIS
File size: 7.5 KB
Line 
1MODULE mod_grid
2  USE mod_xmlio_parameters
3  USE mod_sorted_list
4  USE mod_domain
5  IMPLICIT NONE
6
7  TYPE, PUBLIC :: grid
8    CHARACTER(len=str_len)      :: id
9    LOGICAL                     :: has_id
10    CHARACTER(len=str_len)      :: name
11    LOGICAL                     :: has_name
12    CHARACTER(len=str_len)      :: description
13    LOGICAL                     :: has_description
14    TYPE(domain),POINTER        :: domain
15    TYPE(vector_domain),POINTER :: subdomain
16    TYPE(sorted_list),POINTER   :: rank_ids
17    INTEGER,POINTER             :: ranks(:)
18    INTEGER                     :: ni
19    INTEGER                     :: nj
20    LOGICAL                     :: has_dimension
21  END TYPE grid
22
23  INCLUDE 'vector_grid_def.inc'
24 
25  TYPE(vector_grid),POINTER,SAVE             :: grid_Ids
26  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
27
28CONTAINS
29  INCLUDE 'vector_grid_contains.inc'
30
31  SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids)
32  IMPLICIT NONE
33    TYPE(vector_grid),POINTER          :: saved_grid_Ids
34    TYPE(sorted_list),POINTER          :: saved_Ids 
35   
36    grid_ids=>saved_grid_ids
37    ids=>saved_ids
38  END SUBROUTINE grid__swap_context
39 
40 
41  SUBROUTINE grid__init
42  IMPLICIT NONE
43   
44    CALL vector_grid__new(grid_Ids)
45    CALL sorted_list__new(Ids)
46   
47  END SUBROUTINE grid__init
48 
49  SUBROUTINE grid__get(Id,Pt_grid)
50  USE string_function
51  IMPLICIT NONE
52    CHARACTER(LEN=*),INTENT(IN)     :: Id
53    TYPE(grid),POINTER              :: Pt_grid
54
55    INTEGER                         :: Pos
56    LOGICAL                         :: success
57   
58    CALL sorted_list__find(Ids,hash(Id),Pos,success)
59    IF (success) THEN
60      Pt_grid=>grid_ids%at(Pos)%Pt
61    ELSE
62      Pt_grid=>NULL()
63    ENDIF
64   
65  END SUBROUTINE grid__get
66 
67  SUBROUTINE grid__new(pt_grid,Id)
68  USE string_function
69  IMPLICIT NONE
70   TYPE(grid), POINTER           :: pt_grid
71   CHARACTER(LEN=*),OPTIONAL     :: Id
72   INTEGER                       :: Pos
73   
74   ALLOCATE(pt_grid%domain)
75   ALLOCATE(pt_grid%subdomain)
76   ALLOCATE(pt_grid%rank_ids)
77   CALL domain__new(pt_grid%domain)
78   CALL vector_domain__new(pt_grid%subdomain)
79   CALL sorted_list__new(pt_grid%rank_ids)
80   
81   pt_grid%has_id          = .FALSE.
82   pt_grid%has_name        = .FALSE.
83   pt_grid%has_description = .FALSE.
84   pt_grid%has_dimension   = .FALSE.
85   
86   IF (PRESENT(Id)) THEN
87     Pt_grid%id=TRIM(ADJUSTL(Id))
88     Pt_grid%has_id=.TRUE.
89     CALL vector_grid__set_new(grid_Ids,Pt_grid,Pos)
90     CALL sorted_list__Add(Ids,hash(id),Pos)
91   ENDIF
92
93 END SUBROUTINE grid__new
94
95  SUBROUTINE grid__set(pt_grid, name, description)
96  IMPLICIT NONE
97    TYPE(grid), POINTER :: pt_grid
98    CHARACTER(len=*)  ,OPTIONAL :: name
99    CHARACTER(len=*)  ,OPTIONAL :: description
100
101    IF (PRESENT(name)) THEN
102        pt_grid%name=TRIM(ADJUSTL(name))
103        pt_grid%has_name = .TRUE.
104    ENDIF
105
106    IF (PRESENT(description)) THEN
107        pt_grid%description=TRIM(ADJUSTL(description))
108        pt_grid%has_description = .TRUE.
109    ENDIF
110
111  END SUBROUTINE grid__set
112
113  SUBROUTINE grid__set_dimension(pt_grid, ni, nj)
114  IMPLICIT NONE
115    TYPE(grid), POINTER   :: pt_grid
116    INTEGER,INTENT(IN)    :: ni
117    INTEGER,INTENT(IN)    :: nj
118   
119    pt_grid%ni=ni
120    pt_grid%nj=nj
121    pt_grid%has_dimension=.TRUE.
122   
123  END SUBROUTINE grid__set_dimension
124   
125
126  SUBROUTINE grid__get_new_subdomain(Pt_grid,rank,pt_domain)
127  IMPLICIT NONE
128    TYPE(grid), POINTER   :: pt_grid
129    INTEGER,INTENT(IN)    :: rank
130    TYPE(domain), POINTER :: Pt_domain
131   
132    INTEGER :: Pos
133   
134    CALL vector_domain__get_new(pt_grid%subdomain,pt_domain,Pos)
135    CALL sorted_list__add(pt_grid%rank_ids,rank,Pos)
136    CALL domain__new(pt_domain)
137   
138  END SUBROUTINE grid__get_new_subdomain   
139
140  SUBROUTINE grid__get_subdomain(Pt_grid,rank,pt_domain)
141  IMPLICIT NONE
142    TYPE(grid), POINTER     :: pt_grid
143    INTEGER,INTENT(IN)      :: rank
144    TYPE(domain), POINTER   :: Pt_domain
145
146    INTEGER    :: rank_id
147    LOGICAL    :: success
148
149    CALL sorted_list__find(pt_grid%rank_ids,rank,rank_id,success)
150    IF (success) THEN
151      pt_domain=>pt_grid%subdomain%at(rank_id)%pt
152    ELSE
153      !! message d'erreur
154   ENDIF
155
156  END SUBROUTINE grid__get_subdomain
157   
158  SUBROUTINE grid__process_domain(Pt_grid)
159  IMPLICIT NONE
160    TYPE(grid), POINTER  :: pt_grid
161    TYPE(domain),POINTER :: subdomain
162   
163    REAL,ALLOCATABLE :: lon(:,:)
164    REAL,ALLOCATABLE :: lat(:,:)
165    INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin
166    INTEGER :: i
167   
168      ALLOCATE(pt_grid%ranks(1:pt_grid%subdomain%size))
169
170      DO i=1,pt_grid%subdomain%size
171        subdomain=>pt_grid%subdomain%at(i)%pt
172        IF (i==1) THEN
173          ib=subdomain%ibegin
174          ie=subdomain%iend   
175          jb=subdomain%jbegin
176          je=subdomain%jend
177        ELSE
178          IF (subdomain%ibegin<ib) ib=subdomain%ibegin
179          IF (subdomain%iend>ie) ie=subdomain%iend
180          IF (subdomain%jbegin<jb) jb=subdomain%jbegin
181          IF (subdomain%jend>je) je=subdomain%jend
182        ENDIF
183        pt_grid%ranks(subdomain%rank)=i
184      ENDDO
185     
186      ni=ie-ib+1
187      nj=je-jb+1
188      ibegin=ib
189      jbegin=jb
190     
191      ALLOCATE(lon(ni,nj))
192      ALLOCATE(lat(ni,nj))
193     
194      DO i=1,pt_grid%subdomain%size
195        subdomain=>pt_grid%subdomain%at(i)%pt
196        ib=subdomain%ibegin-ibegin+1
197        ie=subdomain%iend-ibegin+1   
198        jb=subdomain%jbegin-jbegin+1
199        je=subdomain%jend-jbegin+1
200        lon(ib:ie,jb:je)=subdomain%lon(:,:)
201        lat(ib:ie,jb:je)=subdomain%lat(:,:)
202      ENDDO
203     
204      CALL domain__set(pt_grid%domain,0,ni,nj,ibegin,jbegin,lon,lat)
205
206     
207      DEALLOCATE(lon)
208      DEALLOCATE(lat)
209     
210    END SUBROUTINE grid__process_domain
211     
212           
213       
214  SUBROUTINE grid__print(pt_grid)
215  IMPLICIT NONE
216    TYPE(grid), POINTER  :: pt_grid
217    INTEGER              :: i
218   
219    PRINT *,"---- GRID ----"
220   
221    IF (pt_grid%has_id) THEN
222      PRINT *,"id = ",TRIM(pt_grid%id)
223    ELSE
224      PRINT *,"id undefined"
225    ENDIF
226   
227    IF (pt_grid%has_name) THEN
228      PRINT *,"name = ",TRIM(pt_grid%name)
229    ELSE
230      PRINT *,"name undefined"
231    ENDIF
232   
233    IF (pt_grid%has_description) THEN
234      PRINT *,"description = ",TRIM(pt_grid%description)
235    ELSE
236      PRINT *,"description undefined"
237    ENDIF
238   
239    IF (pt_grid%has_dimension) THEN
240      PRINT *,"Global grid dimension :"
241      PRINT *,"   ni =",pt_grid%ni
242      PRINT *,"   nj =",pt_grid%nj
243    ELSE
244      PRINT *,"Global dimension ni, nj undefined"
245    ENDIF
246   
247    PRINT *,"grid domain :"
248    CALL domain__print(pt_grid%domain)
249   
250    PRINT *,"grid subdomain :",pt_grid%subdomain%size
251   
252    DO i=1,pt_grid%subdomain%size
253      CALL domain__print(pt_grid%subdomain%at(i)%pt)
254    ENDDO
255   
256    PRINT *,"--------------"
257   
258  END SUBROUTINE grid__print
259
260  SUBROUTINE grid__apply_default(pt_grid_default, pt_grid_in, pt_grid_out)
261
262    TYPE(grid), POINTER :: pt_grid_default, pt_grid_in, pt_grid_out
263
264    IF (pt_grid_in%has_name) THEN
265        pt_grid_out%name=pt_grid_in%name
266        pt_grid_out%has_name=.TRUE.
267    ELSE IF ( pt_grid_default%has_name) THEN
268        pt_grid_out%name=pt_grid_default%name
269        pt_grid_out%has_name=.TRUE.
270    ELSE
271        pt_grid_out%has_name=.FALSE.
272    ENDIF
273       
274    IF (pt_grid_in%has_description) THEN
275        pt_grid_out%description=pt_grid_in%description
276        pt_grid_out%has_description=.TRUE.
277    ELSE IF ( pt_grid_default%has_description ) THEN
278        pt_grid_out%description=pt_grid_default%description
279        pt_grid_out%has_description=.TRUE.
280    ELSE
281        pt_grid_out%has_description=.FALSE.
282    ENDIF
283 
284  END SUBROUTINE grid__apply_default
285
286END MODULE mod_grid
Note: See TracBrowser for help on using the repository browser.