New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
multi.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/multi.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator
File size: 11.1 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: multi
6!
7!
8! DESCRIPTION:
9!> This module manage multi file structure
10!
11!> @details
12!> define type TMULTI:<br/>
13!> TYPE(TMULTI) :: tl_multi<br/>
14!>
15!> @author
16!>  J.Paul
17! REVISION HISTORY:
18!> @date 2013 - Initial Version
19!
20!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
21!----------------------------------------------------------------------
22MODULE multi
23   USE kind                            ! F90 kind parameter
24   USE logger                             ! log file manager
25   USE fct                             ! basic useful function
26   USE dim                             ! dimension manager
27   USE att                             ! attribute manager
28   USE var                             ! variable manager
29   USE file                            ! file manager
30   IMPLICIT NONE
31   PRIVATE
32   ! NOTE_avoid_public_variables_if_possible
33
34   ! type and variable
35   PUBLIC :: TMULTI       ! multi file structure
36
37   ! function and subroutine
38   PUBLIC :: ASSIGNMENT(=)     !< copy multi structure
39   PUBLIC :: multi_init        !< initialise mpp structure
40   PUBLIC :: multi_clean       !< clean mpp strcuture
41   PUBLIC :: multi_print       !< print information about mpp structure
42
43   PUBLIC :: multi_add_file    !< add one proc strucutre in mpp structure
44!   PUBLIC :: multi_del_file    !< delete one proc strucutre in mpp structure
45!   PUBLIC :: multi_move_file   !< overwrite proc strucutre in mpp structure
46
47   !> @struct TMULTI
48   TYPE TMULTI
49      ! general
50      INTEGER(i4)                         :: i_nfile = 0         !< number of files
51      INTEGER(i4)                         :: i_nvar  = 0         !< total number of variables
52      TYPE(TFILE), DIMENSION(:), POINTER  :: t_file => NULL()    !< files composing multi
53   END TYPE
54
55   INTERFACE ASSIGNMENT(=)
56      MODULE PROCEDURE multi__copy   ! copy multi file structure
57   END INTERFACE   
58
59CONTAINS
60   !-------------------------------------------------------------------
61   !> @brief
62   !> This function copy multi file structure in another multi file
63   !> structure
64   !> @details
65   !> file variable value are copied in a temporary table,
66   !> so input and output file structure value do not point on the same
67   !> "memory cell", and so on are independant.
68   !>
69   !> @warning to avoid infinite loop, do not use any function inside
70   !> this subroutine
71   !>   
72   !> @author J.Paul
73   !> - Nov, 2013- Initial Version
74   !
75   !> @param[out] td_multi1  : file structure
76   !> @param[in] td_multi2  : file structure
77   !-------------------------------------------------------------------
78   !> @code
79   SUBROUTINE multi__copy( td_multi1, td_multi2 )
80      IMPLICIT NONE
81      ! Argument
82      TYPE(TMULTI), INTENT(OUT) :: td_multi1
83      TYPE(TMULTI), INTENT(IN)  :: td_multi2
84
85      ! loop indices
86      INTEGER(i4) :: ji
87      !----------------------------------------------------------------
88
89      CALL logger_trace("COPY: mulit file ")
90
91      td_multi1%i_nfile = td_multi2%i_nfile
92      td_multi1%i_nvar  = td_multi2%i_nvar
93
94      ! copy variable structure
95      IF( ASSOCIATED(td_multi1%t_file) ) DEALLOCATE(td_multi1%t_file)
96      IF( ASSOCIATED(td_multi2%t_file) .AND. td_multi1%i_nfile > 0 )THEN
97         ALLOCATE( td_multi1%t_file(td_multi1%i_nfile) )
98         DO ji=1,td_multi1%i_nfile
99            td_multi1%t_file(ji) = td_multi2%t_file(ji)
100         ENDDO
101      ENDIF
102
103   END SUBROUTINE multi__copy
104   !> @endcode
105   !-------------------------------------------------------------------
106   !> @brief This subroutine initialize multi file structure.
107   !
108   !> @author J.Paul
109   !> - Nov, 2013- Initial Version
110   !
111   !> @param[in] cd_varfile : variable location information (from namelist)
112   !> @return td_multi : multi structure
113   !-------------------------------------------------------------------
114   ! @code
115   FUNCTION multi_init(cd_varfile)
116      IMPLICIT NONE
117
118      ! Argument
119      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varfile
120
121      ! function
122      TYPE(TMULTI) :: multi_init
123
124      ! local variable
125      CHARACTER(LEN=lc) :: cl_name
126      CHARACTER(LEN=lc) :: cl_file
127      CHARACTER(LEN=lc) :: cl_matrix
128
129      INTEGER(i4)       :: il_fileid
130
131      TYPE(TVAR)        :: tl_var
132
133      TYPE(TFILE)       :: tl_file
134
135      TYPE(TMULTI)      :: tl_multi
136
137      ! loop indices
138      INTEGER(i4) :: ji
139      !----------------------------------------------------------------
140
141      ji=1
142      DO WHILE( TRIM(cd_varfile(ji)) /= '' )
143
144         cl_name=fct_lower(fct_split(cd_varfile(ji),1,':'))
145         cl_file=fct_split(cd_varfile(ji),2,':')
146
147         IF( TRIM(cl_name) /= '' )THEN
148            IF( TRIM(cl_file) /= '' )THEN
149               cl_matrix=''
150               IF( fct_is_num(cl_file(1:1)) )THEN
151                  cl_matrix=TRIM(cl_file)
152                  WRITE(cl_file,'(a,i2.2)')'data_',ji
153               ENDIF
154               
155               ! get file id
156               tl_file=file_init(TRIM(cl_file))
157               il_fileid=multi_add_file(tl_multi,tl_file) 
158 
159               ! define variable
160               tl_var=var_init(TRIM(cl_name))
161               CALL var_read_matrix(tl_var, cl_matrix)
162
163               ! add variable
164               CALL file_add_var(tl_multi%t_file(il_fileid),tl_var)
165
166               ! update total number of variable
167               tl_multi%i_nvar=tl_multi%i_nvar+1
168
169               ! clean structure
170               CALL var_clean(tl_var)
171
172            ELSE
173               CALL logger_error("MULTI INIT: file name matching variable "//&
174               &                 TRIM(cl_name)//" is empty. check namelist.")
175            ENDIF
176         ELSE
177            CALL logger_error("MULTI INIT: variable name "//&
178            &                 "is empty. check namelist.")
179         ENDIF
180
181         ji=ji+1
182      ENDDO
183
184      ! save result
185      multi_init=tl_multi
186
187   END FUNCTION multi_init
188   ! @endcode
189   !-------------------------------------------------------------------
190   !> @brief This subroutine clean multi file strucutre.
191   !
192   !> @author J.Paul
193   !> - Nov, 2013- Initial Version
194   !
195   !> @param[in] td_multi : multi file structure
196   !-------------------------------------------------------------------
197   ! @code
198   SUBROUTINE multi_clean(td_multi)
199      IMPLICIT NONE
200
201      ! Argument     
202      TYPE(TMULTI), INTENT(INOUT) :: td_multi
203
204      ! local variable
205      TYPE(TMULTI) :: tl_multi ! empty multi file structure
206
207      ! loop indices
208      INTEGER(i4) :: ji
209      !----------------------------------------------------------------
210
211      CALL logger_info( " CLEAN: reset multi file " )
212
213      IF( ASSOCIATED( td_multi%t_file ) )THEN
214         DO ji=td_multi%i_nfile,1,-1
215            CALL file_clean(td_multi%t_file(ji))
216         ENDDO
217         DEALLOCATE(td_multi%t_file)
218      ENDIF
219
220      ! replace by empty structure
221      td_multi=tl_multi
222
223   END SUBROUTINE multi_clean
224   ! @endcode
225   !-------------------------------------------------------------------
226   !> @brief This subroutine print some information about mpp strucutre.
227   !
228   !> @author J.Paul
229   !> - Nov, 2013- Initial Version
230   !
231   !> @param[in] td_mpp : mpp structure
232   !-------------------------------------------------------------------
233   ! @code
234   SUBROUTINE multi_print(td_multi)
235      IMPLICIT NONE
236
237      ! Argument     
238      TYPE(TMULTI), INTENT(IN) :: td_multi
239
240      ! local variable
241
242      ! loop indices
243      INTEGER(i4) :: ji
244      INTEGER(i4) :: jj
245      !----------------------------------------------------------------
246
247      ! print file
248      IF( td_multi%i_nfile /= 0 .AND. ASSOCIATED(td_multi%t_file) )THEN
249         WRITE(*,'(/a,i3)') 'MULTI: total number of file: ',&
250         &  td_multi%i_nfile
251         WRITE(*,'(6x,a,i3)') ' total number of variable: ',&
252         &  td_multi%i_nvar
253         DO ji=1,td_multi%i_nfile
254            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_file(ji)%c_name),&
255            & ' CONTAINS'
256            DO jj=1,td_multi%t_file(ji)%i_nvar
257               IF( ASSOCIATED(td_multi%t_file(ji)%t_var) )THEN
258                  WRITE(*,'(6x,a/)') TRIM(td_multi%t_file(ji)%t_var(jj)%c_name)
259               ENDIF
260            ENDDO
261         ENDDO
262      ENDIF
263
264   END SUBROUTINE multi_print
265   ! @endcode
266   !-------------------------------------------------------------------
267   !> @brief
268   !>    This subroutine add file to multi file structure.
269   !>
270   !> @detail
271   !
272   !> @author J.Paul
273   !> - Nov, 2013- Initial Version
274   !
275   !> @param[inout] td_multi : multi file strcuture
276   !> @param[in]    td_file  : file strcuture
277   !> @return file id in multi structure
278   !-------------------------------------------------------------------
279   !> @code
280   FUNCTION multi_add_file( td_multi, td_file )
281      IMPLICIT NONE
282      ! Argument
283      TYPE(TMULTI), INTENT(INOUT) :: td_multi
284      TYPE(TFILE) , INTENT(IN)    :: td_file
285
286      ! function
287      INTEGER(i4) :: multi_add_file
288
289      ! local variable
290      INTEGER(i4) :: il_status
291      INTEGER(i4) :: il_fileid
292      TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_file
293      !----------------------------------------------------------------
294
295      il_fileid=0
296      IF( ASSOCIATED(td_multi%t_file) )THEN
297         il_fileid=file_get_id(td_multi%t_file(:),TRIM(td_file%c_name))
298      ENDIF
299
300      IF( il_fileid /= 0 )THEN
301
302            multi_add_file=il_fileid
303
304      ELSE
305         
306         CALL logger_trace("MULTI ADD FILE: add file "//&
307         &               TRIM(td_file%c_name)//" in multi structure")
308
309         IF( td_multi%i_nfile > 0 )THEN
310            !
311            ! already other file in multi structure
312            ALLOCATE( tl_file(td_multi%i_nfile), stat=il_status )
313            IF(il_status /= 0 )THEN
314
315               CALL logger_error( " MULTI ADD FILE: not enough space to put file &
316               &               in multi structure")
317
318            ELSE
319               ! save temporary multi structure
320               tl_file(:)=td_multi%t_file(:)
321
322               DEALLOCATE( td_multi%t_file )
323               ALLOCATE( td_multi%t_file(td_multi%i_nfile+1), stat=il_status)
324               IF(il_status /= 0 )THEN
325
326                  CALL logger_error( " MULTI ADD FILE: not enough space to put "//&
327                  &  "file in multi structure ")
328
329               ENDIF
330
331               ! copy file in multi before
332               td_multi%t_file(1:td_multi%i_nfile) = tl_file(:)
333
334               DEALLOCATE(tl_file)
335            ENDIF
336
337         ELSE
338            ! no processor in mpp structure
339            IF( ASSOCIATED(td_multi%t_file) )THEN
340               DEALLOCATE(td_multi%t_file)
341            ENDIF
342            ALLOCATE( td_multi%t_file(td_multi%i_nfile+1), stat=il_status )
343            IF(il_status /= 0 )THEN
344
345               CALL logger_error( " MULTI ADD FILE: not enough space to put "//&
346               &  "file in multi structure " )
347
348            ENDIF
349         ENDIF
350
351         td_multi%i_nfile=td_multi%i_nfile+1
352
353         ! add new file
354         td_multi%t_file(td_multi%i_nfile)=td_file
355
356         multi_add_file=td_multi%i_nfile
357
358      ENDIF
359   END FUNCTION multi_add_file
360   !> @endcode
361END MODULE multi
362
Note: See TracBrowser for help on using the repository browser.