source: XMLIO_SERVER/trunk/src/XMLIO/mod_zoom.f90 @ 46

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

Ligne trop longue sous SX (>132 caractÚres)

YM

File size: 5.9 KB
Line 
1MODULE mod_zoom
2  USE mod_xmlio_parameters
3  USE mod_sorted_list
4
5  IMPLICIT NONE
6
7  TYPE,PUBLIC :: zoom
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    INTEGER                     :: ni_glo
15    LOGICAL                     :: has_ni_glo
16    INTEGER                     :: nj_glo
17    LOGICAL                     :: has_nj_glo
18    INTEGER                     :: ibegin_glo
19    LOGICAL                     :: has_ibegin_glo
20    INTEGER                     :: jbegin_glo
21    LOGICAL                     :: has_jbegin_glo
22    INTEGER                     :: ni_loc
23    INTEGER                     :: nj_loc
24    INTEGER                     :: ibegin_loc
25    INTEGER                     :: jbegin_loc
26  END TYPE zoom   
27
28  INCLUDE 'vector_zoom_def.inc'
29
30  TYPE(vector_zoom),POINTER,SAVE             :: zoom_Ids
31  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
32
33  INTERFACE zoom__set_attribut
34    MODULE PROCEDURE zoom__set_attribut_id,zoom__set_attribut_pt
35  END INTERFACE
36 
37CONTAINS
38 
39  INCLUDE 'vector_zoom_contains.inc'
40
41  SUBROUTINE zoom__swap_context(saved_zoom_Ids,saved_Ids)
42  IMPLICIT NONE
43    TYPE(vector_zoom),POINTER          :: saved_zoom_Ids
44    TYPE(sorted_list),POINTER          :: saved_Ids 
45   
46    zoom_ids=>saved_zoom_ids
47    ids=>saved_ids
48  END SUBROUTINE zoom__swap_context
49
50
51  SUBROUTINE zoom__init
52  IMPLICIT NONE
53
54    CALL vector_zoom__new(zoom_Ids)
55    CALL sorted_list__new(Ids)
56   
57  END SUBROUTINE zoom__init
58 
59
60  SUBROUTINE zoom__new(pt_zoom,Id)
61  USE string_function
62  IMPLICIT NONE
63    TYPE(zoom),POINTER :: pt_zoom
64    CHARACTER(LEN=*),OPTIONAL     :: Id
65    INTEGER   :: Pos 
66     
67    pt_zoom%has_id=.FALSE.
68    pt_zoom%has_name=.FALSE.
69    pt_zoom%has_description=.FALSE.
70    pt_zoom%has_ni_glo=.FALSE.
71    pt_zoom%has_nj_glo=.FALSE.
72    pt_zoom%has_ibegin_glo=.FALSE.
73    pt_zoom%has_jbegin_glo=.FALSE.
74     
75    IF (PRESENT(Id)) THEN
76      Pt_zoom%id=TRIM(ADJUSTL(Id))
77      Pt_zoom%has_id=.TRUE.
78     CALL vector_zoom__set_new(zoom_Ids,Pt_zoom,Pos)
79     CALL sorted_list__Add(Ids,hash(id),Pos)
80    ENDIF
81   
82  END SUBROUTINE zoom__new
83   
84  SUBROUTINE zoom__set(pt_zoom,name,description,ni_glo,nj_glo,ibegin_glo,jbegin_glo)
85  IMPLICIT NONE
86    TYPE(zoom),POINTER                   :: pt_zoom
87    CHARACTER(len=*),OPTIONAL            :: name
88    CHARACTER(len=*),OPTIONAL            :: description
89    INTEGER,OPTIONAL                     :: ni_glo
90    INTEGER,OPTIONAL                     :: nj_glo
91    INTEGER,OPTIONAL                     :: ibegin_glo
92    INTEGER,OPTIONAL                     :: jbegin_glo
93   
94    IF (PRESENT(name)) THEN
95      pt_zoom%name=TRIM(ADJUSTL(name))
96      pt_zoom%has_name=.TRUE.
97    ENDIF
98   
99    IF (PRESENT(description)) THEN
100      pt_zoom%name=TRIM(ADJUSTL(description))
101      pt_zoom%has_description=.TRUE.
102    ENDIF
103   
104    IF (PRESENT(ni_glo)) THEN
105      pt_zoom%ni_glo=ni_glo
106      pt_zoom%has_ni_glo=.TRUE.
107    ENDIF
108
109    IF (PRESENT(nj_glo)) THEN
110      pt_zoom%nj_glo=nj_glo
111      pt_zoom%has_nj_glo=.TRUE.
112    ENDIF
113
114    IF (PRESENT(ibegin_glo)) THEN
115      pt_zoom%ibegin_glo=ibegin_glo
116      pt_zoom%has_ibegin_glo=.TRUE.
117    ENDIF
118   
119    IF (PRESENT(jbegin_glo)) THEN
120      pt_zoom%jbegin_glo=jbegin_glo
121      pt_zoom%has_ibegin_glo=.TRUE.
122    ENDIF
123               
124   END SUBROUTINE zoom__set   
125
126  SUBROUTINE zoom__set_attribut_id(id,attrib,ok)
127  USE mod_attribut
128  USE error_msg
129  IMPLICIT NONE
130    CHARACTER(LEN=*),INTENT(IN)   :: id
131    TYPE(attribut),INTENT(IN)     :: attrib
132    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
133   
134    TYPE(zoom),POINTER              :: Pt_zoom
135    INTEGER                         :: Pos
136    LOGICAL                         :: success
137   
138    CALL sorted_list__find(Ids,hash(Id),Pos,success)
139    IF (success) THEN
140      Pt_zoom=>zoom_ids%at(Pos)%Pt
141      CALL zoom__set_attribut_pt(Pt_zoom,attrib)
142      IF (PRESENT(OK)) OK=.TRUE.
143    ELSE
144      IF (.NOT.PRESENT(OK)) THEN
145        WRITE(message,*) 'zoom id :',id,'is undefined'
146        CALL error('mod_zoom::zoom__set_attribut')
147      ELSE
148        OK=.FALSE.
149      ENDIF
150    ENDIF 
151 
152  END SUBROUTINE zoom__set_attribut_id
153     
154  SUBROUTINE zoom__set_attribut_pt(Pt_zoom,attrib)
155  USE mod_attribut
156  USE mod_zoom_attribut
157  USE error_msg
158  IMPLICIT NONE
159    TYPE(zoom),POINTER        :: Pt_zoom
160    TYPE(attribut),INTENT(IN) :: attrib
161   
162    SELECT CASE(attrib%name)
163      CASE (zoom__name)
164        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,name=attrib%string0_ptr) ; RETURN
165      CASE (zoom__description)
166        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,description=attrib%string0_ptr) ; RETURN
167      CASE (zoom__ni)
168        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ni_glo=attrib%integer0_ptr) ; RETURN
169      CASE (zoom__nj)
170        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,nj_glo=attrib%integer0_ptr) ; RETURN
171      CASE (zoom__ibegin)
172        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ibegin_glo=attrib%integer0_ptr) ; RETURN
173      CASE (zoom__jbegin)
174        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,jbegin_glo=attrib%integer0_ptr) ; RETURN
175     END SELECT
176
177     WRITE(message,*) 'zoom attribut ',attrib%name,' : type :',attrib%type,   &
178                      ' : Attribute type is incompatible with the provided value'
179     CALL error('mod_zoom::zoom__set_attribut')
180   
181  END SUBROUTINE zoom__set_attribut_pt
182
183  SUBROUTINE zoom__get(Id,pt_zoom)
184  USE string_function
185  IMPLICIT NONE
186    CHARACTER(LEN=*),INTENT(IN)     :: Id
187    TYPE(zoom),POINTER              :: Pt_zoom
188
189    INTEGER                         :: Pos
190    LOGICAL                         :: success
191   
192    CALL sorted_list__find(Ids,hash(Id),Pos,success)
193    IF (success) THEN
194      Pt_zoom=>zoom_ids%at(Pos)%Pt
195    ELSE
196      Pt_zoom=>NULL()
197    ENDIF
198   
199  END SUBROUTINE zoom__get
200
201END MODULE mod_zoom
Note: See TracBrowser for help on using the repository browser.